From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 22 Aug 2013 04:59:20 +0000 (-0700)
Subject: [perl #118747] Allow in-place s///g when !!PL_sawampersand
X-Git-Tag: v5.19.4~463
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/9cefd268f0a1c07e6746eef1c037efc657387f21

[perl #118747] Allow in-place s///g when !!PL_sawampersand

This is the more correct version of 1555b325 which was reverted
by 6200d5a0e.

In pp_subst, there is an initial pattern match against the target
string, followed by logic to determine which of several code paths
will handle the rest of the substitution, depending on which shortcuts
can be taken.

There is one path specifically for doing a global sort (/g) and modi-
fying the target in place.  This code was skipped if the target was a
copy-on-write scalar or if the pre-match copy was enabled.  The pre-
match copy is always enabled now, so this code is unreachable.

In-place substitution stringifies the rhs at the outset, just after
the first regexp match, but before any substitution.  Then it uses
that string buffer, expecting it not to change.

That clearly cannot work with s/a/$&/g; it will also cause erratic
behaviour in the case of regexp code blocks (which will see the
string being modified, which doesn not happen with unoptimised subst).
That’s why the in-place optimisation has to be skipped when the
REXEC_COPY_STR flag is set.

But we can tweak that logic:

• As long as the rhs is not a magical var, its contents are not going
  to change from one iteration to the next.
• If there are no code blocks, nothing will see the string during the
  substitution.

So this commit adds logic to check those things, enabling this opti-
misation where possible.

Skipping this optimisation for the pre-match copy was originally added
in commit 5d5aaa5e7.
---

diff --git a/pp_hot.c b/pp_hot.c
index c30acc5..75e5d65 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2159,7 +2159,10 @@ PP(pp_subst)
 	&& !is_cow
 #endif
         && (I32)clen <= RX_MINLENRET(rx)
-        && (once || !(r_flags & REXEC_COPY_STR))
+        && (  once
+           || !(r_flags & REXEC_COPY_STR)
+           || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN))
+           )
         && !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST)
 	&& (!doutf8 || SvUTF8(TARG))
 	&& !(rpm->op_pmflags & PMf_NONDESTRUCT))