[inseparable changes from patch from perl5.003_12 to perl5.003_13]

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 85c65bf..3784350 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -330,13 +330,17 @@ SV* sv;
 }
 #endif
 
+static bool in_clean_objs = FALSE;
+
 void
 sv_clean_objs()
 {
+    in_clean_objs = TRUE;
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     visit(do_clean_named_objs);
 #endif
     visit(do_clean_objs);
+    in_clean_objs = FALSE;
 }
 
 static void
@@ -348,14 +352,14 @@ SV* sv;
     SvREFCNT_dec(sv);
 }
 
-static int in_clean_all = 0;
+static bool in_clean_all = FALSE;
 
 void
 sv_clean_all()
 {
-    in_clean_all = 1;
+    in_clean_all = TRUE;
     visit(do_clean_all);
-    in_clean_all = 0;
+    in_clean_all = FALSE;
 }
 
 void
@@ -375,6 +379,9 @@ sv_free_arenas()
        if (!SvFAKE(sva))
            Safefree((void *)sva);
     }
+
+    sv_arenaroot = 0;
+    sv_root = 0;
 }
 
 static XPVIV*
@@ -2386,6 +2393,9 @@ I32 namlen;
     case 'x':
        mg->mg_virtual = &vtbl_substr;
        break;
+    case 'y':
+       mg->mg_virtual = &vtbl_vivary;
+       break;
     case '*':
        mg->mg_virtual = &vtbl_glob;
        break;
@@ -2554,6 +2564,7 @@ register SV *nsv;
     }
     SvREFCNT(sv) = 0;
     sv_clear(sv);
+    assert(!SvREFCNT(sv));
     StructCopy(nsv,sv,SV);
     SvREFCNT(sv) = refcnt;
     SvFLAGS(nsv) |= SVTYPEMASK;                /* Mark as freed */
@@ -2602,7 +2613,7 @@ register SV *sv;
                --sv_objcount;  /* XXX Might want something more general */
        }
        if (SvREFCNT(sv)) {
-           SV *ret;  
+           SV *ret;
            if ( perldb
                 && (ret = perl_get_sv("DB::ret", FALSE))
                 && SvROK(ret) && SvRV(ret) == sv && SvREFCNT(sv) == 1) {
@@ -2610,8 +2621,12 @@ register SV *sv;
                SvRV(ret) = 0;
                SvROK_off(ret);
                SvREFCNT(sv) = 0;
-           } else {
-               croak("panic: dangling references in DESTROY");
+           }
+           else {
+               if (in_clean_objs)
+                   croak("DESTROY created new reference to dead object");
+               /* DESTROY gave object new lease on life */
+               return;
            }
        }
     }
@@ -2619,7 +2634,10 @@ register SV *sv;
        mg_free(sv);
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
-       io_close((IO*)sv);
+       if (IoIFP(sv) != PerlIO_stdin() &&
+           IoIFP(sv) != PerlIO_stdout() &&
+           IoIFP(sv) != PerlIO_stderr())
+         io_close((IO*)sv);
        Safefree(IoTOP_NAME(sv));
        Safefree(IoFMT_NAME(sv));
        Safefree(IoBOTTOM_NAME(sv));
@@ -2751,7 +2769,8 @@ SV *sv;
     }
 #endif
     sv_clear(sv);
-    del_SV(sv);
+    if (! SvREFCNT(sv))
+       del_SV(sv);
 }
 
 STRLEN
@@ -3406,6 +3425,19 @@ SV *ref;
     return sv;
 }
 
+#ifdef CRIPPLED_CC
+SV *
+newRV_noinc(ref)
+SV *ref;
+{
+    register SV *sv;
+
+    sv = newRV(ref);
+    SvREFCNT_dec(ref);
+    return sv;
+}
+#endif /* CRIPPLED_CC */
+
 /* make an exact duplicate of old */
 
 SV *