Disable const repl optimisation for empty pattern

s//$a/ cannot assume that the $a expression is going to return the
same value at each iteration, because the last-used pattern may con-
tain code blocks that clobber *a.

diff --git a/op.c b/op.c
index f1b0d13..8fccf71 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4787,6 +4787,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
        if (konst
            && !(repl_has_vars
                 && (!PM_GETRE(pm)
+                    || !RX_PRELEN(PM_GETRE(pm))
                     || RX_EXTFLAGS(PM_GETRE(pm)) & RXf_EVAL_SEEN)))
        {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 43069f5..43cb670 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -830,9 +830,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 11.
-Use of uninitialized value $g1 in substitution (s///) at - line 11.
 Use of uninitialized value $_ in substitution (s///) at - line 11.
-Use of uninitialized value $g1 in substitution (s///) at - line 11.
+Use of uninitialized value $g1 in substitution iterator at - line 11.
 Use of uninitialized value $m1 in regexp compilation at - line 12.
 Use of uninitialized value $_ in substitution (s///) at - line 12.
 Use of uninitialized value $_ in substitution (s///) at - line 12.
@@ -849,9 +848,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 22.
-Use of uninitialized value $g1 in substitution (s///) at - line 22.
 Use of uninitialized value $_ in substitution (s///) at - line 22.
-Use of uninitialized value $g1 in substitution (s///) at - line 22.
+Use of uninitialized value $g1 in substitution iterator at - line 22.
 Use of uninitialized value $m1 in regexp compilation at - line 23.
 Use of uninitialized value $_ in substitution (s///) at - line 23.
 Use of uninitialized value $_ in substitution (s///) at - line 23.
@@ -868,9 +866,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 32.
-Use of uninitialized value $g1 in substitution (s///) at - line 32.
 Use of uninitialized value $g2 in substitution (s///) at - line 32.
-Use of uninitialized value $g1 in substitution (s///) at - line 32.
+Use of uninitialized value $g1 in substitution iterator at - line 32.
 Use of uninitialized value $m1 in regexp compilation at - line 33.
 Use of uninitialized value $g2 in substitution (s///) at - line 33.
 Use of uninitialized value $g2 in substitution (s///) at - line 33.
@@ -880,7 +877,7 @@ Use of uninitialized value in transliteration (tr///) at - line 35.
 Use of uninitialized value $m1 in regexp compilation at - line 38.
 Use of uninitialized value $g1 in regexp compilation at - line 39.
 Use of uninitialized value $m1 in regexp compilation at - line 41.
-Use of uninitialized value $g1 in substitution (s///) at - line 42.
+Use of uninitialized value $g1 in substitution iterator at - line 42.
 Use of uninitialized value $m1 in regexp compilation at - line 43.
 Use of uninitialized value $g1 in substitution iterator at - line 43.
 Use of uninitialized value $m1 in substitution (s///) at - line 44.

diff --git a/t/re/subst.t b/t/re/subst.t
index 8aa2266..b139812 100644 (file)
--- a/t/re/subst.t
+++ b/t/re/subst.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 204 );
+plan( tests => 205 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -864,6 +864,16 @@ $_ = "hello";
     s/e(.)\1/a$a/g;
 }
 is $_, 'halo', 's/pat/$alias_to_match_var/';
+# Last-used pattern containing re-evals that modify "constant" rhs
+{
+    local *a;
+    $x = "hello";
+    $x =~ /(?{*a = \"a"})./;
+    undef *a;
+    $x =~ s//$a/g;
+    is $x, 'aaaaa',
+       'last-used pattern disables constant repl optimisation';
+}
 
 
 $_ = "\xc4\x80";