summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2005-06-07 14:57:35 +0000
committerNicholas Clark <nick@ccl4.org>2005-06-07 14:57:35 +0000
commitb8f9541a0e3495cf3f2a868f440b6b197d5c68ee (patch)
treed33e8a3c75c82fc8f3f6aec703db4504bb740706
parentce6e1103a66e3cbd2c2ec85914dcbaa395276c13 (diff)
downloadperl-b8f9541a0e3495cf3f2a868f440b6b197d5c68ee.tar.gz
Ensure string table counts are balanced. (Was not true in op/pack.t)
p4raw-id: //depot/perl@24732
-rw-r--r--sv.c12
-rw-r--r--sv.h7
2 files changed, 13 insertions, 6 deletions
diff --git a/sv.c b/sv.c
index f3dbaf8051..81634de3e2 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 af93b32d01..19acb1a100 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)