develooper Front page | perl.perl5.porters | Postings from January 2004

Re: [perl #24898] Segfault with complicated regex inside map. 5.8 .1 and beyond. [PATCH], to be checked.

Thread Next
From:
LAUN Wolfgang
Date:
January 14, 2004 23:42
Subject:
Re: [perl #24898] Segfault with complicated regex inside map. 5.8 .1 and beyond. [PATCH], to be checked.
Message ID:
DF27CDCBD2581D4B88431901094E4B4D02B0C4D8@attmsx1
abigail@abigail.nl (via RT) <perlbug-followup@perl.org> writes:
>
> I'm getting a segmentation fault when using a complicated regex inside
> a map. Consider the following program:
>
>    my $MAX = shift || 100;
>    my $re = qr /^(1+)(??{"(?:$1){" . (length ($1) - 1) . "}" })$/;
>    map {printf "%3d is a square\n" =&gt; $_ if (1 x $_) =~ /$re/} 1 .. $MAX;

The trouble arises when the stack is reallocated while pp_match is
active, which finally restores the dSP-saved stack pointer, with
PL_stack_base now being elsewhere.

I tried to hatch a patch for pp_match. Please check with utmost care.

Also, I found a call to PL_regexecp (CALLREGEXEC) in pp_ctl.c where I didn't
see SPAGAIN.

Wouldn't it be useful (certainly only in debug mode) to do a save of
PL_stack_base together with dSP, and an update toghether with SPAGAIN,
and to add an assertion (saved_PL_stack_base == PL_stack_base) to
RETURN-type (or other?) macros?

Regards
Wolfgang

--- pp_hot.c.old	Thu Jan 15 07:51:29 2004
+++ pp_hot.c	Thu Jan 15 07:50:38 2004
@@ -1315,13 +1315,16 @@
     }
     if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
     {
+	SPAGAIN;			/* EVAL blocks could move the stack. */
 	PL_curpm = pm;
 	if (dynpm->op_pmflags & PMf_ONCE)
 	    dynpm->op_pmdynflags |= PMdf_USED;
 	goto gotcha;
     }
-    else
+    else{
+	SPAGAIN;			/* EVAL blocks could move the stack. */
 	goto ret_no;
+    }
     /*NOTREACHED*/
 
   gotcha:
@@ -1336,7 +1339,6 @@
 	    i = 1;
 	else
 	    i = 0;
-	SPAGAIN;			/* EVAL blocks could move the stack. */
 	EXTEND(SP, nparens + i);
 	EXTEND_MORTAL(nparens + i);
 	for (i = !i; i <= nparens; i++) {
--- pp_ctl.c.act	Sun Jan 11 10:54:08 2004
+++ pp_ctl.c	Thu Jan 15 08:18:14 2004
@@ -173,6 +173,7 @@
 
     if (cx->sb_iters++) {
 	I32 saviters = cx->sb_iters;
+	bool done;
 	if (cx->sb_iters > cx->sb_maxiters)
 	    DIE(aTHX_ "Substitution loop");
 
@@ -181,11 +182,16 @@
 	sv_catsv(dstr, POPs);
 
 	/* Are we done */
-	if (cx->sb_once || !CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,
-				     s == m, cx->sb_targ, NULL,
-				     ((cx->sb_rflags & REXEC_COPY_STR)
-				      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
-				      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
+	done = cx->sb_once;
+	if (! done) {
+	    done = ! CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,
+			     s == m, cx->sb_targ, NULL,
+			     ((cx->sb_rflags & REXEC_COPY_STR)
+			      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
+			      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST)));
+	    SPAGAIN;
+	}
+	if (done)
 	{
 	    SV *targ = cx->sb_targ;
 

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About