From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 17 Jun 2005 15:37:50 +0000 (+0000)
Subject: Collect a little more information about the body we're getting rid of
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4cbc76b1bf09108493ca657fbc5ed7ed7b09fdbc;p=p5sagit%2Fp5-mst-13.2.git

Collect a little more information about the body we're getting rid of

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

diff --git a/sv.c b/sv.c
index eea7ae1..a14026d 100644
--- a/sv.c
+++ b/sv.c
@@ -1335,7 +1335,12 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     HV*		stash;
     void*	old_body_arena;
     size_t	old_body_offset;
+    size_t	old_body_length;	/* Well, the length to copy.  */
     void*	old_body;
+    bool	zero_nv = TRUE;
+#ifdef DEBUGGING
+    U32		old_type = SvTYPE(sv);
+#endif
 
     if (mt != SVt_PV && SvIsCOW(sv)) {
 	sv_force_normal_flags(sv, 0);
@@ -1359,6 +1364,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     old_body = SvANY(sv);
     old_body_arena = 0;
     old_body_offset = 0;
+    old_body_length = 0;
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1369,10 +1375,14 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	    mt = SVt_PVNV;
 	else if (mt < SVt_PVIV)
 	    mt = SVt_PVIV;
+	old_body_offset = STRUCT_OFFSET(XPVIV, xiv_iv);
+	old_body_length = sizeof(IV);
 	break;
     case SVt_NV:
 	nv	= SvNVX(sv);
 	old_body_arena = PL_xnv_root;
+	old_body_length = sizeof(NV);
+	zero_nv = FALSE;
 
 	if (mt < SVt_PVNV)
 	    mt = SVt_PVNV;
@@ -1387,6 +1397,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	old_body_arena = PL_xpv_root;
 	old_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
 	    - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+	old_body_length = sizeof(XPV) - old_body_offset;
 	if (mt <= SVt_IV)
 	    mt = SVt_PVIV;
 	else if (mt == SVt_NV)
@@ -1400,6 +1411,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	old_body_arena = PL_xpviv_root;
 	old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
 	    - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
+	old_body_length = sizeof(XPVIV) - old_body_offset;
 	break;
     case SVt_PVNV:
 	pv	= SvPVX_mutable(sv);
@@ -1408,6 +1420,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	iv	= SvIVX(sv);
 	nv	= SvNVX(sv);
 	old_body_arena = PL_xpvnv_root;
+	old_body_length = sizeof(XPVNV);
+	zero_nv = FALSE;
 	break;
     case SVt_PVMG:
 	/* Because the XPVMG of PL_mess_sv isn't allocated from the arena,
@@ -1426,6 +1440,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	magic	= SvMAGIC(sv);
 	stash	= SvSTASH(sv);
 	old_body_arena = PL_xpvmg_root;
+	old_body_length = sizeof(XPVMG);
+	zero_nv = FALSE;
 	break;
     default:
 	Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
@@ -1438,14 +1454,17 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     case SVt_NULL:
 	Perl_croak(aTHX_ "Can't upgrade to undef");
     case SVt_IV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
 	SvIV_set(sv, iv);
 	break;
     case SVt_NV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = new_XNV();
 	SvNV_set(sv, nv);
 	break;
     case SVt_RV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = &sv->sv_u.svu_rv;
 	SvRV_set(sv, (SV*)pv);
 	break;