Re: [perl #43357] *DESTROY = sub {} at runtime

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

diff --git a/sv.c b/sv.c
index 02b4d02..7f030e3 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -467,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *sv)
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
-            (GvIO(sv) && GvIOp(sv) && SvOBJECT(GvIO(sv))) ||  /* In certain rare cases GvIOP(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
@@ -3622,9 +3623,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE
-            && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
-                && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-                 && SvTYPE(sstr) >= SVt_PVIV)
+            && ((flags & SV_COW_SHARED_HASH_KEYS)
+               ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && SvTYPE(sstr) >= SVt_PVIV))
+               : 1)
 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.
@@ -4394,6 +4397,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
     */
     if (!obj || obj == sv ||
        how == PERL_MAGIC_arylen ||
+       how == PERL_MAGIC_isaelem ||
        how == PERL_MAGIC_qr ||
        how == PERL_MAGIC_symtab ||
        (SvTYPE(obj) == SVt_PVGV &&
@@ -10903,6 +10907,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
@@ -10937,6 +10942,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);