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.

3 files changed, 74 insertions, 4 deletions

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;