From 007ee6b5c9390c9b68f5078d641b65ae38744242 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 21 Nov 2013 15:53:41 +0000 Subject: [PATCH] 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/. --- dist/Storable/Storable.xs | 14 +++++++------- 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 439635b..6960d6c 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 */ if (!sv) return (SV *) 0; /* Failed */ diff --git a/dist/Storable/t/tied.t b/dist/Storable/t/tied.t index 6c6381a..921117d 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/); +} -- 2.7.4