lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject [1/2] git commit: Make Storable failures graceful.
Date Thu, 10 Jul 2014 05:20:04 GMT
Repository: lucy-clownfish
Updated Branches:
  refs/heads/prep_cpan_dist_for_0.4.0 7a69398d8 -> 02c105c68


Make Storable failures graceful.

Throw exceptions rather than segfault when Clownfish objects are
serialized using Storable.


Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/0b806ea7
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/0b806ea7
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/0b806ea7

Branch: refs/heads/prep_cpan_dist_for_0.4.0
Commit: 0b806ea7af97754beabc27db0921f55bf310ccb3
Parents: 7a69398
Author: Marvin Humphrey <marvin@rectangular.com>
Authored: Wed Jul 9 19:55:14 2014 -0700
Committer: Marvin Humphrey <marvin@rectangular.com>
Committed: Wed Jul 9 19:55:14 2014 -0700

----------------------------------------------------------------------
 runtime/perl/lib/Clownfish.pm    |  9 +++++++++
 runtime/perl/t/binding/019-obj.t | 17 ++++++++++++++++-
 2 files changed, 25 insertions(+), 1 deletion(-)
----------------------------------------------------------------------


http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0b806ea7/runtime/perl/lib/Clownfish.pm
----------------------------------------------------------------------
diff --git a/runtime/perl/lib/Clownfish.pm b/runtime/perl/lib/Clownfish.pm
index 5b02103..ac625a8 100644
--- a/runtime/perl/lib/Clownfish.pm
+++ b/runtime/perl/lib/Clownfish.pm
@@ -86,6 +86,15 @@ sub error {$Clownfish::Err::error}
     our $VERSION = '0.003000';
     $VERSION = eval $VERSION;
     use Clownfish qw( to_clownfish to_perl );
+    use Carp qw( confess );
+    sub STORABLE_freeze {
+        my $class_name = ref(shift);
+        confess("Storable serialization not implemented for $class_name");
+    }
+    sub STORABLE_thaw {
+        my $class_name = ref(shift);
+        confess("Storable serialization not implemented for $class_name");
+    }
 }
 
 {

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0b806ea7/runtime/perl/t/binding/019-obj.t
----------------------------------------------------------------------
diff --git a/runtime/perl/t/binding/019-obj.t b/runtime/perl/t/binding/019-obj.t
index 5560f48..ce9e9d9 100644
--- a/runtime/perl/t/binding/019-obj.t
+++ b/runtime/perl/t/binding/019-obj.t
@@ -16,7 +16,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 17;
 
 package TestObj;
 use base qw( Clownfish::Obj );
@@ -43,6 +43,7 @@ use base qw( Clownfish::Obj );
 }
 
 package main;
+use Storable qw( freeze thaw );
 
 ok( defined $TestObj::version,
     "Using base class should grant access to "
@@ -53,6 +54,20 @@ my $object = TestObj->new;
 isa_ok( $object, "Clownfish::Obj",
     "Clownfish objects can be subclassed" );
 
+{
+    no warnings 'once';
+    eval { freeze($object) };
+    like( $@, qr/implement/i,
+        "freezing an Obj throws an exception rather than segfaults" );
+    *TestObj::STORABLE_freeze = sub {"meep"};
+    local *TestObj::DESTROY = sub {};
+    my $fake = bless {}, 'TestObj';
+    my $frozen = freeze($fake);
+    eval { thaw($frozen) };
+    like( $@, qr/implement/,
+        "thawing an Obj throws an exception rather than segfaults" );
+}
+
 ok( $object->is_a("Clownfish::Obj"),     "custom is_a correct" );
 ok( !$object->is_a("Clownfish::Object"), "custom is_a too long" );
 ok( !$object->is_a("Clownfish"),         "custom is_a substring" );


Mime
View raw message