lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From nwelln...@apache.org
Subject [2/2] git commit: Define a custom class for thaw test object
Date Thu, 17 Jul 2014 15:19:22 GMT
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 <wellnhofer@aevum.de>
Authored: Thu Jul 17 17:16:00 2014 +0200
Committer: Nick Wellnhofer <wellnhofer@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" );


Mime
View raw message