develooper Front page | perl.perl5.porters | Postings from April 2011

5.14.0 assertion failure (RT#76538)

From:
Michael Schroeder
Date:
April 28, 2011 06:51
Subject:
5.14.0 assertion failure (RT#76538)
Message ID:
20110428104540.GA31563@suse.de

Hi Porters,

This is about RT#76538, "Assertion failed: (rx->sublen >= (s
- rx->subbeg) + i), function Perl_reg_numbered_buff_fetch"

The following little test program still crashes for me:

    my @x = ("AX=B","AAAAAAX=");
    utf8::upgrade($x[1]);
    for (@x) {
      m{^([^=]+?)X\s*=.+$};
      print "-> $1\n";
    }

What happens is that $1 is already set when "AAAAAAX=" is
matched against the ^([^=]+?) part of the regexp, then
the swash needs to be created and Perl_save_re_context() is
called. save_re_context tries to save $1, but $1 is not
usable at the moment - it contains the new offsets (0-6), but
subbeg and sublen still point to the old match, as they
only get set at the end of the match.

I'm not sure about the best way to fix this. A quick and dirty
fix is to modify Perl_save_re_context() to not use save_scalar(),
but to use a variant that doesn't call SvGETMAGIC(). (The
current content of $1 needs to be saved, see #18107.)

--- ./regcomp.c.orig	2011-04-27 14:19:37.000000000 +0000
+++ ./regcomp.c	2011-04-27 14:21:58.000000000 +0000
@@ -9912,8 +9912,23 @@ Perl_save_re_context(pTHX)
 
 		if (gvp) {
 		    GV * const gv = *gvp;
-		    if (SvTYPE(gv) == SVt_PVGV && GvSV(gv))
-			save_scalar(gv);
+		    if (SvTYPE(gv) == SVt_PVGV && GvSV(gv)) {
+			/* this is a copy of save_scalar() without the GETMAGIC call, RT#76538 */
+			SV ** const sptr = &GvSVn(gv);
+			SV * osv = *sptr;
+			SV * nsv = newSV(0);
+			save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(osv), SAVEt_SV);
+			if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+			    if (SvGMAGICAL(osv)) {
+				const bool oldtainted = PL_tainted;
+				SvFLAGS(osv) |= (SvFLAGS(osv) &
+				    (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+				PL_tainted = oldtainted;
+			    }
+			    mg_localize(osv, nsv, 1);
+			}
+			*sptr = nsv;
+		    }
 		}
 	    }
 	}


A saner way would probably be to avoid the inconsistency between
offs and subbeg/sublen.

Cheers,
  Michael.

-- 
Michael Schroeder                                   mls@suse.de
SUSE LINUX Products GmbH, GF Markus Rex, HRB 16746 AG Nuernberg
main(_){while(_=~getchar())putchar(~_-1/(~(_|32)/13*2-11)*13);}



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