X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=18fdfc1acf5626edafc1999ac54af1e72036d26e;hb=43bb546a01e54de6c96472cbb373abf202b991da;hp=cc65ab283d80e2dd5a511ba63d8bb3c816223ce1;hpb=c0a105bfc95a10a0d8ab4cc278bd5b1ad66f202b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index cc65ab2..18fdfc1 100644
--- a/sv.c
+++ b/sv.c
@@ -3192,14 +3192,16 @@ would lose the UTF-8'ness of the PV.
 void
 Perl_sv_copypv(pTHX_ SV *dsv, register SV *ssv)
 {
-    SV *tmpsv = sv_newmortal();
+    SV *tmpsv;
 
-    if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) ) {
-	tmpsv = AMG_CALLun(ssv,string);
+    if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) && 
+	 (tmpsv = AMG_CALLun(ssv,string))) {
 	if (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(ssv))) {
 	    SvSetSV(dsv,tmpsv);
 	    return;
 	}
+    } else {
+        tmpsv = sv_newmortal();
     }
     {
 	STRLEN len;
@@ -4459,7 +4461,13 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
     /* Some magic sontains a reference loop, where the sv and object refer to
        each other.  To prevent a reference loop that would prevent such
        objects being freed, we look for such loops and if we find one we
-       avoid incrementing the object refcount. */
+       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
+
+    */
     if (!obj || obj == sv ||
 	how == PERL_MAGIC_arylen ||
 	how == PERL_MAGIC_qr ||
@@ -6594,8 +6602,14 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
 		if (GvHV(gv) && !HvNAME(GvHV(gv))) {
 		    hv_clear(GvHV(gv));
 #ifdef USE_ENVIRON_ARRAY
-		    if (gv == PL_envgv)
+		    if (gv == PL_envgv
+#  ifdef USE_ITHREADS
+			&& PL_curinterp == aTHX
+#  endif
+		    )
+		    {
 			environ[0] = Nullch;
+		    }
 #endif
 		}
 	    }
@@ -7290,9 +7304,6 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 }
 
 /* Downgrades a PVGV to a PVMG.
- *
- * XXX This function doesn't actually appear to be used anywhere
- * DAPM 15-Jun-01
  */
 
 STATIC void
@@ -7420,44 +7431,6 @@ Perl_sv_tainted(pTHX_ SV *sv)
     return FALSE;
 }
 
-/*
-=for apidoc sv_setpviv
-
-Copies an integer into the given SV, also updating its string value.
-Does not handle 'set' magic.  See C<sv_setpviv_mg>.
-
-=cut
-*/
-
-void
-Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
-{
-    char buf[TYPE_CHARS(UV)];
-    char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
-    sv_setpvn(sv, ptr, ebuf - ptr);
-}
-
-/*
-=for apidoc sv_setpviv_mg
-
-Like C<sv_setpviv>, but also handles 'set' magic.
-
-=cut
-*/
-
-void
-Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
-{
-    char buf[TYPE_CHARS(UV)];
-    char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
-    sv_setpvn(sv, ptr, ebuf - ptr);
-    SvSETMAGIC(sv);
-}
-
 #if defined(PERL_IMPLICIT_CONTEXT)
 
 /* pTHX_ magic can't cope with varargs, so this is a no-context
@@ -9742,7 +9715,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PERL_SET_THX(my_perl);
 
 #  ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
@@ -9773,7 +9746,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 
 #    ifdef DEBUGGING
-    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    Poison(my_perl, 1, PerlInterpreter);
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
@@ -10505,9 +10478,10 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
 	  PUTBACK;
 	  s = SvPV(uni, len);
 	  if (s != SvPVX(sv)) {
-	       SvGROW(sv, len);
+	       SvGROW(sv, len + 1);
 	       Move(s, SvPVX(sv), len, char);
 	       SvCUR_set(sv, len);
+	       SvPVX(sv)[len] = 0;	
 	  }
 	  FREETMPS;
 	  LEAVE;