From: Archer Sully <archer@meer.net>
Date: Thu, 4 Apr 2002 21:45:34 +0000 (-0700)
Subject: Patch for bug ID 20020221.007
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=14bff8b861f7a49697333a4a6aa1ca75ecd40c6e;p=p5sagit%2Fp5-mst-13.2.git

Patch for bug ID 20020221.007
Message-Id: <20020405044630.8F2B3C859@mail.goldenagewireless.net>

Fix for "[ID 20020221.007] SEGV in Storable with empty string
scalar object" (dclone)

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

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 847ec1f..279cd1f 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -3917,8 +3917,12 @@ static SV *retrieve_scalar(stcxt_t *cxt, char *cname)
 		/*
 		 * newSV did not upgrade to SVt_PV so the scalar is undefined.
 		 * To make it defined with an empty length, upgrade it now...
+		 * Don't upgrade to a PV if the original type contains more
+		 * information than a scalar.
 		 */
-		sv_upgrade(sv, SVt_PV);
+		if (SvTYPE(sv) <= SVt_PV) {
+			sv_upgrade(sv, SVt_PV);
+		}
 		SvGROW(sv, 1);
 		*SvEND(sv) = '\0';			/* Ensure it's null terminated anyway */
 		TRACEME(("ok (retrieve_scalar empty at 0x%"UVxf")", PTR2UV(sv)));
diff --git a/ext/Storable/t/dclone.t b/ext/Storable/t/dclone.t
index 38c82eb..7e3adce 100644
--- a/ext/Storable/t/dclone.t
+++ b/ext/Storable/t/dclone.t
@@ -27,7 +27,7 @@ sub BEGIN {
 
 use Storable qw(dclone);
 
-print "1..9\n";
+print "1..10\n";
 
 $a = 'toto';
 $b = \$a;
@@ -80,3 +80,17 @@ $$cloned{a} = "blah";
 print "not " unless $$cloned{''}[0] == \$$cloned{a};
 print "ok 9\n";
 
+# [ID 20020221.007] SEGV in Storable with empty string scalar object
+package TestString;
+sub new {
+    my ($type, $string) = @_;
+    return bless(\$string, $type);
+}
+package main;
+my $empty_string_obj = TestString->new('');
+my $clone = dclone($empty_string_obj);
+# If still here after the dclone the fix (#17543) worked.
+print ref $clone eq ref $empty_string_obj &&
+      $$clone eq $$empty_string_obj &&
+      $$clone eq '' ? "ok 10\n" : "not ok 10\n";
+