diff options
| author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-04-05 19:30:12 +0000 |
|---|---|---|
| committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-04-05 19:30:12 +0000 |
| commit | 004283b80f6094bb85aba6f48a74e3c5c34ea24f (patch) | |
| tree | db851a089943a624ec7b74f075bc28014ca70891 /ext | |
| parent | 07bc525fab7db02aeab0c4065ba408c74862a1be (diff) | |
| download | perl-004283b80f6094bb85aba6f48a74e3c5c34ea24f.tar.gz | |
Integrate mainline
p4raw-id: //depot/perlio@15753
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/Storable/Storable.xs | 6 | ||||
| -rw-r--r-- | ext/Storable/t/dclone.t | 16 |
2 files changed, 20 insertions, 2 deletions
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 847ec1f736..279cd1f9f2 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 38c82ebcc1..7e3adce08f 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"; + |