This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123753] Assert fail with &{+foo} and errors
authorFather Chrysostomos <sprout@cpan.org>
Sun, 8 Feb 2015 03:22:00 +0000 (19:22 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Feb 2015 03:22:00 +0000 (19:22 -0800)
This fixes the problem mentioned in 3c47da3c2e with an op address
being used as flags.  '&' not followed by a identifier was being fed
to the parser with a stale token value, left over from the previous
token that had a value, which might be an op address.  This would
cause the flags on the op to vary randomly.

Usually the rv2cv op created this way is nulled, but if there is a
syntax error it may be freed before that happens.  And it is when the
op is freed that the private flags are checked to make sure no invalid
flags have been set.

The test added to t/op/lex.t used to fail an assertion (for me) more
than half the time, but not always, because the 0x10 bit was being set
in op_private (rv2cv does not use that bit).

t/op/lex.t
toke.c

index 07cdcca..762d888 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 16);
+plan(tests => 17);
 
 {
     no warnings 'deprecated';
@@ -129,7 +129,7 @@ fresh_perl_is(
   '* <null> ident'
 );
 SKIP: {
-    skip "Different output on EBCDIC (presumably)", 1 if ord("A") != 65;
+    skip "Different output on EBCDIC (presumably)", 2 if ord("A") != 65;
     fresh_perl_is(
       qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
 Bareword found where operator expected at - line 1, near ""ab}"ax"
@@ -140,4 +140,14 @@ gibberish
        { stderr => 1 },
       'gibberish containing &\0z - used to crash [perl #123753]'
     );
+    fresh_perl_is(
+      qq'"ab}"ax;&{+z}\x8Ao}\x82x;', <<gibberish,
+Bareword found where operator expected at - line 1, near ""ab}"ax"
+       (Missing operator before ax?)
+syntax error at - line 1, near ""ab}"ax"
+Unrecognized character \\x8A; marked by <-- HERE after }"ax;&{+z}<-- HERE near column 14 at - line 1.
+gibberish
+       { stderr => 1 },
+      'gibberish containing &{+z} - used to crash [perl #123753]'
+    );
 }
diff --git a/toke.c b/toke.c
index fa4de96..388b272 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5752,12 +5752,12 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '&';
        s = scan_ident(s - 1, PL_tokenbuf + 1,
                       sizeof PL_tokenbuf - 1, TRUE);
+       pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
        if (PL_tokenbuf[1]) {
            force_ident_maybe_lex('&');
        }
        else
            PREREF('&');
-       pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
        TERM('&');
 
     case '|':