From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 17 Mar 2004 16:10:57 +0000 (+0000)
Subject: Add auto-require of modules to restore overloading (and tests)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=165cc789d248f15373a01b5b620e86cdc98e3eab;p=p5sagit%2Fp5-mst-13.2.git

Add auto-require of modules to restore overloading (and tests)

p4raw-id: //depot/perl@22516
---

diff --git a/MANIFEST b/MANIFEST
index 1bd188d..16c6a10 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -651,6 +651,7 @@ ext/Storable/README		Storable extension
 ext/Storable/Storable.pm	Storable extension
 ext/Storable/Storable.xs	Storable extension
 ext/Storable/t/HAS_HOOK.pm	For auto-requiring of modules for STORABLE_thaw
+ext/Storable/t/HAS_OVERLOAD.pm	For auto-requiring of mdoules for overload
 ext/Storable/t/blessed.t	See if Storable works
 ext/Storable/t/canonical.t	See if Storable works
 ext/Storable/t/code.t		See if Storable works
diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog
index e4479ba..f4dddba 100644
--- a/ext/Storable/ChangeLog
+++ b/ext/Storable/ChangeLog
@@ -1,6 +1,7 @@
 Wed Mar 17 15:40:29 GMT 2004   Nicholas Clark <nick@ccl4.org>
 
         1. Add regression tests for the auto-require of STORABLE_thaw
+        2. Add auto-require of modules to restore overloading (and tests)
 
 Sat Mar 13 20:11:03 GMT 2004   Nicholas Clark <nick@ccl4.org>
 	
diff --git a/ext/Storable/MANIFEST b/ext/Storable/MANIFEST
index 3b70842..aa26dbb 100644
--- a/ext/Storable/MANIFEST
+++ b/ext/Storable/MANIFEST
@@ -6,6 +6,7 @@ Storable.xs		    The C side of Storable
 ChangeLog		    Changes since baseline
 hints/linux.pl		    Hint file to drop gcc to -O2
 t/HAS_HOOK.pm		    For auto-requiring of modules for STORABLE_thaw
+t/HAS_OVERLOAD.pm	    For auto-requiring of mdoules for overload
 t/blessed.t		    See if Storable works
 t/canonical.t		    See if Storable works
 t/code.t		    Test (de)serialization of code references
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index a98cdc5..2d44097 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -4286,14 +4286,32 @@ static SV *retrieve_overloaded(stcxt_t *cxt, char *cname)
 	/*
 	 * Restore overloading magic.
 	 */
-	if (!SvTYPE(sv)
-	    || !(stash = (HV *) SvSTASH (sv))
-	    || !Gv_AMG(stash))
+
+	stash = SvTYPE(sv) ? (HV *) SvSTASH (sv) : 0;
+	if (!stash) {
 		CROAK(("Cannot restore overloading on %s(0x%"UVxf
-		       ") (package %s)",
+		       ") (package <unknown>)",
 		       sv_reftype(sv, FALSE),
-		       PTR2UV(sv),
-			   stash ? HvNAME(stash) : "<unknown>"));
+		       PTR2UV(sv)));
+	}
+	if (!Gv_AMG(stash)) {
+		SV *psv = newSVpvn("require ", 8);
+		const char *package = HvNAME(stash);
+		sv_catpv(psv, package);
+
+		TRACEME(("No overloading defined for package %s", package));
+		TRACEME(("Going to require module '%s' with '%s'", package, SvPVX(psv)));
+
+		perl_eval_sv(psv, G_DISCARD);
+		sv_free(psv);
+		if (!Gv_AMG(stash)) {
+			CROAK(("Cannot restore overloading on %s(0x%"UVxf
+			       ") (package %s) (even after a \"require %s;\")",
+			       sv_reftype(sv, FALSE),
+			       PTR2UV(sv),
+			       package, package));
+		}
+	}
 
 	SvAMAGIC_on(rv);
 
diff --git a/ext/Storable/t/HAS_OVERLOAD.pm b/ext/Storable/t/HAS_OVERLOAD.pm
new file mode 100644
index 0000000..8a622a4
--- /dev/null
+++ b/ext/Storable/t/HAS_OVERLOAD.pm
@@ -0,0 +1,14 @@
+package HAS_OVERLOAD;
+
+use overload
+	'""'	=> sub { ${$_[0]} }, fallback => 1;
+
+sub make {
+  my $package = shift;
+  my $value = shift;
+  bless \$value, $package;
+}
+
+++$loaded_count;
+
+1;
diff --git a/ext/Storable/t/overload.t b/ext/Storable/t/overload.t
index a0b65a2..31b861d 100644
--- a/ext/Storable/t/overload.t
+++ b/ext/Storable/t/overload.t
@@ -25,7 +25,7 @@ sub ok;
 
 use Storable qw(freeze thaw);
 
-print "1..12\n";
+print "1..16\n";
 
 package OVERLOADED;
 
@@ -87,5 +87,15 @@ ok 10, ref $b->{ref} eq 'REF_TO_OVER';
 ok 11, "$b->{ref}->{over}" eq "$b";
 ok 12, $b + $b == 314;
 
+# nfreeze data generated by make_overload.pl
+my $f = unpack 'u', q{7!084$0Q(05-?3U9%4DQ/040*!'-N;W<`};
+
+# see note at the end of do_retrieve in Storable.xs about why this test has to
+# use a reference to an overloaded reference, rather than just a reference.
+my $t = eval {thaw $f};
+print "# $@" if $@;
+ok 13, $@ eq "";
+ok 14, ref ($t) eq 'REF';
+ok 15, ref ($$t) eq 'HAS_OVERLOAD';
+ok 16, $$$t eq 'snow';
 1;
-