From: Adrian M. Enache <enache@rdslink.ro>
Date: Wed, 18 Jun 2003 23:00:43 +0000 (+0300)
Subject: Re: [perl #22727] split() with re_eval segfaults/panics
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=080c2decc1c1070c5ce819e741a37407aa249711;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #22727] split() with re_eval segfaults/panics
Message-ID: <20030618200043.GA1249@ratsnest.hole>

p4raw-id: //depot/perl@19814
---

diff --git a/pp.c b/pp.c
index eccf7eb..fc6a7bf 100644
--- a/pp.c
+++ b/pp.c
@@ -4658,13 +4658,13 @@ PP(pp_split)
     }
     else {
 	maxiters += slen * rx->nparens;
-	while (s < strend && --limit
-/*	       && (!rx->check_substr
-		   || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
-						 0, NULL))))
-*/	       && CALLREGEXEC(aTHX_ rx, s, strend, orig,
-			      1 /* minend */, sv, NULL, 0))
+	while (s < strend && --limit)
 	{
+	    PUTBACK;
+	    i = CALLREGEXEC(aTHX_ rx, s, strend, orig, 1 , sv, NULL, 0);
+	    SPAGAIN;
+	    if (i == 0)
+		break;
 	    TAINT_IF(RX_MATCH_TAINTED(rx));
 	    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
 		m = s;
@@ -4703,7 +4703,6 @@ PP(pp_split)
 		}
 	    }
 	    s = rx->endp[0] + orig;
-	    PUTBACK;
 	}
     }
 
diff --git a/regexec.c b/regexec.c
index 7acee5b..db3cecb 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2835,6 +2835,7 @@ S_regmatch(pTHX_ regnode *prog)
 	    COP *ocurcop = PL_curcop;
 	    PAD *old_comppad;
 	    SV *ret;
+	    struct regexp *oreg = PL_reg_re;
 	
 	    n = ARG(scan);
 	    PL_op = (OP_4tree*)PL_regdata->data[n];
@@ -2967,8 +2968,10 @@ S_regmatch(pTHX_ regnode *prog)
 		sw = SvTRUE(ret);
 		logical = 0;
 	    }
-	    else
+	    else {
 		sv_setsv(save_scalar(PL_replgv), ret);
+		cache_re(oreg);
+	    }
 	    break;
 	}
 	case OPEN:
diff --git a/t/op/pat.t b/t/op/pat.t
index ccf57a1..0b49054 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..1004\n";
+print "1..1006\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3140,7 +3140,15 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
 {
     my $i;
     ok('-1-3-5-' eq join('', split /((??{$i++}))/, '-1-3-5-'),
-	"[perl #21411] (??{ .. }) corrupts split's stack")
+	"[perl #21411] (??{ .. }) corrupts split's stack");
+    split /(?{'WOW'})/, 'abc';
+    ok('a|b|c' eq join ('|', @_),
+       "[perl #21411] (?{ .. }) version of the above");
+}
+
+{
+    split /(?{ split "" })/, "abc";
+    ok(1,'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0');
 }
 
 {