You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by nw...@apache.org on 2014/07/17 17:19:22 UTC
[2/2] git commit: Define a custom class for thaw test object
Define a custom class for thaw test object
On my platform, the local DESTROY method used for the thaw test
didn't have an effect resulting in a warning during cleanup.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/e68aa863
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/e68aa863
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/e68aa863
Branch: refs/heads/master
Commit: e68aa863e35913003657fb006769eb7b71e3d2e0
Parents: eefe705
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Thu Jul 17 17:16:00 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Thu Jul 17 17:16:00 2014 +0200
----------------------------------------------------------------------
runtime/perl/t/binding/019-obj.t | 31 +++++++++++++++++--------------
1 file changed, 17 insertions(+), 14 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/e68aa863/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 32b2e16..0c2734f 100644
--- a/runtime/perl/t/binding/019-obj.t
+++ b/runtime/perl/t/binding/019-obj.t
@@ -42,6 +42,13 @@ use base qw( Clownfish::Obj );
}
}
+package ThawTestObj;
+use base qw( Clownfish::Obj );
+{
+ sub STORABLE_freeze {"meep"}
+ sub DESTROY {}
+}
+
package main;
use Storable qw( freeze thaw );
@@ -54,20 +61,16 @@ my $object = TestObj->new;
isa_ok( $object, "Clownfish::Obj",
"Clownfish objects can be subclassed" );
-{
- no warnings 'once';
- my $thawed = TestObj->new;
- eval { freeze($thawed) };
- 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" );
-}
+my $thawed = TestObj->new;
+eval { freeze($thawed) };
+like( $@, qr/implement/i,
+ "freezing an Obj throws an exception rather than segfaults" );
+
+my $fake = bless {}, 'ThawTestObj';
+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" );