1 files changed, 35 insertions, 7 deletions

diff --git a/ext/Storable/t/code.t b/ext/Storable/t/code.t
index b66cae7116..81e8b9037d 100644
--- a/ext/Storable/t/code.t
+++ b/ext/Storable/t/code.t
@@ -38,7 +38,7 @@ BEGIN {
     }
 }
 
-BEGIN { plan tests => 49 }
+BEGIN { plan tests => 59 }
 
 use Storable qw(retrieve store nstore freeze nfreeze thaw dclone);
 use Safe;
@@ -118,7 +118,7 @@ ok($thawed->(), "JAPH");
 ######################################################################
 
 eval { $freezed = freeze $obj[4] };
-ok($@ =~ /The result of B::Deparse::coderef2text was empty/);
+ok($@, qr/The result of B::Deparse::coderef2text was empty/);
 
 ######################################################################
 # Test dclone
@@ -162,7 +162,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	$freezed = freeze $obj[$i];
 	$@ = "";
 	eval { $thawed  = thaw $freezed };
-	ok($@ =~ /Can\'t eval/);
+	ok($@, qr/Can\'t eval/);
     }
 }
 
@@ -172,7 +172,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
     for my $i (0 .. 1) {
 	$@ = "";
 	eval { $freezed = freeze $obj[$i] };
-	ok($@ =~ /Can\'t store CODE items/);
+	ok($@, qr/Can\'t store CODE items/);
     }
 }
 
@@ -184,7 +184,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	$@ = "";
 	eval { $thawed  = thaw $freezed };
 	ok($@, "");
-	ok($$thawed =~ /^sub/);
+	ok($$thawed, qr/^sub/);
     }
 }
 
@@ -218,7 +218,8 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
     $freezed = freeze $obj[0]->[6];
     eval { $thawed = thaw $freezed };
-    ok($@ =~ /trapped/);
+    # The "Code sub ..." error message only appears if Log::Agent is installed
+    ok($@, qr/(trapped|Code sub)/);
 
     if (0) {
 	# Disable or fix this test if the internal representation of Storable
@@ -234,7 +235,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	substr($freezed, -1, 0, $bad_code);
 	$@ = "";
 	eval { $thawed = thaw $freezed };
-	ok($@ =~ /trapped/);
+	ok($@, qr/(trapped|Code sub)/);
     }
 }
 
@@ -282,3 +283,30 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
     }
 }
 
+{
+    # Check internal "seen" code
+    my $short_sub = sub { "short sub" }; # for SX_SCALAR
+    # for SX_LSCALAR
+    my $long_sub_code = 'sub { "' . "x"x255 . '" }';
+    my $long_sub = eval $long_sub_code; die $@ if $@;
+    my $sclr = \1;
+
+    local $Storable::Deparse = 1;
+    local $Storable::Eval    = 1;
+
+    for my $sub ($short_sub, $long_sub) {
+	my $res;
+
+	$res = thaw freeze [$sub, $sub];
+	ok(int($res->[0]), int($res->[1]));
+
+	$res = thaw freeze [$sclr, $sub, $sub, $sclr];
+	ok(int($res->[0]), int($res->[3]));
+	ok(int($res->[1]), int($res->[2]));
+
+	$res = thaw freeze [$sub, $sub, $sclr, $sclr];
+	ok(int($res->[0]), int($res->[1]));
+	ok(int($res->[2]), int($res->[3]));
+    }
+
+}