call defout/stderr destructors last
authorDavid Mitchell <davem@iabyn.com>
Mon, 20 Sep 2010 21:14:23 +0000 (22:14 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 20 Sep 2010 21:14:23 +0000 (22:14 +0100)
When calling the destructors for IO objects embedded in arena GVs,
process PL_defoutgv and PL_stderrgv last. Yes, the test suite
expects STDOUT to still work at this point. Indeed, one test in ref.t
calls print from STDOUT's destructor (which is why pp_print needed a
slight tweak to handle a null GV properly).

perl.c
pp_hot.c
sv.c

diff --git a/perl.c b/perl.c
index 5092958..cf42087 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -774,8 +774,6 @@ perl_destruct(pTHXx)
         */
        sv_clean_objs();
        PL_sv_objcount = 0;
-       if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
-           PL_defoutgv = NULL; /* may have been freed */
     }
 
     /* unhook hooks which will soon be, or use, destroyed data */
@@ -837,9 +835,6 @@ perl_destruct(pTHXx)
         return STATUS_EXIT;
     }
 
-    /* reset so print() ends up where we expect */
-    setdefout(NULL);
-
 #ifdef USE_ITHREADS
     /* the syntax tree is shared between clones
      * so op_free(PL_main_root) only ReREFCNT_dec's
index 031c2cf..4f043fb 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -751,7 +751,7 @@ PP(pp_print)
        RETURN;
     }
     if (!(io = GvIO(gv))) {
-        if ((GvEGVx(gv)) && (io = GvIO(GvEGV(gv)))
+        if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv)))
            && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
             goto had_magic;
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
diff --git a/sv.c b/sv.c
index 18ba290..0c78725 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -522,7 +522,7 @@ do_clean_named_objs(pTHX_ SV *const sv)
     SvREFCNT_dec(sv); /* undo the inc above */
 }
 
-/* clear any IO slots in a GV which hold objects;
+/* clear any IO slots in a GV which hold objects (except stderr, defout);
  * called by sv_clean_objs() for each live GV */
 
 static void
@@ -532,7 +532,7 @@ do_clean_named_io_objs(pTHX_ SV *const sv)
     SV *obj;
     assert(SvTYPE(sv) == SVt_PVGV);
     assert(isGV_with_GP(sv));
-    if (!GvGP(sv))
+    if (!GvGP(sv) || sv == (SV*)PL_stderrgv || sv == (SV*)PL_defoutgv)
        return;
 
     SvREFCNT_inc(sv);
@@ -558,6 +558,7 @@ void
 Perl_sv_clean_objs(pTHX)
 {
     dVAR;
+    GV *olddef, *olderr;
     PL_in_clean_objs = TRUE;
     visit(do_clean_objs, SVf_ROK, SVf_ROK);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
@@ -566,6 +567,15 @@ 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);
+    olddef = PL_defoutgv;
+    PL_defoutgv = NULL; /* disable skip of PL_defoutgv */
+    if (olddef && isGV_with_GP(olddef))
+       do_clean_named_io_objs(aTHX_ MUTABLE_SV(olddef));
+    olderr = PL_stderrgv;
+    PL_stderrgv = NULL; /* disable skip of PL_stderrgv */
+    if (olderr && isGV_with_GP(olderr))
+       do_clean_named_io_objs(aTHX_ MUTABLE_SV(olderr));
+    SvREFCNT_dec(olddef);
 #endif
     PL_in_clean_objs = FALSE;
 }