Fix Perl #49190, tests from Abigail, codefix from me.

p4raw-id: //depot/perl@32761

diff --git a/pp_hot.c b/pp_hot.c
index 5cc8087..f987357 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2035,6 +2035,7 @@ PP(pp_subst)
     const I32 oldsave = PL_savestack_ix;
     STRLEN slen;
     bool doutf8 = FALSE;
+    I32 matched;
 #ifdef PERL_OLD_COPY_ON_WRITE
     bool is_cow;
 #endif
@@ -2121,7 +2122,8 @@ PP(pp_subst)
 
     /* only replace once? */
     once = !(rpm->op_pmflags & PMf_GLOBAL);
-
+    matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
+                        r_flags | REXEC_CHECKED);
     /* known replacement string? */
     if (dstr) {
        /* replacement needing upgrading? */
@@ -2153,8 +2155,7 @@ PP(pp_subst)
        && (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
        && !(rx->extflags & RXf_LOOKBEHIND_SEEN)
        && (!doutf8 || SvUTF8(TARG))) {
-       if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
-                        r_flags | REXEC_CHECKED))
+       if (!matched)
        {
            SPAGAIN;
            PUSHs(&PL_sv_no);
@@ -2258,8 +2259,7 @@ PP(pp_subst)
        RETURN;
     }
 
-    if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
-                   r_flags | REXEC_CHECKED))
+    if (matched)
     {
        if (force_on_match) {
            force_on_match = 0;

diff --git a/t/op/pat.t b/t/op/pat.t
index 821e652..26c4cb3 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4511,13 +4511,20 @@ sub kt
         }
     }
 }
-
 {
     my $a = 3; "" =~ /(??{ $a })/;
     my $b = $a;
     iseq($b, $a, "copy of scalar used for postponed subexpression");
 }
-
+{
+     local $Message = "\$REGMARK in replacement -- Bug #49190";
+     my $_ = "A";
+     s/(*:B)A/$REGMARK/;
+     iseq $_, "B";
+     $_ = "CCCCBAA";
+     s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g;
+     iseq $_, "ZYX";
+}
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4576,6 +4583,6 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
 iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
 BEGIN {
-    $::TestCount = 4014;
+    $::TestCount = 4016;
     print "1..$::TestCount\n";
 }