X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=90a99dfd6207d3f296f005cc7b63d75a9297142a;hb=7e107e90b7bd52c7fb110ac98da6bb7ab38e8959;hp=48efa2e6f3de3b0132e2827e6e5c93e0453fb036;hpb=b4b9a3288b9178e46ae8397db4a9c2e17d729ebf;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 48efa2e..90a99df 100644
--- a/sv.c
+++ b/sv.c
@@ -26,7 +26,7 @@
 #ifdef PERL_COPY_ON_WRITE
 #define SV_COW_NEXT_SV(sv)	INT2PTR(SV *,SvUVX(sv))
 #define SV_COW_NEXT_SV_SET(current,next)	SvUVX(current) = PTR2UV(next)
-/* This is a pessamistic view. Scalar must be purely a read-write PV to copy-
+/* This is a pessimistic view. Scalar must be purely a read-write PV to copy-
    on-write.  */
 #define CAN_COW_MASK	(SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
 			 SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \
@@ -164,7 +164,28 @@ Public API:
 
 /* new_SV(): return a new, empty SV head */
 
-#define new_SV(p) \
+#ifdef DEBUG_LEAKING_SCALARS
+/* provide a real function for a debugger to play with */
+STATIC SV*
+S_new_SV(pTHX)
+{
+    SV* sv;
+
+    LOCK_SV_MUTEX;
+    if (PL_sv_root)
+	uproot_SV(sv);
+    else
+	sv = more_sv();
+    UNLOCK_SV_MUTEX;
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    return sv;
+}
+#  define new_SV(p) (p)=S_new_SV(aTHX)
+
+#else
+#  define new_SV(p) \
     STMT_START {					\
 	LOCK_SV_MUTEX;					\
 	if (PL_sv_root)					\
@@ -176,6 +197,7 @@ Public API:
 	SvREFCNT(p) = 1;				\
 	SvFLAGS(p) = 0;					\
     } STMT_END
+#endif
 
 
 /* del_SV(): return an empty SV head to the free list */
@@ -4631,8 +4653,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
        avoid incrementing the object refcount.
 
        Note we cannot do this to avoid self-tie loops as intervening RV must
-       have its REFCNT incremented to keep it in existence - instead we could
-       special case them in sv_free() -- NI-S
+       have its REFCNT incremented to keep it in existence.
 
     */
     if (!obj || obj == sv ||
@@ -4649,6 +4670,21 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 	mg->mg_obj = SvREFCNT_inc(obj);
 	mg->mg_flags |= MGf_REFCOUNTED;
     }
+
+    /* Normal self-ties simply pass a null object, and instead of
+       using mg_obj directly, use the SvTIED_obj macro to produce a
+       new RV as needed.  For glob "self-ties", we are tieing the PVIO
+       with an RV obj pointing to the glob containing the PVIO.  In
+       this case, to avoid a reference loop, we need to weaken the
+       reference.
+    */
+
+    if (how == PERL_MAGIC_tiedscalar && SvTYPE(sv) == SVt_PVIO &&
+        obj && SvROK(obj) && GvIO(SvRV(obj)) == (IO*)sv)
+    {
+      sv_rvweaken(obj);
+    }
+
     mg->mg_type = how;
     mg->mg_len = namlen;
     if (name) {
@@ -5149,7 +5185,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
 		    PUSHMARK(SP);
 		    PUSHs(&tmpref);
 		    PUTBACK;
-		    call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
+		    call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR|G_VOID);
 		    SvREFCNT(sv)--;
 		    POPSTACK;
 		    SPAGAIN;
@@ -9566,10 +9602,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 	  CvDEPTH(dstr) = 0;
 	}
 	PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
+	/* anon prototypes aren't refcounted */
 	if (!CvANON(sstr) || CvCLONED(sstr))
 	    CvOUTSIDE(dstr)	= cv_dup_inc(CvOUTSIDE(sstr), param);
 	else
 	    CvOUTSIDE(dstr)	= cv_dup(CvOUTSIDE(sstr), param);
+	CvOUTSIDE_SEQ(dstr)	= CvOUTSIDE_SEQ(sstr);
 	CvFLAGS(dstr)	= CvFLAGS(sstr);
 	CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr));
 	break;
@@ -10195,12 +10233,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* pseudo environmental stuff */
     PL_origargc		= proto_perl->Iorigargc;
-    i = PL_origargc;
-    New(0, PL_origargv, i+1, char*);
-    PL_origargv[i] = '\0';
-    while (i-- > 0) {
-	PL_origargv[i]	= SAVEPV(proto_perl->Iorigargv[i]);
-    }
+    PL_origargv		= proto_perl->Iorigargv;
 
     param->stashes      = newAV();  /* Setup array of objects to call clone on */