[perl #30563] [PATCH] Storable::dclone fails for tied elements

Message-ID: <rt-3.0.11-30563-91788.4.94870186951744@perl.org>

Also, a version bump to Storable.pm.

p4raw-id: //depot/perl@25881

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index 03f50d9..712f597 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -21,7 +21,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
 use AutoLoader;
 use vars qw($canonical $forgive_me $VERSION);
 
-$VERSION = '2.15';
+$VERSION = '2.15_01';
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;            # Grrr...
 
 #

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 0d2d8c6..b4c1f6a 100644 (file)
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -6240,6 +6240,14 @@ static SV *dclone(pTHX_ SV *sv)
                clean_context(aTHX_ cxt);
 
        /*
+        * Tied elements seem to need special handling.
+        */
+
+       if (SvTYPE(sv) == SVt_PVLV && SvRMAGICAL(sv) && mg_find(sv, 'p')) {
+               mg_get(sv);
+       }
+
+       /*
         * do_store() optimizes for dclone by not freeing its context, should
         * we need to allocate one because we're deep cloning from a hook.
         */

diff --git a/ext/Storable/t/dclone.t b/ext/Storable/t/dclone.t
index 266afe8..c3aa180 100644 (file)
--- a/ext/Storable/t/dclone.t
+++ b/ext/Storable/t/dclone.t
@@ -24,7 +24,7 @@ sub BEGIN {
 
 use Storable qw(dclone);
 
-print "1..10\n";
+print "1..12\n";
 
 $a = 'toto';
 $b = \$a;
@@ -90,3 +90,22 @@ my $clone = dclone($empty_string_obj);
 print ref $clone eq ref $empty_string_obj &&
       $$clone eq $$empty_string_obj &&
       $$clone eq '' ? "ok 10\n" : "not ok 10\n";
+
+
+# Do not fail if Tie::Hash and/or Tie::StdHash is not available
+if (eval { require Tie::Hash; scalar keys %Tie::StdHash:: }) {
+    tie my %tie, "Tie::StdHash" or die $!;
+    $tie{array} = [1,2,3,4];
+    $tie{hash} = {1,2,3,4};
+    my $clone_array = dclone $tie{array};
+    print "not " unless "@$clone_array" eq "@{$tie{array}}";
+    print "ok 11\n";
+    my $clone_hash = dclone $tie{hash};
+    print "not " unless $clone_hash->{1} eq $tie{hash}{1};
+    print "ok 12\n";
+} else {
+    print <<EOF;
+ok 11 # skip No Tie::StdHash available
+ok 12 # skip No Tie::StdHash available
+EOF
+}