You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2014/07/11 21:04:06 UTC
[8/8] git commit: Make Storable failures graceful.
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/fb9f9efb
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/fb9f9efb
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/fb9f9efb
Branch: refs/heads/master
Commit: fb9f9efb8b5a861bb35cc99a201e1b554dc690d2
Parents: 1642349
Author: Marvin Humphrey <ma...@rectangular.com>
Authored: Wed Jul 9 19:55:14 2014 -0700
Committer: Marvin Humphrey <ma...@rectangular.com>
Committed: Fri Jul 11 12:02:20 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/fb9f9efb/runtime/perl/lib/Clownfish.pm
----------------------------------------------------------------------
diff --git a/runtime/perl/lib/Clownfish.pm b/runtime/perl/lib/Clownfish.pm
index e1baa6e..e0ede72 100644
--- a/runtime/perl/lib/Clownfish.pm
+++ b/runtime/perl/lib/Clownfish.pm
@@ -85,6 +85,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/fb9f9efb/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" );