tighten Storable's recognition of tied SVs

Since commit ff44333e5a9d9dca5272bb166df463607ebd3020, being RMAGICAL
and having tie magic is not sufficient to recognise an SV as tied.
When magic is turned off for mg_set(), the RMAGICAL flag is now left on,
so that vstrings will be recognised as such.  So Storable needs to check
whether the tie magic it sees is actually in effect, by also looking at
the GMAGICAL and SMAGICAL flags.

diff --git a/MANIFEST b/MANIFEST
index b27423b..9652cd5 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 9cb1a85..f74c867 100644 (file)
--- 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 31e31a3..9b55b50 100644 (file)
--- 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 (file)
index 0000000..c657f95
--- /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;