Import perl-5.18.2

OK espie@ sthen@ deraadt@

13 files changed, 308 insertions, 106 deletions

diff --git a/gnu/usr.bin/perl/t/uni/case.pl b/gnu/usr.bin/perl/t/uni/case.pl
index 8bd115b4792..08df6706db9 100644
--- a/gnu/usr.bin/perl/t/uni/case.pl
+++ b/gnu/usr.bin/perl/t/uni/case.pl
@@ -1,11 +1,16 @@
 require "test.pl";
+use strict;
+use warnings;
 
 sub unidump {
     join " ", map { sprintf "%04X", $_ } unpack "U*", $_[0];
 }
 
 sub casetest {
-    my ($already_run, $base, $spec, @funcs) = @_;
+    my ($already_run, $base, @funcs) = @_;
+
+    my %spec;
+
     # For each provided function run it, and run a version with some extra
     # characters afterwards. Use a recycling symbol, as it doesn't change case.
     # $already_run is the number of extra tests the caller has run before this
@@ -20,18 +25,33 @@ sub casetest {
 		    },
 		   )} @funcs;
 
-    my $file = "../lib/unicore/To/$base.pl";
-    my $simple = do $file or die $@;
+    use Unicode::UCD 'prop_invmap';
+
+    # Get the case mappings
+    my ($invlist_ref, $invmap_ref, undef, $default) = prop_invmap($base);
     my %simple;
