develooper Front page | perl.perl5.porters | Postings from May 2006

Re: [perl #32332] Perl segfaults; test case available

Thread Previous
From:
Dave Mitchell
Date:
May 20, 2006 05:00
Subject:
Re: [perl #32332] Perl segfaults; test case available
Message ID:
20060520120104.GA2900@iabyn.com
On Thu, Mar 30, 2006 at 07:34:37PM -0800, Steve Peters via RT wrote:
> > [timwi - Thu Nov 04 16:53:40 2004]:
> > Perl segfaults upon the execution of the following 26-line script.
> > 
> > If you don't get the segfault, try duplicating lines 14-16 (the
> > contents of the 'starthere' string). The more you put in, the
> > more likely you are to get the segfault.
> > 
> > I am aware that line 19 (my $ac = '';) seems pointless, because
> > $ac is never used again anywhere. However, if I remove that line,
> > then instead of a segfault it gets stuck in an endless loop...
> > 
> > I have a suspicion that line 22 is the actual culprit.
> > 
> > Here is the script.
> > 
> > #!/usr/bin/perl
> > use strict;
> > SegFaultFunction ('starthere');
> > 
> > sub SegFaultFunction {
> >      my $variable = shift;
> >      my $params = shift;
> >      my $cns =   {   'abcdefg' => sub {
> >                          return (shift)->{'x'};
> >                      },
> >                      starthere => "
> >                          <?abcdefg <?xy xy?> abcdefg?>
> >                          <?abcdefg <?xy xy?> abcdefg?>
> >                          <?abcdefg <?xy xy?> abcdefg?>
> >                      ",
> >                  }->{$variable};
> >      $cns = $cns->($params) if ref $cns eq 'CODE';
> >      while ($cns =~ s/^(.*?)(?=<\?)//os) {
> >          my $ac = '';
> >          if ($cns =~ /^<\?([a-zA-Z0-9_]+)(\s|$)/os) {
> >              my $var = $1;
> >              ($cns =~ s/^.*?$var\?>/ $_=$&; s!^.*<\?$var\s*(.*?)\s*$var\?>!
> >                  SegFaultFunction ($var, { x => $1 }); !es; $_ /es);
> >          }
> >      }
> > }
> > 
> 
> Welcome to a completely different problem!
> 
> steve@kirk:~/smoke/perl-current$ ./perl -Ilib rt_32332.pl 
> *** glibc detected *** double free or corruption (fasttop): 0x08297730 ***
> Aborted (core dumped)

fixed by the change below. The refcounting of REs got a bit messed up.

-- 
The crew of the Enterprise encounter an alien life form which is
suprisingly neither humanoid nor made from pure energy.
    -- Things That Never Happen in "Star Trek" #22

Change 28251 by davem@davem-splatty on 2006/05/20 11:58:07

	[perl #32332] Perl segfaults; test case available
	sub f { s/$var/f()/e } could free the wrong RE

Affected files ...

... //depot/perl/cop.h#118 edit
... //depot/perl/pp_ctl.c#566 edit
... //depot/perl/pp_hot.c#468 edit

Differences ...

==== //depot/perl/cop.h#118 (text) ====

@@ -576,10 +576,12 @@
 	cx->sb_rxres		= NULL,					\
 	cx->sb_rx		= rx,					\
 	cx->cx_type		= CXt_SUBST;				\
-	rxres_save(&cx->sb_rxres, rx)
+	rxres_save(&cx->sb_rxres, rx);					\
+	ReREFCNT_inc(rx)
 
 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--];			\
-	rxres_free(&cx->sb_rxres)
+	rxres_free(&cx->sb_rxres);					\
+	ReREFCNT_dec(cx->sb_rx)
 
 struct context {
     U32		cx_type;	/* what kind of context this is */

==== //depot/perl/pp_ctl.c#566 (text) ====

@@ -197,7 +197,7 @@
     if(old != rx) {
 	if(old)
 	    ReREFCNT_dec(old);
-	PM_SETRE(pm,rx);
+	PM_SETRE(pm,ReREFCNT_inc(rx));
     }
 
     rxres_restore(&cx->sb_rxres, rx);
@@ -256,7 +256,6 @@
 	    SvTAINT(targ);
 
 	    LEAVE_SCOPE(cx->sb_oldsave);
-	    ReREFCNT_dec(rx);
 	    POPSUBST(cx);
 	    RETURNOP(pm->op_next);
 	}

==== //depot/perl/pp_hot.c#468 (text) ====

@@ -2303,7 +2303,6 @@
 	if (!c) {
 	    register PERL_CONTEXT *cx;
 	    SPAGAIN;
-	    (void)ReREFCNT_inc(rx);
 	    PUSHSUBST(cx);
 	    RETURNOP(cPMOP->op_pmreplroot);
 	}

Thread Previous


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