[perl #26986] Skip subst const repl optimisation for logops
authorFather Chrysostomos <sprout@cpan.org>
Tue, 9 Oct 2012 20:34:54 +0000 (13:34 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 10 Oct 2012 00:44:16 +0000 (17:44 -0700)
pm_runtime iterates through the ops that make up the replacement part
of s///, to see whether the ops on the rhs can have side effects or
contain match vars (in which case they must only be evaluted after the
pattern).  If they do not have side-effects, the rhs is presumed to be
constant and evaluated first, and then pp_subst hangs on to the return
value and reuses it in each iteration of s///g.

This iteration simply follows op_next pointers.  Logops are not that
simple, so it is possible to hide match vars inside them, resulting in
incorrect optimisations:

"g" =~ /(.)/;
@l{'a'..'z'} = 'a'..'z';
$_ = "hello";
s/(.)/$l{$a||$1}/g;
print;
__END__
ggggg

This commit skips the optimisation whenever a logop is present.

This does not fix all the optimisation problems.  See ticket #49190.

op.c
t/re/subst.t

diff --git a/op.c b/op.c
index d3df75e..65fb457 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4793,6 +4793,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
                    else
                        break;
                }
+               else if ((PL_opargs[curop->op_type] & OA_CLASS_MASK)
+                          == OA_LOGOP)
+                   break;
                lastop = curop;
            }
        }
index d546bd2..0016843 100644 (file)
@@ -4,10 +4,10 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
+    require './test.pl';
 }
 
-require './test.pl';
-plan( tests => 200 );
+plan( tests => 201 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -839,3 +839,12 @@ pass("s/// on tied var returning a cow");
     eval { $s =~ s/(.)/die/e; };
     like($@, qr/Died at/, "s//die/e");
 }
+
+
+# [perl #26986] logop in repl resulting in incorrect optimisation
+"g" =~ /(.)/;
+@l{'a'..'z'} = 'A'..':';
+$_ = "hello";
+{ s/(.)/$l{my $a||$1}/g }
+is $_, "HELLO",
+  'logop in s/// repl does not result in "constant" repl optimisation';