This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123712] Don’t check sub_inwhat
authorFather Chrysostomos <sprout@cpan.org>
Mon, 16 Feb 2015 05:22:00 +0000 (21:22 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 16 Feb 2015 05:22:18 +0000 (21:22 -0800)
PL_sublex_info.sub_inwhat (in the parser struct) is a temporary spot
to store the value of PL_lex_inwhat (also in the parser struct)
when a sub-lexing scope (for a quote-like operator) is entered.
PL_lex_inwhat is localised, and the value is copied from its temporary
spot (sub_inwhat) into PL_lex_inwhat.

The PL_sublex_info.sub_inwhat was not localised, but instead the value
was set to 0 when a sub-lexing scope was exited.  This value was being
used, in a couple of places, to determine whether we were inside a
quote-like operator.  But because the value is not localised, it can
be wrong when it is set to 0, if we have nested lexing scopes.

So this ends up crashing for the same reason described in e47d32dcd5:

echo -n '/$a[m||/<<a' | ./miniperl

perl-5.005_02-1816-g09bef84 added the first use of
PL_sublex_info.sub_inwhat to determine whether we are in a quote-like
operator.  (Later it got shifted around.)  I copied that in e47d32dcd5
(earlier today), because I assumed the logic was correct.  Other parts
of the code use PL_lex_inwhat, which is already localised, as I said,
and does not suffer this problem.

If we do not check PL_sublex_info.sub_inwhat to see if we are in
a quote-like construct, then we don’t need to clear it on lexing
scope exit.

t/op/lex.t
toke.c

index 4de5a80..3207198 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 18);
+plan(tests => 19);
 
 {
     no warnings 'deprecated';
@@ -159,3 +159,10 @@ fresh_perl_is(
    { stderr => 1 },
   '/$a[/<<a with no newline [perl #123712]'
 );
+fresh_perl_is(
+  '/$a[m||/<<a',
+  "syntax error at - line 1, next char ;\n" .
+  "Execution of - aborted due to compilation errors.\n",
+   { stderr => 1 },
+  '/$a[m||/<<a with no newline [perl #123712]'
+);
diff --git a/toke.c b/toke.c
index 4db7400..9e0575c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1266,7 +1266,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     bool got_some;
     if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
-    if (!(flags & LEX_NO_TERM) && PL_sublex_info.sub_inwhat)
+    if (!(flags & LEX_NO_TERM) && PL_lex_inwhat)
        return FALSE;
     linestr = PL_parser->linestr;
     buf = SvPVX(linestr);
@@ -1806,7 +1806,7 @@ S_skipspace_flags(pTHX_ char *s, U32 flags)
        STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
        PL_bufptr = s;
        lex_read_space(flags | LEX_KEEP_PREVIOUS |
-               (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+               (PL_lex_inwhat || PL_lex_state == LEX_FORMLINE ?
                    LEX_NO_NEXT_CHUNK : 0));
        s = PL_bufptr;
        PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
@@ -2486,7 +2486,6 @@ S_sublex_done(pTHX)
        PL_bufend = SvPVX(PL_linestr);
        PL_bufend += SvCUR(PL_linestr);
        PL_expect = XOPERATOR;
-       PL_sublex_info.sub_inwhat = 0;
        return ')';
     }
 }