Re: [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps

On Sun, Oct 18, 2009 at 02:32:51PM +0100, Nicholas Clark wrote:
> On Sun, Oct 18, 2009 at 03:22:21PM +0200, demerphq wrote:
> > 2009/10/17 Nicholas Clark <perlbug-followup@perl.org>:
> 
> > > I don't think that there's actually a ticket associated with the TODO tests in
> > > t/re/qr_gc.t
> > 
> > Why should it? Why are we persisting with the Regexp class at all?
> > Afaik it was never really useful.
> 
> It's not the class specifically. It's that the reference count on a regexp
> object (whatever its class) starts out as 2, not 1. Which seems wrong.

Whilst t/re/qr_gc.t notes that change 32751 first displayed the symptoms, this
is actually a bit of a red herring. Regexp::DESTROY isn't called, because that
change stopped (automatically) blessing (now first class) regexps into a class.

If you explicitly bless your regexp into 'Regexp', then Regexp::DESTROY is
called on it at the time you expect.

The real culprit is 288b8c02c5ee89a2978a1b9e56ed255c53beb793

    Make struct regexp the body of SVt_REGEXP SVs, REGEXPs become SVs,
    and regexp reference counting is via the regular SV reference counting.
    This was not as easy at it looks.
    
    p4raw-id: //depot/perl@32804


In particular, this part with the helpful comment:

diff --git a/pp_hot.c b/pp_hot.c
index e686b2a..9099c88 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1194,11 +1194,21 @@ PP(pp_qr)
     REGEXP * rx = PM_GETRE(pm);
     SV * const pkg = CALLREG_PACKAGE(rx);
     SV * const rv = sv_newmortal();
-    SV * const sv = newSVrv(rv, pkg ? SvPV_nolen(pkg) : NULL);
+
+    SvUPGRADE(rv, SVt_IV);
+    /* This RV is about to own a reference to the regexp. (In addition to the
+       reference already owned by the PMOP.  */
+    ReREFCNT_inc(rx);
+    SvRV_set(rv, rx);
+    SvROK_on(rv);
+
+    if (pkg) {
+	HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+	(void)sv_bless(rv, stash);
+    }
+
     if (RX_EXTFLAGS(rx) & RXf_TAINTED)
         SvTAINTED_on(rv);
-    sv_upgrade(sv, SVt_REGEXP);
-    ((struct xregexp *)SvANY(sv))->xrx_regexp = ReREFCNT_inc(rx);
     XPUSHs(rv);
     RETURN;
 }


Before that change:

$ ./miniperl -le 'sub Foo::DESTROY {warn "DESTROY called"}; { my $a = bless qr//, "Foo"}; END {warn "END"}'
DESTROY called at -e line 1.
END at -e line 1.

After that change:

$ ./miniperl -le 'sub Foo::DESTROY {warn "DESTROY called"}; { my $a = bless qr//, "Foo"}; END {warn "END"}'
END at -e line 1.
DESTROY called at -e line 1.

There is no actual leak. Just a failure to stop existing until global
destruction.


This is actually a problem.

Before:

$ ./miniperl -le 'sub r{ qr//; } print ref r(); print ref r(); bless r(); print ref r()'
Regexp
Regexp
Regexp

After:

$ ./miniperl -le 'sub r{ qr//; } print ref r(); print ref r(); bless r(); print ref r()'
Regexp
Regexp
main

And with the addition of the ability to dereference and assign to regexps
(which at the time I wasn't sure about, but didn't comment on):

$ ./perl -le 'sub r {qr/Pie Good/}; $a = r(); print $a; ${r()} = "Whoops"; print r(); print $a'
(?-xism:Pie Good)
Whoops
Whoops


Yes. You can change the regexp that is somewhere else, because qr// doesn't
actually create you a new regexp, but instead simply returns you a reference
to the same (first class) object in the optree.

We're going to need to fix all of this.

Nicholas Clark

• [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by Nicholas Clark via RT
• [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by Nicholas Clark
• Re: [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by demerphq
• Re: [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by Nicholas Clark
• Re: [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by Nicholas Clark
• Re: [perl #69852] Regexp::DESTROY doesn't trigger with first classregexps by Paul LeoNerd Evans
• Re: [perl #69852] Regexp::DESTROY doesn't trigger with first class regexps by demerphq