This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Don’t point mother_re to regexp copy
authorFather Chrysostomos <sprout@cpan.org>
Mon, 29 Oct 2012 06:37:21 +0000 (23:37 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 30 Oct 2012 19:35:55 +0000 (12:35 -0700)
In code like this:

    $x = ${qr//};
    $y = $x
    undef $x;

We end up with $y’s mother_re pointer pointing to something that is
not a regexp.

This can cause thread cloning to create a new regexp with its SvPVX
pointing to the string buffer of the original regexp:

    $x = ${qr/abcd/};
    $y = $x;
    use Devel::Peek;
    Dump($y);
    $x = *3;
    use threads;
    async { Dump $y; print $y, "\n" }->join;

The dump shows that both $y’s share the same string buffer, and nei-
ther claims ownership to it.

I have not been able to make this crash or reuse the string for some-
thing else, but still this is walking a fine line.  Theoretically, it
should be possible for that string to be freed and reused in the par-
ent thread while the child thread is still using it.

Instead of pointing mother_re to the rhs of the assignment, point it
to the original re from which the rhs derives its existence.  I.e.,
copy the mother_re field.

regcomp.c

index d524a99..e18d1f4 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -14183,7 +14183,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
     SvFAKE_on(ret_x);
     ret = (struct regexp *)SvANY(ret_x);
     
     SvFAKE_on(ret_x);
     ret = (struct regexp *)SvANY(ret_x);
     
-    (void)ReREFCNT_inc(rx);
     /* We can take advantage of the existing "copied buffer" mechanism in SVs
        by pointing directly at the buffer, but flagging that the allocated
        space in the copy is zero. As we've just done a struct copy, it's now
     /* We can take advantage of the existing "copied buffer" mechanism in SVs
        by pointing directly at the buffer, but flagging that the allocated
        space in the copy is zero. As we've just done a struct copy, it's now
@@ -14215,7 +14214,7 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
 #ifdef PERL_OLD_COPY_ON_WRITE
     ret->saved_copy = NULL;
 #endif
 #ifdef PERL_OLD_COPY_ON_WRITE
     ret->saved_copy = NULL;
 #endif
-    ret->mother_re = rx;
+    ret->mother_re = ReREFCNT_inc(r->mother_re ? r->mother_re : rx);
     SvREFCNT_inc_void(ret->qr_anoncv);
     
     return ret_x;
     SvREFCNT_inc_void(ret->qr_anoncv);
     
     return ret_x;
@@ -14431,8 +14430,8 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
               2: something we no longer hold a reference on
               so we need to copy it locally.  */
            /* Note we need to use SvCUR(), rather than
               2: something we no longer hold a reference on
               so we need to copy it locally.  */
            /* Note we need to use SvCUR(), rather than
-              SvLEN(), on our mother_re, because it, in
-              turn, may well be pointing to its own mother_re.  */
+              SvLEN(), on our mother_re, because its buffer may not be
+              the same size as our newly-allocated one.  */
            SvPV_set(dstr, SAVEPVN(SvPVX_const(ret->mother_re),
                                   SvCUR(ret->mother_re)+1));
            SvLEN_set(dstr, SvCUR(ret->mother_re)+1);
            SvPV_set(dstr, SAVEPVN(SvPVX_const(ret->mother_re),
                                   SvCUR(ret->mother_re)+1));
            SvLEN_set(dstr, SvCUR(ret->mother_re)+1);