This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix two minor s//.../e parsing bugs
authorFather Chrysostomos <sprout@cpan.org>
Thu, 30 Aug 2012 22:57:18 +0000 (15:57 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 31 Aug 2012 01:18:12 +0000 (18:18 -0700)
It may be an odd place to allow comments, but s//"" # hello/e has\
always worked, *unless* there happens to be a null before the first #.

scan_subst in toke.c wraps the replacement text in do { ... } when the
/e flag is present.

It was adding a line break before the final } if the replacement text
contained #, because otherwise the } would be commented out.

But to find the # it was using strchr, which stops at the first null.
So eval "s//'\0'#/e" would fail.

It makes little sense to me to check whether the replacement contains
# before adding the line break.  It would be faster just to add the
line break without checking.

But then I discovered this bug:

s//"#" . <<END/e;
foo
END
__END__
Can't find string terminator "END" anywhere before EOF at - line 1.

So now I have two bugs to fix.

The easiest solution seems to be to omit the line break and make the
comment parser skip the } at the end of a s///e replacement.

t/base/lex.t
toke.c

index b3359bf..590f219 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..69\n";
+print "1..71\n";
 
 $x = 'x';
 
@@ -344,3 +344,13 @@ END
 b"';
 print "not " if $_ =~ /\n\n/;
 print "ok 69 - eval 's//<<END/' does not leave extra newlines\n";
+
+$_ = a;
+eval "s/a/'b\0'#/e";
+print 'not ' unless $_ eq "b\0";
+print "ok 70 - # after null in s/// repl\n";
+
+s//"#" . <<END/e;
+foo
+END
+print "ok 71 - s//'#' . <<END/e\n";
diff --git a/toke.c b/toke.c
index c9384d2..175deb4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5263,6 +5263,7 @@ Perl_yylex(pTHX)
                    incline(s);
            }
            else {
+               const bool in_comment = *s == '#';
                d = s;
                while (d < PL_bufend && *d != '\n')
                    d++;
@@ -5276,7 +5277,11 @@ Perl_yylex(pTHX)
                    PL_thiswhite = newSVpvn(s, d - s);
 #endif
                s = d;
-               incline(s);
+               if (in_comment && d == PL_bufend
+                && PL_lex_state == LEX_INTERPNORMAL
+                && PL_lex_inwhat == OP_SUBST && PL_lex_repl
+                && SvEVALED(PL_lex_repl) && d[-1] == '}') s--;
+               else incline(s);
            }
            if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
                PL_lex_state = LEX_FORMLINE;
@@ -9361,8 +9366,6 @@ S_scan_subst(pTHX_ char *start)
        }
        sv_catpvs(repl, "{");
        sv_catsv(repl, PL_sublex_info.repl);
-       if (strchr(SvPVX(PL_sublex_info.repl), '#'))
-           sv_catpvs(repl, "\n");
        sv_catpvs(repl, "}");
        SvEVALED_on(repl);
        SvREFCNT_dec(PL_sublex_info.repl);