[Poop-group] [PATCH] Test::Builder holds object inside

[Tatsuhiko M. <miy...@ed...>]

Here's a patch for Test::(Simple|More) to allow idioms like

  my $obj = Foo->new;
  ok($obj, 'object is defined');

Without this patch, passed $obj was referenced in Test::Builder, so
REFCNT doesn't come to 0 before global cleanup.


--
Tatsuhiko Miyagawa <miy...@ed...>


diff -ruP Test-Simple-0.46.orig/MANIFEST Test-Simple-0.46/MANIFEST
--- Test-Simple-0.46.orig/MANIFEST	Thu Aug 22 22:13:06 2002
+++ Test-Simple-0.46/MANIFEST	Thu Aug 22 22:25:21 2002
@@ -20,6 +20,8 @@
 t/fail-more.t
 t/fail.t
 t/filehandles.t
+t/has_plan.t
+t/has_plan2.t
 t/import.t
 t/is_deeply.t
 t/lib/Test/Simple/Catch.pm
@@ -40,6 +42,7 @@
 t/no_ending.t
 t/no_header.t
 t/no_plan.t
+t/ok_obj.t
 t/output.t
 t/plan.t
 t/plan_is_noplan.t
@@ -53,5 +56,3 @@
 t/undef.t
 t/use_ok.t
 t/useing.t
-t/has_plan.t
-t/has_plan2.t
diff -ruP Test-Simple-0.46.orig/lib/Test/Builder.pm Test-Simple-0.46/lib/Test/Builder.pm
--- Test-Simple-0.46.orig/lib/Test/Builder.pm	Thu Aug 22 22:13:06 2002
+++ Test-Simple-0.46/lib/Test/Builder.pm	Thu Aug 22 22:25:08 2002
@@ -303,7 +303,8 @@
         @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
     }
     else {
-        @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+	# $test might be object, so we evaluate it as bool
+        @$result{ 'ok', 'actual_ok' } = ( 1, $test ? 1 : 0 );
     }
 
     $out .= "ok";
diff -ruP Test-Simple-0.46.orig/t/ok_obj.t Test-Simple-0.46/t/ok_obj.t
--- Test-Simple-0.46.orig/t/ok_obj.t	Thu Jan  1 09:00:00 1970
+++ Test-Simple-0.46/t/ok_obj.t	Thu Aug 22 22:24:19 2002
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More tests => 4;
+
+package Foo;
+my $destroyed = 0;
+sub new { bless {}, shift }
+
+sub DESTROY {
+    $destroyed++;
+}
+
+package main;
+
+for (1..3) {
+    ok(my $foo = Foo->new, 'created Foo object');
+}
+is $destroyed, 3, "DESTROY called 3 times";
+