From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 7 Jun 2005 14:57:35 +0000 (+0000)
Subject: Ensure string table counts are balanced. (Was not true in op/pack.t)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8f9541a0e3495cf3f2a868f440b6b197d5c68ee;p=p5sagit%2Fp5-mst-13.2.git

Ensure string table counts are balanced. (Was not true in op/pack.t)

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

diff --git a/sv.c b/sv.c
index f3dbaf8..81634de 100644
--- a/sv.c
+++ b/sv.c
@@ -4447,7 +4447,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 	(void)SvPOK_only(dstr);
 
 	if (
-            (sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
+	    /* We're not already COW  */
+            ((sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
+#ifndef PERL_COPY_ON_WRITE
+	     /* or we are, but dstr isn't a suitable target.  */
+	     || (SvFLAGS(dstr) & CAN_COW_MASK) != CAN_COW_FLAGS
+#endif
+	     )
             &&
             !(isSwipe =
                  (sflags & SVs_TEMP) &&   /* slated for free anyway? */
@@ -4513,9 +4519,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                 /* making another shared SV.  */
                 STRLEN cur = SvCUR(sstr);
                 STRLEN len = SvLEN(sstr);
-		assert (SvTYPE(dstr) >= SVt_PVIV);
 #ifdef PERL_COPY_ON_WRITE
                 if (len) {
+		    assert (SvTYPE(dstr) >= SVt_PVIV);
                     /* SvIsCOW_normal */
                     /* splice us in between source and next-after-source.  */
                     SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
@@ -4528,6 +4534,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                     UV hash = SvSHARED_HASH(sstr);
                     DEBUG_C(PerlIO_printf(Perl_debug_log,
                                           "Copy on write: Sharing hash\n"));
+
+		    assert (SvTYPE(dstr) >= SVt_PVIV);
                     SvPV_set(dstr,
                              sharepvn(SvPVX_const(sstr),
                                       (sflags & SVf_UTF8?-cur:cur), hash));
diff --git a/sv.h b/sv.h
index af93b32..19acb1a 100644
--- a/sv.h
+++ b/sv.h
@@ -1351,16 +1351,15 @@ Like C<sv_catsv> but doesn't process magic.
 #  define SvRELEASE_IVX(sv)   ((void)((SvFLAGS(sv) & (SVf_OOK|SVf_READONLY|SVf_FAKE)) \
 				&& Perl_sv_release_IVX(aTHX_ sv)))
 #  define SvIsCOW_normal(sv)	(SvIsCOW(sv) && SvLEN(sv))
+#else
+#  define SvRELEASE_IVX(sv)   SvOOK_off(sv)
+#endif /* PERL_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| \
 			 SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_AMAGIC)
 #define CAN_COW_FLAGS	(SVp_POK|SVf_POK)
 
-#else
-#  define SvRELEASE_IVX(sv)   SvOOK_off(sv)
-#endif /* PERL_COPY_ON_WRITE */
-
 #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) \
 				    sv_force_normal_flags(sv, 0)