improve error reporting by store_hook() on an unknown type

This produced an opaque message when it was asked to freeze an
object of an unsupported type.  Changes:

- replace the opaque internal object type number with the typical perl name of the
  type ("GLOB" instead of "8")
- include the class of the object being frozen to identify which class needs work
- include name of the function we're trying to call to do the freeze,
  if possible

2 files changed, 38 insertions, 6 deletions

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 682a78e912..67ebba8afb 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -3583,7 +3583,10 @@ static int store_hook(
     int need_large_oids = 0;
 #endif
 
-    TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), (int)cxt->tagnum));
+    classname = HvNAME_get(pkg);
+    len = strlen(classname);
+
+    TRACEME(("store_hook, classname \"%s\", tagged #%d", classname, (int)cxt->tagnum));
 
     /*
      * Determine object type on 2 bits.
@@ -3631,13 +3634,20 @@ static int store_hook(
         }
         break;
     default:
-        CROAK(("Unexpected object type (%d) in store_hook()", type));
+        {
+            /* pkg_can() always returns a ref to a CV on success */
+            CV *cv = (CV*)SvRV(hook);
+            const GV * const gv = CvGV(cv);
+            const char *gvname = GvNAME(gv);
+            const HV * const stash = GvSTASH(gv);
+            const char *hvname = stash ? HvNAME(stash) : NULL;
+
+            CROAK(("Unexpected object type (%s) of class '%s' in store_hook() calling %s::%s",
+                   sv_reftype(sv, FALSE), classname, hvname, gvname));
+        }
     }
     flags = SHF_NEED_RECURSE | obj_type;
 
-    classname = HvNAME_get(pkg);
-    len = strlen(classname);
-
     /*
      * To call the hook, we need to fake a call like:
      *
diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t
index d9a77b3723..398f21f80e 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 = 13;
+my $test = 14;
 my $tests = $test + 41 + (2 * 6 * keys %::immortals) + (3 * keys %::weird_refs);
 plan(tests => $tests);
 
@@ -414,3 +414,25 @@ is(ref $t, 'STRESS_THE_STACK');
 
     unlink("store$$");
 }
+
+{
+    # trying to freeze a glob via STORABLE_freeze
+    {
+        package GlobHookedBase;
+
+        sub STORABLE_freeze {
+            return \1;
+        }
+
+        package GlobHooked;
+        our @ISA = "GlobHookedBase";
+    }
+    use Symbol ();
+    my $glob = bless Symbol::gensym(), "GlobHooked";
+    eval {
+        my $data = freeze($glob);
+    };
+    my $msg = $@;
+    like($msg, qr/Unexpected object type \(GLOB\) of class 'GlobHooked' in store_hook\(\) calling GlobHookedBase::STORABLE_freeze/,
+         "check we get the verbose message");
+}