Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD

Front page | perl.perl5.porters | Postings from April 2003

Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD

Thread Previous | Thread Next

From:

Enache Adrian

Date:

April 1, 2003 18:01

Subject:

Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD

Message ID:

20030402020242.GA2966@ratsnest.hole

> > When the time comes for the qr// to be freed, the code inside
> > sv_clear() tries to call its DESTROY method - since it is an
> > object. (sv.c:5261)
> > DESTROY doesn't exist in the 'Regexp' stash: if the user defined
> > a UNIVERSAL::AUTOLOAD sub, that will be called instead.
> > If that AUTOLOAD uses qr//'s, the recursion happens.
...
> > I have 2 ideas to fix that:
...
> > 2) Put a dummy DESTROY method in the 'Regexp' stash.

Here is a patch that does the second ( in the most naive way )

I added a new test file too (t/run/crash.t) to test for this
kind of final cleanup crashes, etc. The first test there is
for another bug, see
    http://nntp.perl.org/group/perl.perl5.porters/73117

I didn't think it should be a TODO test since it's already done :)

Regards
Adi

--------------------------------------------------------------------
Index: MANIFEST
===================================================================
RCS file: /opt/cvsroot/perl/perl/MANIFEST,v
retrieving revision 1.1.1.1.2.1
diff -u -r1.1.1.1.2.1 MANIFEST
--- MANIFEST	1 Apr 2003 21:29:16 -0000	1.1.1.1.2.1
+++ MANIFEST	2 Apr 2003 00:48:55 -0000
@@ -2701,6 +2701,7 @@
 t/pod/testpchk.pl		Module to test Pod::Checker for a given file
 t/pod/testpods/lib/Pod/Stuff.pm			Sample data for find.t
 t/README			Instructions for regression tests
+t/run/crash.t			Different crashes, most during final cleanup
 t/run/exit.t			Test perl's exit status.
 t/run/fresh_perl.t		Tests that require a fresh perl.
 t/run/noswitch.t		Test aliasing ARGV for other switch tests
Index: universal.c
===================================================================
RCS file: /opt/cvsroot/perl/perl/universal.c,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 universal.c
--- universal.c	1 Apr 2003 21:12:03 -0000	1.1.1.1
+++ universal.c	1 Apr 2003 23:42:34 -0000
@@ -176,6 +176,7 @@
 XS(XS_Internals_SvREADONLY);
 XS(XS_Internals_SvREFCNT);
 XS(XS_Internals_hv_clear_placehold);
+XS(XS_Regexp_DESTROY);
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
@@ -214,6 +215,8 @@
     newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
     newXSproto("Internals::hv_clear_placeholders",
                XS_Internals_hv_clear_placehold, file, "\\%");
+
+    newXS("Regexp::DESTROY", XS_Regexp_DESTROY, file);
 }
 
 
@@ -713,4 +716,9 @@
     }
 
     XSRETURN(0);
+}
+
+XS(XS_Regexp_DESTROY)
+{
+
 }
Index: ext/B/t/stash.t
===================================================================
RCS file: /opt/cvsroot/perl/perl/ext/B/t/stash.t,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 stash.t
--- ext/B/t/stash.t	1 Apr 2003 21:12:05 -0000	1.1.1.1
+++ ext/B/t/stash.t	2 Apr 2003 00:33:09 -0000
@@ -66,7 +66,7 @@
 
 $got = "@got";
 
-my $expected = "attributes Carp Carp::Heavy DB Exporter Exporter::Heavy Internals main utf8 version warnings";
+my $expected = "attributes Carp Carp::Heavy DB Exporter Exporter::Heavy Internals main Regexp utf8 version warnings";
 
 {
     no strict 'vars';
Index: t/run/crash.t
===================================================================
RCS file: t/run/crash.t
diff -N t/run/crash.t
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ t/run/crash.t	2 Apr 2003 00:14:21 -0000
@@ -0,0 +1,14 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+require './test.pl';
+
+plan(tests => 2);
+
+runperl(prog => 'sub UNIVERSAL::DESTROY { warn } bless \$a, A', stderr => 1);
+ok ($? == 0, 'warn called inside UNIVERSAL::DESTROY { }');
+
+runperl(prog => 'sub UNIVERSAL::AUTOLOAD { qr// } a->p' );
+ok ($? == 0, 'UNIVERSAL::AUTOLOAD called when freeing qr//');

Thread Previous | Thread Next