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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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;
-