Skip Menu |
Report information
Id: 36347
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: nicholas <nick [at] ccl4.org>
Cc:
AdminCc:

Operating System: darwin
PatchStatus: (no value)
Severity: low
Type:
Perl Version: 5.9.3
Fixed In: (no value)



Subject: Object destruction incomplete
Date: Tue, 21 Jun 2005 14:52:14 +0100
To: perlbug [...] perl.org
From: Nicholas Clark <nick [...] ccl4.org>
Download (untitled) / with headers
text/plain 3.7k
This is a bug report for perl from nick@ccl4.org, generated with the help of perlbug 1.35 running under perl vv5.9.3. ----------------------------------------------------------------- [Please enter your report here] It's possible to create objects that never get destroyed. Tersest example: #!perl -w use strict; use vars '@a'; package M; sub DESTROY {warn "Farewell $_[0]"} package main; bless \($a[0]), "M"; #undef @a; __END__ Without the undef @::a; it will never call the destructor, because do_clean_objs only looks for references to objects and objects that typeglobs point to, rather than objects themselves. Should we replace the use of do_clean_named_objs() with a routine that searches directly for any remaining objects, and directly reduces their reference counts? Nicholas Clark [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl vv5.9.3: Configured by nick at Sun Jun 19 15:22:28 BST 2005. Summary of my perl5 (revision 5 version 9 subversion 3 patch 24148) configuration: Platform: osname=darwin, osvers=7.9.0, archname=darwin-thread-multi-2level uname='darwin ship-in-a-bottle 7.9.0 darwin kernel version 7.9.0: wed mar 30 20:11:17 pst 2005; root:xnuxnu-517.12.7.obj~1release_ppc power macintosh powerpc ' config_args='-Dusedevel=y -Dcc=ccache gcc -Dld=gcc -Ubincompat5005 -Uinstallusrbinperl -Dcf_email=nick@ccl4.org -Dperladmin=nick@ccl4.org -Doptimize=-Os -Dusethreads=y -Uuse64bitint -Dprefix=~/Sandpit/blead-Os -de' hint=previous, useposix=true, d_sigaction=define usethreads=define useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='ccache gcc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe', optimize='-Os', cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe' ccversion='', gccversion='3.3 20030304 (Apple Computer, Inc. build 1666)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /usr/lib libs=-ldbm -ldl -lm -lc perllibs=-ldl -lm -lc libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a gnulibc_version='' Dynamic Linking: dlsrc=dl_dyld.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib' Locally applied patches: --- @INC for perl vv5.9.3: lib /sw/lib/perl5 /sw/lib/perl5/darwin /Users/nick/Sandpit/blead-Os/lib/perl5/5.9.3/darwin-thread-multi-2level /Users/nick/Sandpit/blead-Os/lib/perl5/5.9.3 /Users/nick/Sandpit/blead-Os/lib/perl5/site_perl/5.9.3/darwin-thread-multi-2level /Users/nick/Sandpit/blead-Os/lib/perl5/site_perl/5.9.3 /Users/nick/Sandpit/blead-Os/lib/perl5/site_perl . --- Environment for perl vv5.9.3: DYLD_LIBRARY_PATH (unset) HOME=/Users/nick LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/Users/nick/bin:/sw/bin:/sw/sbin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/sbin:/sbin:/usr/sbin PERL5LIB=/sw/lib/perl5:/sw/lib/perl5/darwin PERL_BADLANG (unset) SHELL=/bin/bash
Subject: [PATCH] Re: [perl #36347] Object destruction incomplete
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 658b
On Tue Jun 21 06:52:36 2005, nicholas wrote: Show quoted text
> Should we replace the use of do_clean_named_objs() with a routine that > searches directly for any remaining objects, and directly reduces > their > reference counts?
Doing so would allow destructors to see freed SVs. Instead, how’s this patch? It still needs tests and a commit message. Watch: $ perl -le' sub DESTROY{warn aaa}bless\$a[0]' $ ./perl -le' sub DESTROY{warn aaa}bless\$a[0]' aaa at -e line 1 during global destruction. $ perl -le' { bless \my@x; *a=sub{@x}}sub DESTROY{warn aaa}' $ ./perl -le' { bless \my@x; *a=sub{@x}}sub DESTROY{warn aaa}' aaa at -e line 1 during global destruction.
Download open_D3Tt27T1.txt
text/plain 6.2k
diff --git a/embed.fnc b/embed.fnc index fe8f43c..88e179b 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1167,6 +1167,9 @@ pd |I32 |sv_clean_all : Used only in perl.c pd |void |sv_clean_objs Apd |void |sv_clear |NN SV *const orig_sv +#if defined(PERL_IN_SV_C) +s |bool |curse |NN SV * const sv|const bool check_refcnt +#endif Aopd |I32 |sv_cmp |NULLOK SV *const sv1|NULLOK SV *const sv2 Apd |I32 |sv_cmp_flags |NULLOK SV *const sv1|NULLOK SV *const sv2 \ |const U32 flags diff --git a/embed.h b/embed.h index d484a10..6a4e48e 100644 --- a/embed.h +++ b/embed.h @@ -1776,6 +1776,7 @@ #define F0convert S_F0convert #define anonymise_cv_maybe(a,b) S_anonymise_cv_maybe(aTHX_ a,b) #define assert_uft8_cache_coherent(a,b,c,d) S_assert_uft8_cache_coherent(aTHX_ a,b,c,d) +#define curse(a,b) S_curse(aTHX_ a,b) #define expect_number(a) S_expect_number(aTHX_ a) #define find_array_subscript(a,b) S_find_array_subscript(aTHX_ a,b) #define find_hash_subscript(a,b) S_find_hash_subscript(aTHX_ a,b) diff --git a/proto.h b/proto.h index a05f2b9..92202de 100644 --- a/proto.h +++ b/proto.h @@ -6567,6 +6567,11 @@ STATIC void S_assert_uft8_cache_coherent(pTHX_ const char *const func, STRLEN fr #define PERL_ARGS_ASSERT_ASSERT_UFT8_CACHE_COHERENT \ assert(func); assert(sv) +STATIC bool S_curse(pTHX_ SV * const sv, const bool check_refcnt) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_CURSE \ + assert(sv) + STATIC I32 S_expect_number(pTHX_ char **const pattern) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); diff --git a/sv.c b/sv.c index 92634e1..598c29a 100644 --- a/sv.c +++ b/sv.c @@ -542,6 +542,15 @@ do_clean_named_io_objs(pTHX_ SV *const sv) SvREFCNT_dec(sv); /* undo the inc above */ } +/* Void wrapper to pass to visit() */ +static void +do_curse(pTHX_ SV * const sv) { + if ((PL_stderrgv && GvGP(PL_stderrgv) && GvSV(PL_stderrgv) == sv) + || (PL_defoutgv && GvGP(PL_defoutgv) && GvSV(PL_defoutgv) == sv)) + return; + (void)curse(sv, 0); +} + /* =for apidoc sv_clean_objs @@ -562,6 +571,9 @@ Perl_sv_clean_objs(pTHX) * error messages, close files etc */ visit(do_clean_named_objs, SVt_PVGV|SVpgv_GP, SVTYPEMASK|SVp_POK|SVpgv_GP); visit(do_clean_named_io_objs, SVt_PVGV|SVpgv_GP, SVTYPEMASK|SVp_POK|SVpgv_GP); + /* And if there are some very tenacious barnacles clinging to arrays, + closures, or what have you.... */ + visit(do_curse, SVs_OBJECT, SVs_OBJECT); olddef = PL_defoutgv; PL_defoutgv = NULL; /* disable skip of PL_defoutgv */ if (olddef && isGV_with_GP(olddef)) @@ -5948,65 +5960,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) } if (SvOBJECT(sv)) { - if (PL_defstash && /* Still have a symbol table? */ - SvDESTROYABLE(sv)) - { - dSP; - HV* stash; - do { - CV* destructor; - stash = SvSTASH(sv); - destructor = StashHANDLER(stash,DESTROY); - if (destructor - /* A constant subroutine can have no side effects, so - don't bother calling it. */ - && !CvCONST(destructor) - /* Don't bother calling an empty destructor */ - && (CvISXSUB(destructor) - || (CvSTART(destructor) - && (CvSTART(destructor)->op_next->op_type - != OP_LEAVESUB)))) - { - SV* const tmpref = newRV(sv); - SvREADONLY_on(tmpref); /* DESTROY() could be naughty */ - ENTER; - PUSHSTACKi(PERLSI_DESTROY); - EXTEND(SP, 2); - PUSHMARK(SP); - PUSHs(tmpref); - PUTBACK; - call_sv(MUTABLE_SV(destructor), - G_DISCARD|G_EVAL|G_KEEPERR|G_VOID); - POPSTACK; - SPAGAIN; - LEAVE; - if(SvREFCNT(tmpref) < 2) { - /* tmpref is not kept alive! */ - SvREFCNT(sv)--; - SvRV_set(tmpref, NULL); - SvROK_off(tmpref); - } - SvREFCNT_dec(tmpref); - } - } while (SvOBJECT(sv) && SvSTASH(sv) != stash); - - - if (SvREFCNT(sv)) { - if (PL_in_clean_objs) - Perl_croak(aTHX_ - "DESTROY created new reference to dead object '%s'", - HvNAME_get(stash)); - /* DESTROY gave object new lease on life */ - goto get_next_sv; - } - } - - if (SvOBJECT(sv)) { - SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ - SvOBJECT_off(sv); /* Curse the object. */ - if (type != SVt_PVIO) - --PL_sv_objcount;/* XXX Might want something more general */ - } + if (!curse(sv, 1)) goto get_next_sv; } if (type >= SVt_PVMG) { if (type == SVt_PVMG && SvPAD_OUR(sv)) { @@ -6232,6 +6186,78 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) } /* while sv */ } +/* This routine curses the sv itself, not the object referenced by sv. So + sv does not have to be ROK. */ + +static bool +S_curse(pTHX_ SV * const sv, const bool check_refcnt) { + dVAR; + + PERL_ARGS_ASSERT_CURSE; + assert(SvOBJECT(sv)); + + if (PL_defstash && /* Still have a symbol table? */ + SvDESTROYABLE(sv)) + { + dSP; + HV* stash; + do { + CV* destructor; + stash = SvSTASH(sv); + destructor = StashHANDLER(stash,DESTROY); + if (destructor + /* A constant subroutine can have no side effects, so + don't bother calling it. */ + && !CvCONST(destructor) + /* Don't bother calling an empty destructor */ + && (CvISXSUB(destructor) + || (CvSTART(destructor) + && (CvSTART(destructor)->op_next->op_type + != OP_LEAVESUB)))) + { + SV* const tmpref = newRV(sv); + SvREADONLY_on(tmpref); /* DESTROY() could be naughty */ + ENTER; + PUSHSTACKi(PERLSI_DESTROY); + EXTEND(SP, 2); + PUSHMARK(SP); + PUSHs(tmpref); + PUTBACK; + call_sv(MUTABLE_SV(destructor), + G_DISCARD|G_EVAL|G_KEEPERR|G_VOID); + POPSTACK; + SPAGAIN; + LEAVE; + if(SvREFCNT(tmpref) < 2) { + /* tmpref is not kept alive! */ + SvREFCNT(sv)--; + SvRV_set(tmpref, NULL); + SvROK_off(tmpref); + } + SvREFCNT_dec(tmpref); + } + } while (SvOBJECT(sv) && SvSTASH(sv) != stash); + + + if (check_refcnt && SvREFCNT(sv)) { + if (PL_in_clean_objs) + Perl_croak(aTHX_ + "DESTROY created new reference to dead object '%s'", + HvNAME_get(stash)); + /* DESTROY gave object new lease on life */ + return FALSE; + } + } + + if (SvOBJECT(sv)) { + SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ + SvOBJECT_off(sv); /* Curse the object. */ + if (SvTYPE(sv) != SVt_PVIO) + --PL_sv_objcount;/* XXX Might want something more general */ + } + return TRUE; +} + /* =for apidoc sv_newref
CC: perl5-porters [...] perl.org
Subject: Re: [PATCH] Re: [perl #36347] Object destruction incomplete
Date: Tue, 14 Dec 2010 23:57:22 +0000
To: Father Chrysostomos via RT <perlbug-followup [...] perl.org>
From: Dave Mitchell <davem [...] iabyn.com>
Download (untitled) / with headers
text/plain 621b
On Sun, Dec 12, 2010 at 01:00:17PM -0800, Father Chrysostomos via RT wrote: Show quoted text
> On Tue Jun 21 06:52:36 2005, nicholas wrote:
> > Should we replace the use of do_clean_named_objs() with a routine that > > searches directly for any remaining objects, and directly reduces > > their > > reference counts?
> > Doing so would allow destructors to see freed SVs. > > Instead, how’s this patch? It still needs tests and a commit message.
Looks plausible. I don't understand why you skip $STDOUT and $STDERR though. -- A walk of a thousand miles begins with a single step... then continues for another 1,999,999 or so.
RT-Send-CC: perl5-porters [...] perl.org, davem [...] iabyn.com
Download (untitled) / with headers
text/plain 732b
On Tue Dec 14 15:57:54 2010, davem wrote: Show quoted text
> On Sun, Dec 12, 2010 at 01:00:17PM -0800, Father Chrysostomos via RT
wrote: Show quoted text
> > On Tue Jun 21 06:52:36 2005, nicholas wrote:
> > > Should we replace the use of do_clean_named_objs() with a routine that > > > searches directly for any remaining objects, and directly reduces > > > their > > > reference counts?
> > > > Doing so would allow destructors to see freed SVs. > > > > Instead, how’s this patch? It still needs tests and a commit message.
> > Looks plausible. I don't understand why you skip $STDOUT and $STDERR > though.
do_clean_named_io_objs does the same thing. I thought it was so that destructors would be able to warn(). (And I thought you wrote that code, too.)
CC: perl5-porters [...] perl.org
Subject: Re: [perl #36347] Object destruction incomplete
Date: Sun, 19 Dec 2010 22:53:48 +0000
To: Father Chrysostomos via RT <perlbug-followup [...] perl.org>
From: Dave Mitchell <davem [...] iabyn.com>
Download (untitled) / with headers
text/plain 1003b
On Sun, Dec 19, 2010 at 02:31:48PM -0800, Father Chrysostomos via RT wrote: Show quoted text
> On Tue Dec 14 15:57:54 2010, davem wrote:
> > On Sun, Dec 12, 2010 at 01:00:17PM -0800, Father Chrysostomos via RT
> wrote:
> > > On Tue Jun 21 06:52:36 2005, nicholas wrote:
> > > > Should we replace the use of do_clean_named_objs() with a routine that > > > > searches directly for any remaining objects, and directly reduces > > > > their > > > > reference counts?
> > > > > > Doing so would allow destructors to see freed SVs. > > > > > > Instead, how’s this patch? It still needs tests and a commit message.
> > > > Looks plausible. I don't understand why you skip $STDOUT and $STDERR > > though.
> > do_clean_named_io_objs does the same thing. I thought it was so that > destructors would be able to warn().
do_clean_named_io_objs() skips the STDOUT and STDERR filehandles; your codes skips the $STDOUT and $STDERR *scalars*. -- Overhead, without any fuss, the stars were going out. -- Arthur C Clarke
RT-Send-CC: perl5-porters [...] perl.org, davem [...] iabyn.com
Download (untitled) / with headers
text/plain 1.1k
On Sun Dec 19 14:54:14 2010, davem wrote: Show quoted text
> On Sun, Dec 19, 2010 at 02:31:48PM -0800, Father Chrysostomos via RT > wrote:
> > On Tue Dec 14 15:57:54 2010, davem wrote:
> > > On Sun, Dec 12, 2010 at 01:00:17PM -0800, Father Chrysostomos via
> RT
> > wrote:
> > > > On Tue Jun 21 06:52:36 2005, nicholas wrote:
> > > > > Should we replace the use of do_clean_named_objs() with a
> routine that
> > > > > searches directly for any remaining objects, and directly
> reduces
> > > > > their > > > > > reference counts?
> > > > > > > > Doing so would allow destructors to see freed SVs. > > > > > > > > Instead, how’s this patch? It still needs tests and a commit
> message.
> > > > > > Looks plausible. I don't understand why you skip $STDOUT and
> $STDERR
> > > though.
> > > > do_clean_named_io_objs does the same thing. I thought it was so that > > destructors would be able to warn().
> > do_clean_named_io_objs() skips the STDOUT and STDERR filehandles; your > codes skips the $STDOUT and $STDERR *scalars*.
Oh dear. So it does. That was really, really stupid of me. :-) If I change the each instance of GvSV to GvIO in that statement, does the patch look good?
CC: perl5-porters [...] perl.org
Subject: Re: [perl #36347] Object destruction incomplete
Date: Mon, 20 Dec 2010 10:30:09 +0000
To: Father Chrysostomos via RT <perlbug-followup [...] perl.org>
From: Dave Mitchell <davem [...] iabyn.com>
Download (untitled) / with headers
text/plain 672b
On Sun, Dec 19, 2010 at 06:05:19PM -0800, Father Chrysostomos via RT wrote: Show quoted text
> On Sun Dec 19 14:54:14 2010, davem wrote:
> > do_clean_named_io_objs() skips the STDOUT and STDERR filehandles; your > > codes skips the $STDOUT and $STDERR *scalars*.
> > Oh dear. So it does. That was really, really stupid of me. :-) > > If I change the each instance of GvSV to GvIO in that statement, does > the patch look good?
yes :-) -- "Strange women lying in ponds distributing swords is no basis for a system of government. Supreme executive power derives from a mandate from the masses, not from some farcical aquatic ceremony." -- Dennis, "Monty Python and the Holy Grail"
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 527b
On Mon Dec 20 02:30:37 2010, davem wrote: Show quoted text
> On Sun, Dec 19, 2010 at 06:05:19PM -0800, Father Chrysostomos via RT
wrote: Show quoted text
> > On Sun Dec 19 14:54:14 2010, davem wrote:
> > > do_clean_named_io_objs() skips the STDOUT and STDERR filehandles; your > > > codes skips the $STDOUT and $STDERR *scalars*.
> > > > Oh dear. So it does. That was really, really stupid of me. :-) > > > > If I change the each instance of GvSV to GvIO in that statement, does > > the patch look good?
> > yes :-) >
Now tweaked and applied as 4155e4fe8.
Download (untitled) / with headers
text/plain 124b
Re-opening this ticket, as the fix, which broke three CPAN modules, has been disabled (by commit 7f586e41) until after 5.14.
Download (untitled) / with headers
text/plain 223b
On Sun Jan 30 19:04:03 2011, sprout wrote: Show quoted text
> Re-opening this ticket, as the fix, which broke three CPAN modules, has > been disabled (by commit 7f586e41) until after 5.14.
And now it has been re-enabled by commit 640c0c3.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org