From: Hugo van der Sanden <hv@crypt.org>
Date: Thu, 21 Jan 1999 12:08:01 +0000 (+0000)
Subject: Re: [PATCH 5.005_54] Evalled substitution parsing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e9fa98b27b08c227248dead8a754ba7c9269fec0;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH 5.005_54] Evalled substitution parsing

To: perl5-porters@perl.org
Message-Id: <199901211208.MAA01228@crypt.compulink.co.uk>

p4raw-id: //depot/cfgperl@2670
---

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index fc36274..eb84876 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -900,6 +900,12 @@ and the variable had earlier been declared as a lexical variable.
 Either qualify the sort variable with the package name, or rename the
 lexical variable.
 
+=item Bad evalled substitution pattern
+
+(F) You've used the /e switch to evaluate the replacement for a
+substitution, but perl found a syntax error in the code to evaluate,
+most likely an unexpected right brace '}'.
+
 =item Can't use %s for loop variable
 
 (F) Only a simple scalar variable may be used as a loop variable on a foreach.
diff --git a/t/op/subst.t b/t/op/subst.t
index 6b3ce58..6776a1e 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -6,7 +6,7 @@ BEGIN {
     require Config; import Config;
 }
 
-print "1..91\n";
+print "1..93\n";
 
 $x = 'foo';
 $_ = "x";
@@ -451,3 +451,9 @@ $a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
 print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
 print "ok 91\n";
 
+eval q% s/a/"b"}/e %;
+print ($@ =~ /Bad evalled substitution/ ? "ok 92\n" : "not ok 92\n");
+eval q% ($_ = "x") =~ s/(.)/"$1 "/e %;
+print +($_ eq "x " and !length $@) ? "ok 93\n" : "not ok 93\n# \$_ eq $_, $@\n";
+
+
diff --git a/toke.c b/toke.c
index fca117b..de6bfda 100644
--- a/toke.c
+++ b/toke.c
@@ -822,10 +822,15 @@ sublex_done(void)
 	if (SvCOMPILED(PL_lex_repl)) {
 	    PL_lex_state = LEX_INTERPNORMAL;
 	    PL_lex_starts++;
+	    /*	we don't clear PL_lex_repl here, so that we can check later
+		whether this is an evalled subst; that means we rely on the
+		logic to ensure sublex_done() is called again only via the
+		branch (in yylex()) that clears PL_lex_repl, else we'll loop */
 	}
-	else
+	else {
 	    PL_lex_state = LEX_INTERPCONCAT;
-	PL_lex_repl = Nullsv;
+	    PL_lex_repl = Nullsv;
+	}
 	return ',';
     }
     else {
@@ -1845,6 +1850,11 @@ int yylex(PERL_YYLEX_PARAM_DECL)
 	    PL_lex_state = LEX_INTERPCONCAT;
 	    return ')';
 	}
+	if (PL_lex_inwhat == OP_SUBST && PL_lex_repl && SvCOMPILED(PL_lex_repl)) {
+	    if (PL_bufptr != PL_bufend)
+		croak("Bad evalled substitution pattern");
+	    PL_lex_repl = Nullsv;
+	}
 	/* FALLTHROUGH */
     case LEX_INTERPCONCAT:
 #ifdef DEBUGGING