This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #122782] map{no strict;...} etc.
authorFather Chrysostomos <sprout@cpan.org>
Tue, 28 Oct 2014 23:52:18 +0000 (16:52 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 29 Oct 2014 00:46:59 +0000 (17:46 -0700)
After the lexer (toke.c) has decided in the case of ‘map{’ or ‘print{’
that it has a block, not a hash constructor, it has then preceded to
treat the contents as an expression.

Since it is the parser (perly.y) that ultimately decides whether it is
an expression or statement, most of the time things just work.  But in
those cases where the lexer behaves differently whether it is expect-
ing a statement or expression, it usually just does the wrong thing.
Most notable is map {no strict;...}, which dies with ‘"no" not
allowed in expression’.  See the RT ticket for more examples of the
term/statement discrepancies.

This commit changes it to expect a statement most of the time.  These
changes also apply to the contents of ${...}, which has always fol-
lowed the same rules.  Two cases where it used simply to dwim that
would break with a statement expectation are special-cased, to pre-
serve backward-compatibility as much as possible.  See the comments
added to toke.  We already have an exception for ‘sub’ in the case of
${sub{...}}, which is not treated as $sub{...} as happens with other
barewords, so this is consistent with that.

t/base/lex.t
t/lib/croak/toke
t/op/lex.t
t/uni/variables.t
toke.c

index 7604ee1..a9072ac 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..93\n";
+print "1..101\n";
 
 $x = 'x';
 
@@ -444,3 +444,33 @@ print "not " unless
     (eval '${Function_with_side_effects,\$_}' || $@)
       eq "sidekick function called";
 print "ok $test - \${...} where {...} looks like hash\n"; $test++;
+
+@_ = map{BEGIN {$_122782 = 'tst2'}; "rhu$_"} 'barb2';
+print "not " unless "@_" eq 'rhubarb2';
+print "ok $test - map{BEGIN...\n"; $test++;
+print "not " unless $_122782 eq 'tst2';
+print "ok $test - map{BEGIN...\n"; $test++;
+${
+=pod
+blah blah blah
+=cut
+\$_ } = 42;
+print "not "unless $_ == 42;
+print "ok $test - \${ <newline> =pod\n"; $test++;
+@_ = map{
+=pod
+blah blah blah
+=cut
+$_+1 } 1;
+print "not "unless "@_" eq 2;
+print "ok $test - map{ <newline> =pod\n"; $test++;
+eval { ${...}++ };
+print "not " unless $@ =~ /^Unimplemented at /;
+print "ok $test - \${...} (literal triple-dot)\n"; $test++;
+eval { () = map{...} @_ };
+print "not " unless $@ =~ /^Unimplemented at /;
+print "ok $test - map{...} (literal triple-dot)\n"; $test++;
+print "not " unless &{sub :lvalue { "a" }} eq "a";
+print "ok $test - &{sub :lvalue...}\n"; $test++;
+print "not " unless ref+(map{sub :lvalue { "a" }} 1)[0] eq "CODE";
+print "ok $test - map{sub :lvalue...}\n"; $test++;
index 9c8dd54..2943c7b 100644 (file)
@@ -30,6 +30,11 @@ EXPECT
 Missing right brace on \N{} or unescaped left brace after \N at - line 1, within pattern
 Execution of - aborted due to compilation errors.
 ########
+# NAME map{for our *a...
+map{for our *a (1..10) {$_.=$x}}
+EXPECT
+Missing $ on loop variable at - line 1.
+########
 # NAME Missing name in "my sub"
 use feature 'lexical_subs'; my sub;
 EXPECT
index 5af8538..25ae754 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 8);
+plan(tests => 10);
 
 {
     no warnings 'deprecated';
@@ -88,3 +88,8 @@ is runperl(
  ."2.\n",
   'no buffer corruption with multiline *{...expr...}'
 ;
+
+$_ = "rhubarb";
+is ${no strict; \$_}, "rhubarb", '${no strict; ...}';
+is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb',
+  'map{no strict;...}';
index e8259e5..5ccf7e7 100644 (file)
@@ -16,22 +16,21 @@ no warnings qw(misc reserved);
 
 plan (tests => 66900);
 
-# ${single:colon} should not be valid syntax
+# ${single:colon} should not be treated as a simple variable, but as a
+# block with a label inside.
 {
     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'
-        );
+    eval "\${\x{30cd}single:\x{30cd}colon} = 'label, not var'";
+    is ${"\x{30cd}colon"}, 'label, not var',
+         '${\x{30cd}single:\x{30cd}colon} should be block-label';
 
     local $@;
     no utf8;
-    evalbytes '${single:colon} = 1';
-    like($@,
-         qr/syntax error .* near "single:/,
+    evalbytes '${single:colon} = "block/label, not var"';
+    is($::colon,
+         'block/label, not var',
          '...same with ${single:colon}'
         );
 }
diff --git a/toke.c b/toke.c
index f71cfcd..25a9ccc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5501,9 +5501,10 @@ Perl_yylex(pTHX)
                    OPERATOR(HASHBRACK);
                }
                if (PL_expect == XREF && PL_oldoldbufptr != PL_last_lop) {
-                   /* ${...} or @{...} etc., but not print {...} */
-                   PL_expect = XTERM;
-                   break;
+                   /* ${...} or @{...} etc., but not print {...}
+                    * Skip the disambiguation and treat this as a block.
+                    */
+                   goto block_expectation;
                }
                /* This hack serves to disambiguate a pair of curlies
                 * as being a block or an anon hash.  Normally, expectation
@@ -5587,7 +5588,28 @@ Perl_yylex(pTHX)
                                   || (*t == '=' && t[1] == '>')))
                    OPERATOR(HASHBRACK);
                if (PL_expect == XREF)
-                   PL_expect = XTERM;
+               {
+                 block_expectation:
+                   /* If there is an opening brace or 'sub:', treat it
+                      as a term to make ${{...}}{k} and &{sub:attr...}
+                      dwim.  Otherwise, treat it as a statement, so
+                      map {no strict; ...} works.
+                    */
+                   s = skipspace(s);
+                   if (*s == '{') {
+                       PL_expect = XTERM;
+                       break;
+                   }
+                   if (strnEQ(s, "sub", 3)) {
+                       d = s + 3;
+                       d = skipspace(d);
+                       if (*d == ':') {
+                           PL_expect = XTERM;
+                           break;
+                       }
+                   }
+                   PL_expect = XSTATE;
+               }
                else {
                    PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
                    PL_expect = XSTATE;