make store_hook() handle regular expression objects

Previously this would complain it didn't know the object type
when preparing to call STORABLE_freeze.

2 files changed, 31 insertions, 1 deletions

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 67ebba8afb..29f53b5ff2 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -3595,6 +3595,7 @@ static int store_hook(
     switch (type) {
     case svis_REF:
     case svis_SCALAR:
+    case svis_REGEXP:
         obj_type = SHT_SCALAR;
         break;
     case svis_ARRAY:
diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t
index 398f21f80e..dea569b2b0 100644
--- a/dist/Storable/t/blessed.t
+++ b/dist/Storable/t/blessed.t
@@ -44,7 +44,7 @@ use Storable qw(freeze thaw store retrieve fd_retrieve);
    'long VSTRING' => \(my $lvstring = eval "v" . 0 x 300),
    LVALUE         => \(my $substr  = substr((my $str = "foo"), 0, 3)));
 
-my $test = 14;
+my $test = 18;
 my $tests = $test + 41 + (2 * 6 * keys %::immortals) + (3 * keys %::weird_refs);
 plan(tests => $tests);
 
@@ -436,3 +436,32 @@ is(ref $t, 'STRESS_THE_STACK');
     like($msg, qr/Unexpected object type \(GLOB\) of class 'GlobHooked' in store_hook\(\) calling GlobHookedBase::STORABLE_freeze/,
          "check we get the verbose message");
 }
+
+SKIP:
+{
+    $] < 5.012
+      and skip "Can't assign regexps directly before 5.12", 4;
+    my $hook_called;
+    # store regexp via hook
+    {
+        package RegexpHooked;
+        sub STORABLE_freeze {
+            ++$hook_called;
+            "$_[0]";
+        }
+        sub STORABLE_thaw {
+            my ($obj, $cloning, $serialized) = @_;
+            ++$hook_called;
+            $$obj = ${ qr/$serialized/ };
+        }
+    }
+
+    my $obj = bless qr/abc/, "RegexpHooked";
+    my $data = freeze($obj);
+    ok($data, "froze regexp blessed into hooked class");
+    ok($hook_called, "and the hook was actually called");
+    $hook_called = 0;
+    my $obj_thawed = thaw($data);
+    ok($hook_called, "hook called for thaw");
+    like("abc", $obj_thawed, "check the regexp");
+}