In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e4487e9b537f1be1e95aba1c87790c2a411788a7?hp=8e7d0c4b4f9a32461518a61c3643c060cadc7b52>
- Log ----------------------------------------------------------------- commit e4487e9b537f1be1e95aba1c87790c2a411788a7 Author: David Mitchell <da...@iabyn.com> Date: Mon Sep 20 13:43:33 2010 +0100 run named IO destructors later split do_clean_named_objs() into two functions; the first skips the IO slot, and the second, do_clean_named_io_objs(), only processes the IO slot. This means that the destructors for IO objects are run later than for other named objects, so the latter will still have access to all their IO. This is a fix for 57ef47cc7bcd1b57927d5010f363ccaa10f1d990, which changed do_clean_named_objs() to zap the slots of a GV rather than just decrementing the GV's ref count. This change ensures referential integrity, but means that GVs with a reference > 1 will still have their slots zapped. In particular, it means that PL_defoutgv no longer gets delayed zapping. However, this has always been a problem for any other file handles; depending on the order of GV zapping, a file handle could be freed before a destructor gets called that might use it. So this is a general fix. ----------------------------------------------------------------------- Summary of changes: sv.c | 30 +++++++++++++++++++++++++++--- 1 files changed, 27 insertions(+), 3 deletions(-) diff --git a/sv.c b/sv.c index 5381f93..18ba290 100644 --- a/sv.c +++ b/sv.c @@ -123,7 +123,8 @@ called by visit() for each SV]): sv_report_used() / do_report_used() dump all remaining SVs (debugging aid) - sv_clean_objs() / do_clean_objs(),do_clean_named_objs() + sv_clean_objs() / do_clean_objs(),do_clean_named_objs(), + do_clean_named_io_objs() Attempt to free all objects pointed to by RVs, and, unless DISABLE_DESTRUCTOR_KLUDGE is defined, try to do the same for all objects indirectly @@ -474,9 +475,12 @@ do_clean_objs(pTHX_ SV *const ref) /* XXX Might want to check arrays, etc. */ } -/* called by sv_clean_objs() for each live SV */ #ifndef DISABLE_DESTRUCTOR_KLUDGE + +/* clear any slots in a GV which hold objects - except IO; + * called by sv_clean_objs() for each live GV */ + static void do_clean_named_objs(pTHX_ SV *const sv) { @@ -515,6 +519,23 @@ do_clean_named_objs(pTHX_ SV *const sv) GvCV(sv) = NULL; SvREFCNT_dec(obj); } + SvREFCNT_dec(sv); /* undo the inc above */ +} + +/* clear any IO slots in a GV which hold objects; + * called by sv_clean_objs() for each live GV */ + +static void +do_clean_named_io_objs(pTHX_ SV *const sv) +{ + dVAR; + SV *obj; + assert(SvTYPE(sv) == SVt_PVGV); + assert(isGV_with_GP(sv)); + if (!GvGP(sv)) + return; + + SvREFCNT_inc(sv); if ( ((obj = MUTABLE_SV(GvIO(sv)) )) && SvOBJECT(obj)) { DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob IO object:\n "), sv_dump(obj))); @@ -540,8 +561,11 @@ Perl_sv_clean_objs(pTHX) PL_in_clean_objs = TRUE; visit(do_clean_objs, SVf_ROK, SVf_ROK); #ifndef DISABLE_DESTRUCTOR_KLUDGE - /* some barnacles may yet remain, clinging to typeglobs */ + /* Some barnacles may yet remain, clinging to typeglobs. + * Run the non-IO destructors first: they may want to output + * 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); #endif PL_in_clean_objs = FALSE; } -- Perl5 Master Repository