diff options
| author | Archer Sully <archer@meer.net> | 2002-04-04 14:45:34 -0700 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-04-05 12:50:21 +0000 |
| commit | 14bff8b861f7a49697333a4a6aa1ca75ecd40c6e (patch) | |
| tree | 8e621b71687000d5e662110e77aa3ebcdcb94921 /ext/Storable/t | |
| parent | 268e9d79709e84ed1633bc3a726a3322a3e51bae (diff) | |
| download | perl-14bff8b861f7a49697333a4a6aa1ca75ecd40c6e.tar.gz | |
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
Diffstat (limited to 'ext/Storable/t')
| -rw-r--r-- | ext/Storable/t/dclone.t | 16 |
1 files changed, 15 insertions, 1 deletions
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"; + |