summaryrefslogtreecommitdiff
path: root/dist
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2013-11-21 15:53:41 +0000
committerDavid Mitchell <davem@iabyn.com>2013-11-21 17:12:42 +0000
commit007ee6b5c9390c9b68f5078d641b65ae38744242 (patch)
tree1d7a032855d20083866a5dd864d73ea1e62f726a /dist
parent997ca471cc5e30128a8804a59833b5cca3e4b433 (diff)
downloadperl-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')
-rw-r--r--dist/Storable/Storable.xs14
-rw-r--r--dist/Storable/t/tied.t12
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/);
+}