[PATCH] More Test::More stuff

[Dave Rolsky]

Ok, forget the last patch.  This one incorporates that plus more.

This one also adds an eval_ok function.  The idea here is that sometimes
you simply want to try something to see if it works or not.  If it fails
it will append the error ($@) after the name of the test.

The reason for these patches is that I'm trying to use Test::More for
Alzabo and these are some changes that would make it more useful for me.

-dave


--- More.t.old  Mon Sep 24 18:35:39 2001
+++ More.t      Mon Sep 24 18:39:35 2001
@@ -1,4 +1,4 @@
-use Test::More tests => 22;
+use Test::More tests => 25;

 use_ok('Text::Soundex');
 require_ok('Test::More');
@@ -20,7 +20,10 @@
                                    can_ok pass fail eq_array eq_hash
eq_set));

 isa_ok(bless([], "Foo"), "Foo");
+isa_ok(bless([], "Foo"), "Foo", "Optional description to isa_ok");

+eval_ok( sub { 1 }, "eval_ok 1" );
+eval_ok { 1 } "eval_ok 2";

 pass('pass() passed');

--- More.pm.old Mon Sep 24 18:35:27 2001
+++ More.pm     Mon Sep 24 18:39:14 2001
@@ -25,6 +25,7 @@
              $TODO
              plan
              can_ok  isa_ok
+             eval_ok
             );


@@ -447,7 +448,7 @@

 =item B<isa_ok>

-  isa_ok($object, $class);
+  isa_ok($object, $class, $optional_name);

 Checks to see if the given $object->isa($class).  Also checks to make
 sure the object was defined in the first place.  Handy for this sort
@@ -465,11 +466,11 @@

 =cut

-sub isa_ok ($$) {
-    my($object, $class) = @_;
+sub isa_ok ($$;$) {
+    my($object, $class, $name) = @_;

     my $diag;
-    my $name = "object->isa('$class')";
+    $name ||= "object->isa('$class')";
     if( !defined $object ) {
         $diag = "The object isn't defined";
     }
@@ -491,6 +492,35 @@
     }
 }

+=item B<eval_ok>
+
+  eval_ok( sub { code ... }, $name );
+
+    or
+
+  eval_ok { code ... } $name;
+
+Checks to see that a code block can be called in an C<eval> without
+throwing an exception.
+
+If it fails it will print the exception after the name as part of the
+test status.
+
+This is useful if you are calling a block of code simply to make sure
+it doesn't die.
+
+=cut
+
+sub eval_ok (&$) {
+    my ($code, $name) = @_;
+
+    eval { $code->() };
+    if ($@) {
+       ok( 0, "$name - $@" );
+    } else {
+       ok( 1, $name );
+    }
+}