From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 29 Oct 2005 17:02:49 +0000 (+0000)
Subject: Add a new SMAGIC flag, to signal a call to SvSETMAGIC. Add it to
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bddd5118bb8dac8628019bdb9373c01f5937db98;p=p5sagit%2Fp5-mst-13.2.git

Add a new SMAGIC flag, to signal a call to SvSETMAGIC. Add it to
sv_catpvn_flags and sv_catsv_flags, and then re-implement sv_catpvn_mg
and sv_catsv_mg as calls to sv_catpvn_flags and sv_catsv_flags
respectively.

p4raw-id: //depot/perl@25884
---

diff --git a/sv.c b/sv.c
index 1169249..2a0dff6 100644
--- a/sv.c
+++ b/sv.c
@@ -4588,6 +4588,8 @@ Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register
     *SvEND(dsv) = '\0';
     (void)SvPOK_only_UTF8(dsv);		/* validate pointer */
     SvTAINT(dsv);
+    if (flags & SV_SMAGIC)
+	SvSETMAGIC(dsv);
 }
 
 /*
@@ -4601,8 +4603,7 @@ Like C<sv_catpvn>, but also handles 'set' magic.
 void
 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
-    sv_catpvn(sv,ptr,len);
-    SvSETMAGIC(sv);
+    sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 }
 
 /*
@@ -4626,36 +4627,38 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
 {
     const char *spv;
     STRLEN slen;
-    if (!ssv)
-	return;
-    if ((spv = SvPV_const(ssv, slen))) {
-	/*  sutf8 and dutf8 were type bool, but under USE_ITHREADS,
-	    gcc version 2.95.2 20000220 (Debian GNU/Linux) for
-	    Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
-	    get dutf8 = 0x20000000, (i.e.  SVf_UTF8) even though
-	    dsv->sv_flags doesn't have that bit set.
+    if (ssv) {
+	if ((spv = SvPV_const(ssv, slen))) {
+	    /*  sutf8 and dutf8 were type bool, but under USE_ITHREADS,
+		gcc version 2.95.2 20000220 (Debian GNU/Linux) for
+		Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
+		get dutf8 = 0x20000000, (i.e.  SVf_UTF8) even though
+		dsv->sv_flags doesn't have that bit set.
 		Andy Dougherty  12 Oct 2001
-	*/
-	const I32 sutf8 = DO_UTF8(ssv);
-	I32 dutf8;
+	    */
+	    const I32 sutf8 = DO_UTF8(ssv);
+	    I32 dutf8;
 
-	if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
-	    mg_get(dsv);
-	dutf8 = DO_UTF8(dsv);
+	    if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
+		mg_get(dsv);
+	    dutf8 = DO_UTF8(dsv);
 
-	if (dutf8 != sutf8) {
-	    if (dutf8) {
-		/* Not modifying source SV, so taking a temporary copy. */
-		SV* csv = sv_2mortal(newSVpvn(spv, slen));
+	    if (dutf8 != sutf8) {
+		if (dutf8) {
+		    /* Not modifying source SV, so taking a temporary copy. */
+		    SV* csv = sv_2mortal(newSVpvn(spv, slen));
 
-		sv_utf8_upgrade(csv);
-		spv = SvPV_const(csv, slen);
+		    sv_utf8_upgrade(csv);
+		    spv = SvPV_const(csv, slen);
+		}
+		else
+		    sv_utf8_upgrade_nomg(dsv);
 	    }
-	    else
-		sv_utf8_upgrade_nomg(dsv);
+	    sv_catpvn_nomg(dsv, spv, slen);
 	}
-	sv_catpvn_nomg(dsv, spv, slen);
     }
+    if (flags & SV_SMAGIC)
+	SvSETMAGIC(dsv);
 }
 
 /*
@@ -4669,8 +4672,7 @@ Like C<sv_catsv>, but also handles 'set' magic.
 void
 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 {
-    sv_catsv(dsv,ssv);
-    SvSETMAGIC(dsv);
+    sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 }
 
 /*
diff --git a/sv.h b/sv.h
index 2fad32a..06ab68a 100644
--- a/sv.h
+++ b/sv.h
@@ -1348,6 +1348,7 @@ Like C<sv_catsv> but doesn't process magic.
 #define SV_NOSTEAL		16
 #define SV_CONST_RETURN		32
 #define SV_MUTABLE_RETURN	64
+#define SV_SMAGIC		128
 
 #define sv_unref(sv)    	sv_unref_flags(sv, 0)
 #define sv_force_normal(sv)	sv_force_normal_flags(sv, 0)