-    for my $i (split(/\n/, $simple)) {
-	my ($k, $v) = split(' ', $i);
-
-        # Add the simple mapping to the simples test list, except the input
-        # may include code points that the specials override, so don't add
-        # those to the test list.  The specials keys are the code points,
-        # encoded in utf8,, but without the utf8 flag on, so pack with C0.
-	$simple{$k} = $v unless exists $spec->{pack("C0U", hex $k)};
+
+    for my $i (0 .. @$invlist_ref - 1 - 1) {
+        next if $invmap_ref->[$i] == $default;
+
+        # Add simple mappings to the simples test list
+        if (! ref $invmap_ref->[$i]) {
+
+            # The returned map needs to have adjustments made.  Each
+            # subsequent element of the range requires adjustment of +1 from
+            # the previous element
+            my $adjust = 0;
+            for my $k ($invlist_ref->[$i] .. $invlist_ref->[$i+1] - 1) {
+                $simple{$k} = $invmap_ref->[$i] + $adjust++;
+            }
+        }
+        else {  # The return is a list of the characters mapped-to.
+                # prop_invmap() guarantees a single element in the range in
+                # this case, so no adjustments are needed.
+            $spec{$invlist_ref->[$i]} = pack "U0U*" , @{$invmap_ref->[$i]};
+        }
     }
+
     my %seen;
 
     for my $i (sort keys %simple) {
@@ -39,17 +59,12 @@ sub casetest {
     }
     print "# ", scalar keys %simple, " simple mappings\n";
 
-    my $both;
-
-    for my $i (sort keys %$spec) {
+    for my $i (sort keys %spec) {
 	if (++$seen{$i} == 2) {
 	    warn sprintf "$base: $i seen twice\n";
-	    $both++;
 	}
     }
-    print "# ", scalar keys %$spec, " special mappings\n";
-
-    exit(1) if $both;
+    print "# ", scalar keys %spec, " special mappings\n";
 
     my %none;
     for my $i (map { ord } split //,
@@ -62,101 +77,43 @@ sub casetest {
     my $tests = 
         $already_run +
 	((scalar keys %simple) +
-	 (scalar keys %$spec) +
+	 (scalar keys %spec) +
 	 (scalar keys %none)) * @funcs;
 
     my $test = $already_run + 1;
 
     for my $i (sort keys %simple) {
 	my $w = $simple{$i};
-	my $c = pack "U0U", hex $i;
+	my $c = pack "U0U", $i;
 	foreach my $func (@funcs) {
 	    my $d = $func->($c);
 	    my $e = unidump($d);
-	    print $d eq pack("U0U", hex $simple{$i}) ?
-		"ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n";
-		$test++;
+	    is( $d, pack("U0U", $simple{$i}), "$i -> $e ($w)" );
 	}
     }
 
-    for my $i (sort keys %$spec) {
-	my $w = unidump($spec->{$i});
-	if (ord('A') == 193 && $i eq "\x8A\x73") {
-	    $w = '0178'; # It's a Latin small Y with diaeresis and not a Latin small letter sharp 's'.
-	}
-	my $u = unpack "C0U", $i;
-	my $h = sprintf "%04X", $u;
-	my $c = chr($u); $c .= chr(0x100); chop $c;
+    for my $i (sort keys %spec) {
+	my $w = unidump($spec{$i});
+	my $h = sprintf "%04X", $i;
+	my $c = chr($i); $c .= chr(0x100); chop $c;
 	foreach my $func (@funcs) {
 	    my $d = $func->($c);
 	    my $e = unidump($d);
-	    if (ord "A" == 193) { # EBCDIC
-		# We need to a little bit of remapping.
-		#
-		# For example, in titlecase (ucfirst) mapping
-		# of U+0149 the Unicode mapping is U+02BC U+004E.
-		# The 4E is N, which in EBCDIC is 2B--
-		# and the ucfirst() does that right.
-		# The problem is that our reference
-		# data is in Unicode code points.
-		#
-		# The Right Way here would be to use, say,
-		# Encode, to remap the less-than 0x100 code points,
-		# but let's try to be Encode-independent here. 
-		#
-		# These are the titlecase exceptions:
-		#
-		#         Unicode   Unicode+EBCDIC  
-		#
-		# 0149 -> 02BC 004E (02BC 002B)
-		# 01F0 -> 004A 030C (00A2 030C)
-		# 1E96 -> 0048 0331 (00E7 0331)
-		# 1E97 -> 0054 0308 (00E8 0308)
-		# 1E98 -> 0057 030A (00EF 030A)
-		# 1E99 -> 0059 030A (00DF 030A)
-		# 1E9A -> 0041 02BE (00A0 02BE)
-		#
-		# The uppercase exceptions are identical.
-		#
-		# The lowercase has one more:
-		#
-		#         Unicode   Unicode+EBCDIC  
-		#
-		# 0130 -> 0069 0307 (00D1 0307)
-		#
-		if ($h =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) {
-		    $e =~ s/004E/002B/; # N
-		    $e =~ s/004A/00A2/; # J
-		    $e =~ s/0048/00E7/; # H
-		    $e =~ s/0054/00E8/; # T
-		    $e =~ s/0057/00EF/; # W
-		    $e =~ s/0059/00DF/; # Y
-		    $e =~ s/0041/00A0/; # A
-		    $e =~ s/0069/00D1/; # i
-		}
-		# We have to map the output, not the input, because
-		# pack/unpack U has been EBCDICified, too, it would
-		# just undo our remapping.
-	    }
-	    print $w eq $e ?
-		"ok $test # $i -> $w\n" : "not ok $test # $h -> $e ($w)\n";
-		$test++;
+            is( $w, $e, "$h -> $e ($w)" );
 	}
     }
 
     for my $i (sort { $a <=> $b } keys %none) {
+	my $c = pack "U0U", $i;
 	my $w = $i = sprintf "%04X", $i;
-	my $c = pack "U0U", hex $i;
 	foreach my $func (@funcs) {
 	    my $d = $func->($c);
 	    my $e = unidump($d);
-	    print $d eq $c ?
-		"ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n";
-		$test++;
+            is( $d, $c, "$i -> $e ($w)" );
 	}
     }
 
-    print "1..$tests\n";
+    done_testing();
 }
 
 1;
diff --git a/gnu/usr.bin/perl/t/uni/chr.t b/gnu/usr.bin/perl/t/uni/chr.t
index 33283e779a8..9445d32a7ba 100644
--- a/gnu/usr.bin/perl/t/uni/chr.t
+++ b/gnu/usr.bin/perl/t/uni/chr.t
@@ -8,7 +8,8 @@ BEGIN {
 }
 
 use strict;
-plan (tests => 6);
+plan (tests => 8);
+no warnings 'deprecated';
 use encoding 'johab';
 
 ok(chr(0x7f) eq "\x7f");
@@ -19,4 +20,13 @@ for my $i (127, 128, 255) {
     ok(chr($i) eq pack('C', $i));
 }
 
+# [perl #83048]
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= $_[0] };
+    my $chr = chr(-1);
+    is($chr, "\x{fffd}", "invalid values become REPLACEMENT CHARACTER");
+    like($w, qr/^Invalid negative number \(-1\) in chr at /, "with a warning");
+}
+
 __END__
diff --git a/gnu/usr.bin/perl/t/uni/greek.t b/gnu/usr.bin/perl/t/uni/greek.t
index 1737a679fa4..5326ab94ad7 100644
--- a/gnu/usr.bin/perl/t/uni/greek.t
+++ b/gnu/usr.bin/perl/t/uni/greek.t
@@ -9,6 +9,7 @@ BEGIN {
 
 plan tests => 72;
 
+no warnings 'deprecated';
 use encoding "greek"; # iso 8859-7
 
 # U+0391, \xC1, \301, GREEK CAPITAL LETTER ALPHA
diff --git a/gnu/usr.bin/perl/t/uni/labels.t b/gnu/usr.bin/perl/t/uni/labels.t
index 3d7d476ae95..3fa9d38c216 100644
--- a/gnu/usr.bin/perl/t/uni/labels.t
+++ b/gnu/usr.bin/perl/t/uni/labels.t
@@ -15,7 +15,7 @@ use feature qw 'unicode_strings evalbytes';
 
 use charnames qw( :full );
 
-plan(9);
+plan(10);
 
 ＬＡＢＥＬ: {
     pass("Sanity check, UTF-8 labels don't throw a syntax error.");
@@ -54,11 +54,13 @@ SKIP: {
     like $@, qr/Label not found for "next Ｅ" at/u, "next's error is UTF-8 clean";
 }
 
-my $d = 4;
+my $d = 2;
 LÁBEL: {
+    my $e = $@;
     my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
 
-    if ($d % 2) {
+    if ($d == 1) {
+        is $e, '', "redo UTF8 works";
         utf8::downgrade($prog);
     }
     if ($d--) {
@@ -68,8 +70,8 @@ LÁBEL: {
     }
 }
 
-is $@, '', "redo to downgradeable labels works";
-is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
+like $@, qr/Unrecognized character/, "redo to downgradeable labels";
+is $d, 0, "Latin-1 labels are reachable";
 
 {
     no warnings;
diff --git a/gnu/usr.bin/perl/t/uni/latin2.t b/gnu/usr.bin/perl/t/uni/latin2.t
index 152747139ed..6e7d980aec3 100644
--- a/gnu/usr.bin/perl/t/uni/latin2.t
+++ b/gnu/usr.bin/perl/t/uni/latin2.t
@@ -9,6 +9,7 @@ BEGIN {
 
 plan tests => 94;
 
+no warnings 'deprecated';
 use encoding "latin2"; # iso 8859-2
 
 # U+00C1, \xC1, \301, LATIN CAPITAL LETTER A WITH ACUTE
diff --git a/gnu/usr.bin/perl/t/uni/lower.t b/gnu/usr.bin/perl/t/uni/lower.t
index 5ab4cdd74e1..5b706af0d84 100644
--- a/gnu/usr.bin/perl/t/uni/lower.t
+++ b/gnu/usr.bin/perl/t/uni/lower.t
@@ -5,6 +5,6 @@ BEGIN {
 }
 
 casetest(0, # No extra tests run here,
-	"Lower", \%utf8::ToSpecLower,
+	"Lowercase_Mapping",
 	 sub { lc $_[0] }, sub { my $a = ""; lc ($_[0] . $a) },
 	 sub { lcfirst $_[0] }, sub { my $a = ""; lcfirst ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/parser.t b/gnu/usr.bin/perl/t/uni/parser.t
index 79e4612c65d..009ad357386 100644
--- a/gnu/usr.bin/perl/t/uni/parser.t
+++ b/gnu/usr.bin/perl/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 47);
+plan (tests => 48);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -145,3 +145,10 @@ eval q{ Ｆｏｏ::$bar };
 like( $@, qr/Bad name after Ｆｏｏ::/, 'Bad name after Ｆｏｏ::' );
 eval q{ Ｆｏｏ''bar };
 like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' );
+
+{
+    no warnings 'utf8';
+    my $malformed_to_be = "\x{c0}\x{a0}";   # Overlong sequence
+    CORE::evalbytes "use charnames ':full'; use utf8; my \$x = \"\\N{abc$malformed_to_be}\"";
+    like( $@, qr/Malformed UTF-8 character immediately after '\\N\{abc' at .* within string/, 'Malformed UTF-8 input to \N{}');
+}
diff --git a/gnu/usr.bin/perl/t/uni/readline.t b/gnu/usr.bin/perl/t/uni/readline.t
index ef2106dfd21..495172ca98c 100644
--- a/gnu/usr.bin/perl/t/uni/readline.t
+++ b/gnu/usr.bin/perl/t/uni/readline.t
@@ -21,7 +21,7 @@ like($@, 'Modification of a read-only value attempted', '[perl #19566]');
   my $file = tempfile();
   open Ạ,'+>',$file; $a = 3;
   is($a .= <Ạ>, 3, '#21628 - $a .= <A> , A eof');
-  close A; $a = 4;
+  close Ạ; $a = 4;
   is($a .= <Ạ>, 4, '#21628 - $a .= <A> , A closed');
 }
 
diff --git a/gnu/usr.bin/perl/t/uni/stash.t b/gnu/usr.bin/perl/t/uni/stash.t
index 168b93c8742..7d24e5178a2 100644
--- a/gnu/usr.bin/perl/t/uni/stash.t
+++ b/gnu/usr.bin/perl/t/uni/stash.t
@@ -266,11 +266,8 @@ plan( tests => 58 );
         'ref() returns the same thing when an object’s stash is moved';
         ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
         'objects stringify the same way when their stashes are moved';
-        {
-            local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-            ::is eval '__PACKAGE__', 'rìle',
+        ::is eval '__PACKAGE__', 'rìle',
             '__PACKAGE__ returns the same when the current stash is moved';
-        }
     
         # Now detach it completely from the symtab, making it effect-
         # ively anonymous
@@ -283,11 +280,8 @@ plan( tests => 58 );
         'ref() returns the same thing when an object’s stash is detached';
         ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
         'objects stringify the same way when their stashes are detached';
-        {
-            local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-            ::is eval '__PACKAGE__', 'rìle',
+        ::is eval '__PACKAGE__', 'rìle',
             '__PACKAGE__ returns the same when the current stash is detached';
-        }
     }
     
     # Setting the name during undef %stash:: should have no effect.
diff --git a/gnu/usr.bin/perl/t/uni/title.t b/gnu/usr.bin/perl/t/uni/title.t
index 3d2eb3e2519..2d6dcb77ef3 100644
--- a/gnu/usr.bin/perl/t/uni/title.t
+++ b/gnu/usr.bin/perl/t/uni/title.t
@@ -5,5 +5,5 @@ BEGIN {
 }
 
 casetest(0, # No extra tests run here,
-	"Title", \%utf8::ToSpecTitle, sub { ucfirst $_[0] },
+	"Titlecase_Mapping", sub { ucfirst $_[0] },
 	 sub { my $a = ""; ucfirst ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/universal.t b/gnu/usr.bin/perl/t/uni/universal.t
index 8f158e90b81..626c30f8576 100644
--- a/gnu/usr.bin/perl/t/uni/universal.t
+++ b/gnu/usr.bin/perl/t/uni/universal.t
@@ -119,6 +119,7 @@ ok $a->can("slèèp");
 
 {
     package Pìckùp;
+    no warnings "deprecated";
     use UNIVERSAL qw( isa can VERSION );
 
     ::ok isa "Pìckùp", UNIVERSAL;
diff --git a/gnu/usr.bin/perl/t/uni/upper.t b/gnu/usr.bin/perl/t/uni/upper.t
index b343a1fc20a..315680c11b6 100644
--- a/gnu/usr.bin/perl/t/uni/upper.t
+++ b/gnu/usr.bin/perl/t/uni/upper.t
@@ -7,6 +7,6 @@ BEGIN {
 is(uc("\x{3B1}\x{345}\x{301}"), "\x{391}\x{301}\x{399}", 'Verify moves YPOGEGRAMMENI');
 
 casetest( 1,	# extra tests already run
-	"Upper", \%utf8::ToSpecUpper,
+	"Uppercase_Mapping",
 	 sub { uc $_[0] },
 	 sub { my $a = ""; uc ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/variables.t b/gnu/usr.bin/perl/t/uni/variables.t
new file mode 100644
index 00000000000..cee681fd08a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/uni/variables.t
@@ -0,0 +1,229 @@
+#!./perl
+
+# Checks if the parser behaves correctly in edge case
+# (including weird syntax errors)
+
+BEGIN {
+    require './test.pl';
+}
+
+use 5.016;
+use utf8;
+use open qw( :utf8 :std );
+no warnings qw(misc reserved);
+
+plan (tests => 65869);
+
+# ${single:colon} should not be valid syntax
+{
+    no strict;
+
+    local $@;
+    eval "\${\x{30cd}single:\x{30cd}colon} = 1";
+    like($@,
+         qr/syntax error .* near "\x{30cd}single:/,
+         '${\x{30cd}single:\x{30cd}colon} should not be valid syntax'
+        );
+
+    local $@;
+    no utf8;
+    evalbytes '${single:colon} = 1';
+    like($@,
+         qr/syntax error .* near "single:/,
+         '...same with ${single:colon}'
+        );
+}
+
+# ${yadda'etc} and ${yadda::etc} should both work under strict
+{
+    local $@;
+    eval q<use strict; ${flark::fleem}>;
+    is($@, '', q<${package::var} works>);
+
+    local $@;
+    eval q<use strict; ${fleem'flark}>;
+    is($@, '', q<...as does ${package'var}>);
+}
+
+# The first character in ${...} should respect the rules
+{
+   local $@;
+   use utf8;
+   eval '${☭asd} = 1';
+   like($@, qr/\QUnrecognized character/, q(the first character in ${...} isn't special))
+}
+
+# Checking that at least some of the special variables work
+for my $v (qw( ^V ; < > ( ) {^GLOBAL_PHASE} ^W _ 1 4 0 [ ] ! @ / \ = )) {
+    local $@;
+    evalbytes "\$$v;";
+    is $@, '', "No syntax error for \$$v";
+
+    local $@;
+    eval "use utf8; \$$v;";
+    is $@, '', "No syntax error for \$$v under use utf8";
+}
+
+# Checking if the Latin-1 range behaves as expected, and that the behavior is the
+# same whenever under strict or not.
+for ( 0x80..0xff ) {
+    no warnings 'closure';
+    my $chr = chr;
+    my $esc = sprintf("%X", ord $chr);
+    utf8::downgrade($chr);
+    if ($chr !~ /\p{XIDS}/u) {
+        is evalbytes "no strict; \$$chr = 10",
+            10,
+            sprintf("\\x%02x, part of the latin-1 range, is legal as a length-1 variable", $_);
+
+        utf8::upgrade($chr);
+        local $@;
+        eval "no strict; use utf8; \$$chr = 1";
+        like $@,
+            qr/\QUnrecognized character \x{\E\L$esc/,
+            sprintf("..but is illegal as a length-1 variable under use utf8", $_);
+    }
+    else {
+        {
+            no utf8;
+            local $@;
+            evalbytes "no strict; \$$chr = 1";
+            is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, latin-1, no utf8, no strict, is a valid length-1 variable", $_));
+
+            local $@;
+            evalbytes "use strict; \$$chr = 1";
+            is($@,
+                '',
+                sprintf("\\x%02x under no utf8 does not have to be required under strict, even though it matches XIDS", $_)
+            );
+
+            local $@;
+            evalbytes "\$a$chr = 1";
+            like($@,
+                qr/Unrecognized character /,
+                sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
+            );
+
+            local $@;
+            evalbytes "\$a$chr = 1";
+            like($@,
+                qr/Unrecognized character /,
+                sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
+            );
+        }
+        {
+            use utf8;
+            my $u = $chr;
+            utf8::upgrade($u);
+            local $@;
+            eval "no strict; \$$u = 1";
+            is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, UTF-8, use utf8, no strict, is a valid length-1 variable", $_));
+
+            local $@;
+            eval "use strict; \$$u = 1";
+            like($@,
+                qr/Global symbol "\$$u" requires explicit package name/,
+                sprintf("\\x%02x under utf8 has to be required under strict", $_)
+            );
+        }
+    }
+}
+
+{
+    use utf8;
+    my $ret = eval "my \$c\x{327} = 100; \$c\x{327}"; # c + cedilla
+    is($@, '', "ASCII character + combining character works as a variable name");
+    is($ret, 100, "...and returns the correct value");
+}
+
+# From Tom Christiansen's 'highly illegal variable names are now accidentally legal' mail
+for my $chr (
+      "\N{EM DASH}", "\x{F8FF}", "\N{POUND SIGN}", "\N{SOFT HYPHEN}",
+      "\N{THIN SPACE}", "\x{11_1111}", "\x{DC00}", "\N{COMBINING DIAERESIS}",
+      "\N{COMBINING ENCLOSING CIRCLE BACKSLASH}",
+   )
+{
+   no warnings 'non_unicode';
+   my $esc = sprintf("%x", ord $chr);
+   local $@;
+   eval "\$$chr = 1; \$$chr";
+   like($@,
+        qr/\QUnrecognized character \x{$esc};/,
+        "\\x{$esc} is illegal for a length-one identifier"
+       );
+}
+
+for my $i (0x100..0xffff) {
+   my $chr = chr($i);
+   my $esc = sprintf("%x", $i);
+   local $@;
+   eval "my \$$chr = q<test>; \$$chr;";
+   if ( $chr =~ /^\p{_Perl_IDStart}$/ ) {
+      is($@, '', sprintf("\\x{%04x} is XIDS, works as a length-1 variable", $i));
+   }
+   else {
+      like($@,
+           qr/\QUnrecognized character \x{$esc};/,
+           "\\x{$esc} isn't XIDS, illegal as a length-1 variable",
+          )
+   }
+}
+
+{
+    # Bleadperl v5.17.9-109-g3283393 breaks ZEFRAM/Module-Runtime-0.013.tar.gz
+    # https://rt.perl.org/rt3/Public/Bug/Display.html?id=117101
+    no strict;
+
+    local $@;
+    eval <<'EOP';
+    q{$} =~ /(.)/;
+    is($$1, $$, q{$$1 parses as ${$1}});
+
+    $doof = "test";
+    $test = "Got here";
+    $::{+$$} = *doof;
+
+    is( $$$$1, $test, q{$$$$1 parses as ${${${$1}}}} );
+EOP
+    is($@, '', q{$$1 parses correctly});
+
+    for my $chr ( q{@}, "\N{U+FF10}", "\N{U+0300}" ) {
+        my $esc = sprintf("\\x{%x}", ord $chr);
+        local $@;
+        eval <<"    EOP";
+            \$$chr = q{\$};
+            \$\$$chr;
+    EOP
+
+        like($@,
+             qr/syntax error|Unrecognized character/,
+             qq{\$\$$esc is a syntax error}
+        );
+    }
+}
+
+{
+    # bleadperl v5.17.9-109-g3283393 breaks JEREMY/File-Signature-1.009.tar.gz
+    # https://rt.perl.org/rt3/Ticket/Display.html?id=117145
+    local $@;
+    my $var = 10;
+    eval ' ${  var  }';
+
+    is(
+        $@,
+        '',
+        '${  var  } works under strict'
+    );
+
+    {
+        no strict;
+        for my $var ( '$', "\7LOBAL_PHASE", "^GLOBAL_PHASE", "^V" ) {
+            eval "\${ $var}";
+            is($@, '', "\${ $var} works" );
+            eval "\${$var }";
+            is($@, '', "\${$var } works" );
+            eval "\${ $var }";
+            is($@, '', "\${ $var } works" );
+        }
+    }
+}