Add regression tests for the auto-require of STORABLE_thaw

p4raw-id: //depot/perl@22515

2 files changed, 50 insertions, 1 deletions

diff --git a/ext/Storable/t/HAS_HOOK.pm b/ext/Storable/t/HAS_HOOK.pm
new file mode 100644
index 0000000000..979a6a207d
--- /dev/null
+++ b/ext/Storable/t/HAS_HOOK.pm
@@ -0,0 +1,9 @@
+package HAS_HOOK;
+
+sub STORABLE_thaw {
+  ++$thawed_count;
+}
+
+++$loaded_count;
+
+1;
diff --git a/ext/Storable/t/blessed.t b/ext/Storable/t/blessed.t
index 5b971c26fa..842674f0c7 100644
--- a/ext/Storable/t/blessed.t
+++ b/ext/Storable/t/blessed.t
@@ -32,7 +32,7 @@ use Storable qw(freeze thaw);
 );
 
 my $test = 12;
-my $tests = $test + 2 * 6 * keys %::immortals;
+my $tests = $test + 6 + 2 * 6 * keys %::immortals;
 print "1..$tests\n";
 
 package SHORT_NAME;
@@ -158,3 +158,43 @@ foreach $count (1..3) {
     ok ++$test, 1;
   }
 }
+
+# Test automatic require of packages to find thaw hook.
+
+package HAS_HOOK;
+
+$loaded_count = 0;
+$thawed_count = 0;
+
+sub make {
+  bless [];
+}
+
+sub STORABLE_freeze {
+  my $self = shift;
+  return '';
+}
+
+package main;
+
+my $f = freeze (HAS_HOOK->make);
+
+ok ++$test, $HAS_HOOK::loaded_count == 0;
+ok ++$test, $HAS_HOOK::thawed_count == 0;
+
+my $t = thaw $f;
+ok ++$test, $HAS_HOOK::loaded_count == 1;
+ok ++$test, $HAS_HOOK::thawed_count == 1;
+ok ++$test, $t;
+ok ++$test, ref $t eq 'HAS_HOOK';
+
+# Can't do this because the method is still cached by UNIVERSAL::can
+# delete $INC{"HAS_HOOK.pm"};
+# undef &HAS_HOOK::STORABLE_thaw;
+# 
+# warn HAS_HOOK->can('STORABLE_thaw');
+# $t = thaw $f;
+# ok ++$test, $HAS_HOOK::loaded_count == 2;
+# ok ++$test, $HAS_HOOK::thawed_count == 2;
+# ok ++$test, $t;
+# ok ++$test, ref $t eq 'HAS_HOOK';