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.

1 files changed, 27 insertions, 3 deletions

diff --git a/sv.c b/sv.c
index 5381f93dbc..18ba290a08 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;
 }