[PATCH] Make Test::More::can_ok() use objects, not just classes

[chromatic]

I'm writing a new module called Test::MockObject.  It has a test that reads:

        $mock->add('foo');
        can_ok( $mock, 'foo' );

Test::MockObject has a custom can() method, which checks instance data to decide if
the object can handle the method:

        sub can {
                my ($self, $sub) = @_;
                return exists $self->{_subs}{$sub};
        }

Attached is a patch to make Test::More do the right thing (as I see it) in this
case.  Previously, it called can() on the class name, which obviously doesn't
work here.

I suspect something similar should be done for isa_ok().

The included test fails with vanilla 0.43 and passes with the attached patch.

Maybe it would be better to bless a scalar,
-- c

--- lib/Test/More.old   Sat Apr 20 11:29:07 2002
+++ lib/Test/More.pm    Sat Apr 20 11:44:56 2002
@@ -454,21 +454,21 @@
 =cut
 
 sub can_ok ($@) {
-    my($proto, @methods) = @_;
-    my $class= ref $proto || $proto;
+    my($class, @methods) = @_;
 
     unless( @methods ) {
         my $ok = $Test->ok( 0, "$class->can(...)" );
         $Test->diag('    can_ok() called with no methods');
         return $ok;
     }
+       my $can_test = ref( $class ) ?
+               sub { $class->can($_[0]) } : sub { eval "$class->can('$_[0]')" };
 
     my @nok = ();
     foreach my $method (@methods) {
-        my $test = "'$class'->can('$method')";
         local($!, $@);  # don't interfere with caller's $@
                         # eval sometimes resets $!
-        eval $test || push @nok, $method;
+        eval { $can_test->($method) } || push @nok, $method;
     }
 
     my $name;
--- t/More.old  Sat Apr 20 11:29:25 2002
+++ t/More.t    Sat Apr 20 11:44:58 2002
@@ -7,7 +7,7 @@
     }
 }
 
-use Test::More tests => 37;
+use Test::More tests => 39;
 
 # Make sure we don't mess with $@ or $!.  Test at bottom.
 my $Err   = "this should not be touched";
@@ -38,10 +38,19 @@
 can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip 
                                    can_ok pass fail eq_array eq_hash eq_set));
 
+# can_ok() should call can() on object, not just class, in case of custom can()
+{
+       local *Foo::can;
+       *Foo::can = sub { $_[0]->[0] };
+       my $foo = bless([0], 'Foo');
+       ok( ! $foo->can('bar') );
+       $foo->[0] = 1;
+       can_ok( $foo, 'blah');
+}
+
 isa_ok(bless([], "Foo"), "Foo");
 isa_ok([], 'ARRAY');
 isa_ok(\42, 'SCALAR');
-
 
 pass('pass() passed');