Re: [PATCH] [BUG 5.004_63] define/set of PERL_DESTRUCT_LEVEL

Date: Fri, 27 Mar 1998 02:11:21 +0100 (MET)
Subject: [PATCH] another destruct_level fix
Date: Mon, 30 Mar 1998 23:48:12 +0200 (MET DST)

p4raw-id: //depot/perl@855

diff --git a/perl.c b/perl.c
index 0536829..00321af 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -497,7 +497,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
            if (hent) {
                warn("Unbalanced string table refcount: (%d) for \"%s\"",
                     HeVAL(hent) - Nullsv, HeKEY(hent));
-               HeVAL(hent) = Nullsv;
+               HeVAL(hent) = &sv_undef;
                hent = HeNEXT(hent);
            }
            if (!hent) {

diff --git a/sv.c b/sv.c
index b5bec9d..f9872b0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2718,6 +2718,7 @@ sv_replace(register SV *sv, register SV *nsv)
 void
 sv_clear(register SV *sv)
 {
+    HV* stash;
     assert(sv);
     assert(SvREFCNT(sv) == 0);
 
@@ -2726,7 +2727,6 @@ sv_clear(register SV *sv)
        if (defstash) {         /* Still have a symbol table? */
            djSP;
            GV* destructor;
-           HV* stash;
            SV ref;
 
            Zero(&ref, 1, SV);
@@ -2770,6 +2770,7 @@ sv_clear(register SV *sv)
     }
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
        mg_free(sv);
+    stash = NULL;
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
        if (IoIFP(sv) != PerlIO_stdin() &&
@@ -2795,7 +2796,11 @@ sv_clear(register SV *sv)
     case SVt_PVGV:
        gp_free((GV*)sv);
        Safefree(GvNAME(sv));
-       SvREFCNT_dec(GvSTASH(sv));
+       /* cannot decrease stash refcount yet, as we might recursively delete
+          ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+          of stash until current sv is completely gone.
+          -- JohnPC, 27 Mar 1998 */
+       stash = GvSTASH(sv);
        /* FALL THROUGH */
     case SVt_PVLV:
     case SVt_PVMG:
@@ -2857,7 +2862,13 @@ sv_clear(register SV *sv)
        break;
     case SVt_PVGV:
        del_XPVGV(SvANY(sv));
-       break;
+       /* code duplication for increased performance. */
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;
+       /* decrease refcount of the stash that owns this GV, if any */
+       if (stash)
+           SvREFCNT_dec(stash);
+       return; /* not break, SvFLAGS reset already happened */
     case SVt_PVBM:
        del_XPVBM(SvANY(sv));
        break;
@@ -5005,7 +5016,8 @@ sv_dump(SV *sv)
     case SVt_PVGV:
        PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", GvNAME(sv));
        PerlIO_printf(Perl_debug_log, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
-       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n",
+           SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
        PerlIO_printf(Perl_debug_log, "  GP = 0x%lx\n", (long)GvGP(sv));
        PerlIO_printf(Perl_debug_log, "    SV = 0x%lx\n", (long)GvSV(sv));
        PerlIO_printf(Perl_debug_log, "    REFCNT = %ld\n", (long)GvREFCNT(sv));