diff options
| author | David Mitchell <davem@iabyn.com> | 2013-11-21 15:53:41 +0000 |
|---|---|---|
| committer | David Mitchell <davem@iabyn.com> | 2013-11-21 17:12:42 +0000 |
| commit | 007ee6b5c9390c9b68f5078d641b65ae38744242 (patch) | |
| tree | 1d7a032855d20083866a5dd864d73ea1e62f726a /dist/Storable | |
| parent | 997ca471cc5e30128a8804a59833b5cca3e4b433 (diff) | |
| download | perl-007ee6b5c9390c9b68f5078d641b65ae38744242.tar.gz | |
Storable: crash on ref to blessed tied array
When Storable was retrieving a tied array, if that array needed blessing
into a class, the code was passing the name of the class, rather than the
HV of the stash, to sv_bless(), causing a crash.
(Discovered due to a gcc "var set but not used" warning).
I also updated a few source code comments with s/SX_FOO/SX_TIED_FOO/.
Diffstat (limited to 'dist/Storable')
| -rw-r--r-- | dist/Storable/Storable.xs | 14 | ||||
| -rw-r--r-- | dist/Storable/t/tied.t | 12 |
2 files changed, 18 insertions, 8 deletions
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 439635b63d..6960d6c551 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -1179,9 +1179,9 @@ static const sv_retrieve_t sv_old_retrieve[] = { (sv_retrieve_t)retrieve_byte, /* SX_BYTE */ (sv_retrieve_t)retrieve_netint, /* SX_NETINT */ (sv_retrieve_t)retrieve_scalar, /* SX_SCALAR */ - (sv_retrieve_t)retrieve_tied_array, /* SX_ARRAY */ - (sv_retrieve_t)retrieve_tied_hash, /* SX_HASH */ - (sv_retrieve_t)retrieve_tied_scalar, /* SX_SCALAR */ + (sv_retrieve_t)retrieve_tied_array, /* SX_TIED_ARRAY */ + (sv_retrieve_t)retrieve_tied_hash, /* SX_TIED_HASH */ + (sv_retrieve_t)retrieve_tied_scalar, /* SX_TIED_SCALAR */ (sv_retrieve_t)retrieve_other, /* SX_SV_UNDEF not supported */ (sv_retrieve_t)retrieve_other, /* SX_SV_YES not supported */ (sv_retrieve_t)retrieve_other, /* SX_SV_NO not supported */ @@ -1234,9 +1234,9 @@ static const sv_retrieve_t sv_retrieve[] = { (sv_retrieve_t)retrieve_byte, /* SX_BYTE */ (sv_retrieve_t)retrieve_netint, /* SX_NETINT */ (sv_retrieve_t)retrieve_scalar, /* SX_SCALAR */ - (sv_retrieve_t)retrieve_tied_array, /* SX_ARRAY */ - (sv_retrieve_t)retrieve_tied_hash, /* SX_HASH */ - (sv_retrieve_t)retrieve_tied_scalar, /* SX_SCALAR */ + (sv_retrieve_t)retrieve_tied_array, /* SX_TIED_ARRAY */ + (sv_retrieve_t)retrieve_tied_hash, /* SX_TIED_HASH */ + (sv_retrieve_t)retrieve_tied_scalar, /* SX_TIED_SCALAR */ (sv_retrieve_t)retrieve_sv_undef, /* SX_SV_UNDEF */ (sv_retrieve_t)retrieve_sv_yes, /* SX_SV_YES */ (sv_retrieve_t)retrieve_sv_no, /* SX_SV_NO */ @@ -4686,7 +4686,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, cname, 0); /* Will return if tv is null */ + SEEN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) return (SV *) 0; /* Failed */ diff --git a/dist/Storable/t/tied.t b/dist/Storable/t/tied.t index 6c6381abb4..921117dd8b 100644 --- a/dist/Storable/t/tied.t +++ b/dist/Storable/t/tied.t @@ -18,7 +18,7 @@ sub BEGIN { } use Storable qw(freeze thaw); -use Test::More tests => 23; +use Test::More tests => 25; ($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0); @@ -210,3 +210,13 @@ is($FAULT::fault, 2); main::is($b, "ok "); } +{ + # blessed ref to tied object should be thawed blessed + my @a; + tie @a, TIED_ARRAY; + my $r = bless \@a, 'FOO99'; + my $f = freeze($r); + my $t = thaw($f); + isnt($t, undef); + like("$t", qr/^FOO99=ARRAY/); +} |