From: Yves Orton <demerphq@gmail.com>
Date: Sat, 29 Dec 2007 13:26:35 +0000 (+0000)
Subject: Fix Perl #49190, tests from Abigail, codefix from me.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10300be4785857111b4e5614934a2d871b62b6ce;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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";
 }