From: Srezic@Iconmobile.Com <Srezic@Iconmobile.Com>
Date: Fri, 2 Jul 2004 11:32:12 +0000 (+0000)
Subject: [perl #30563] [PATCH] Storable::dclone fails for tied elements
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2711d9fbc9d348da12bba04fd69c8ee78a0bb77a;p=p5sagit%2Fp5-mst-13.2.git

[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
--- 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
--- 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
--- 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
+}