From cc4aa37cf0381fa64942b6fb2777fcec81dbc43d Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 28 Jun 2012 22:17:23 -0500
Subject: [PATCH] fix storing objects with reftype REF [perl #113880]

---
 dist/Storable/Storable.xs |  1 +
 dist/Storable/t/blessed.t | 32 +++++++++++++++++++++++++++++++-
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 1ac528a..3975ac9 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -2860,6 +2860,7 @@ static int store_hook(
 	 */
 
 	switch (type) {
+        case svis_REF:
 	case svis_SCALAR:
 		obj_type = SHT_SCALAR;
 		break;
diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t
index 6b25f37..775592d 100644
--- a/dist/Storable/t/blessed.t
+++ b/dist/Storable/t/blessed.t
@@ -26,8 +26,16 @@ use Storable qw(freeze thaw store retrieve);
      n => \(1 == 0)
 );
 
+{
+    %::weird_refs = (
+        REF     => \(my $aref    = []),
+        VSTRING => \(my $vstring = v1.2.3),
+        LVALUE  => \(my $substr  = substr((my $str = "foo"), 0, 3)),
+    );
+}
+
 my $test = 12;
-my $tests = $test + 23 + 2 * 6 * keys %::immortals;
+my $tests = $test + 23 + (2 * 6 * keys %::immortals) + (2 * keys %::weird_refs);
 plan(tests => $tests);
 
 package SHORT_NAME;
@@ -258,3 +266,25 @@ is(ref $t, 'STRESS_THE_STACK');
     ::is ref $o->{str}, __PACKAGE__,
 	'assignment to $_[0] in STORABLE_freeze does not corrupt things';
 }
+
+# [perl #113880]
+{
+    {
+        package WeirdRefHook;
+        sub STORABLE_freeze { }
+        $INC{'WeirdRefHook.pm'} = __FILE__;
+    }
+
+    for my $weird (keys %weird_refs) {
+        my $obj = $weird_refs{$weird};
+        bless $obj, 'WeirdRefHook';
+        my $frozen;
+        my $success = eval { $frozen = freeze($obj); 1 };
+        ok($success, "can freeze $weird objects")
+            || diag("freezing failed: $@");
+        local $TODO = $weird eq 'VSTRING'
+            ? "can't store vstrings properly yet"
+            : undef;
+        is_deeply(thaw($frozen), $obj, "get the right value back");
+    }
+}
-- 
2.7.4