diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | dist/Storable/Storable.pm | 2 | ||||
| -rw-r--r-- | dist/Storable/Storable.xs | 12 | ||||
| -rw-r--r-- | dist/Storable/t/tied_store.t | 64 |
4 files changed, 75 insertions, 4 deletions
@@ -3417,6 +3417,7 @@ dist/Storable/t/testlib.pl more helper routines for tests dist/Storable/t/threads.t Does Storable work with threads? dist/Storable/t/tied_hook.t See if Storable works dist/Storable/t/tied_items.t See if Storable works +dist/Storable/t/tied_store.t See if Storable works dist/Storable/t/tied.t See if Storable works dist/Storable/t/utf8hash.t See if Storable works dist/Storable/t/utf8.t See if Storable works diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 9cb1a85dc7..f74c867d4e 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.48'; +$VERSION = '2.49'; BEGIN { if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) { diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 31e31a373e..9b55b5073c 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -3534,13 +3534,17 @@ static int sv_type(pTHX_ SV *sv) return SvROK(sv) ? svis_REF : svis_SCALAR; case SVt_PVMG: case SVt_PVLV: /* Workaround for perl5.004_04 "LVALUE" bug */ - if (SvRMAGICAL(sv) && (mg_find(sv, 'p'))) + if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) == + (SVs_GMG|SVs_SMG|SVs_RMG) && + (mg_find(sv, 'p'))) return svis_TIED_ITEM; /* FALL THROUGH */ #if PERL_VERSION < 9 case SVt_PVBM: #endif - if (SvRMAGICAL(sv) && (mg_find(sv, 'q'))) + if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) == + (SVs_GMG|SVs_SMG|SVs_RMG) && + (mg_find(sv, 'q'))) return svis_TIED; return SvROK(sv) ? svis_REF : svis_SCALAR; case SVt_PVAV: @@ -6498,7 +6502,9 @@ static SV *dclone(pTHX_ SV *sv) #if PERL_VERSION < 8 || SvTYPE(sv) == SVt_PVMG #endif - ) && SvRMAGICAL(sv) && mg_find(sv, 'p')) { + ) && (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) == + (SVs_GMG|SVs_SMG|SVs_RMG) && + mg_find(sv, 'p')) { mg_get(sv); } diff --git a/dist/Storable/t/tied_store.t b/dist/Storable/t/tied_store.t new file mode 100644 index 0000000000..c657f950db --- /dev/null +++ b/dist/Storable/t/tied_store.t @@ -0,0 +1,64 @@ +#!./perl + +sub BEGIN { + unshift @INC, 't'; + unshift @INC, 't/compat' if $] < 5.006002; + require Config; import Config; + if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } +} + +use Storable (); +use Test::More tests => 3; + +our $f; + +package TIED_HASH; + +sub TIEHASH { bless({}, $_[0]) } + +sub STORE { + $f = Storable::freeze(\$_[2]); + 1; +} + +package TIED_ARRAY; + +sub TIEARRAY { bless({}, $_[0]) } + +sub STORE { + $f = Storable::freeze(\$_[2]); + 1; +} + +package TIED_SCALAR; + +sub TIESCALAR { bless({}, $_[0]) } + +sub STORE { + $f = Storable::freeze(\$_[1]); + 1; +} + +package main; + +my($s, @a, %h); +tie $s, "TIED_SCALAR"; +tie @a, "TIED_ARRAY"; +tie %h, "TIED_HASH"; + +$f = undef; +$s = 111; +is $f, Storable::freeze(\111); + +$f = undef; +$a[3] = 222; +is $f, Storable::freeze(\222); + +$f = undef; +$h{foo} = 333; +is $f, Storable::freeze(\333); + +1; |