request does_ok() as per isa_ok() in Test::More/etc

[Darren Duncan <darren@darrenduncan.net>]

Hello,

I would like to request a simple new feature for the next CPAN release of
Test::More/Builder/Simple/etc (and by extension the next Perl 5 core since
those are bundled with it).

Please add a clone of the isa_ok() routine that has the name does_ok() and
that tests its main subject argument using ->does() rather than ->isa();
its second main parameter would be named $role rather than $class.

The functionality of the new routine would be like the Perl 6 Test.pm's
does_ok() routine, which has no counterpart in the current Test::More.

The rationale for having this now in Perl 5 is related to the greatly
increasing popularity of Moose, as well as other modules, that allow you to
introspect whether an object consumes a role.

For anyone using Moose roles these days, it is common for role consumption
to replace normal class inheritance, and often tests for Moose-using code
want to test that some code produced an object that consumes a role, rather
than that inherits a class.  For example we just want to test that an
object will provide an interface, but the actual class hierarchy doesn't
matter.

The current isa_ok() of Test::More does not test whether an object consumes
a role, and I don't see anything else in Test::More that will do the job
cleanly.

So far to work around the limitation, my Test::More-using
Muldis::Rosetta::Validator module on CPAN includes its own copy of isa_ok()
from 0.72 minimally modified as I mentioned (I have pasted a copy at the
end of this email as well, as a quasi-patch you can use).

But my copy is an inelegant solution compared to Test::More supporting the
functionality natively, especially since it is so similar to functionality
that Test::More already has.

I'll note that adding this feature to Test::More is not likely adding any
external dependencies, since it mainly just needs to test for provision of,
and then invoke, a does() method or routine, same as it now checks for isa().

Thank you in advance for this consideration.

-- Darren Duncan

--------------

# Modified clone of isa_ok from Test::More 0.72 (what Perl 5.10.0 bundles),
# since we actually want to test with does() rather than isa();
# it is identical to the original save the s/isa/does/g and s/class/role/g;
# this will probably be replaced later with something simple.
# Note: The internals of Test::More/etc were different at least as recently
# as version 0.62 (what Perl 5.8.8 bundles); 0.62 is incompat with this.

sub does_ok ($$;$) {
     my($object, $role, $obj_name) = @_;
     my $tb = Test::More->builder;
     my $diag;
     $obj_name = 'The object' unless defined $obj_name;
     my $name = "$obj_name does $role";
     if( !defined $object ) {
         $diag = "$obj_name isn't defined";
     }
     elsif( !ref $object ) {
         $diag = "$obj_name isn't a reference";
     }
     else {
         # We can't use UNIVERSAL::does because we want to honor does()
overrides
         my($rslt, $error) = $tb->_try(sub { $object->does($role) });
         if( $error ) {
             if( $error =~ /^Can't call method "does" on unblessed
reference/ ) {
                 # Its an unblessed reference
                 if( !UNIVERSAL::does($object, $role) ) {
                     my $ref = ref $object;
                     $diag = "$obj_name isn't a '$role' it's a '$ref'";
                 }
             } else {
                 die <<WHOA;
WHOA! I tried to call ->does on your object and got some weird error.
Here's the error.
$error
WHOA
             }
         }
         elsif( !$rslt ) {
             my $ref = ref $object;
             $diag = "$obj_name isn't a '$role' it's a '$ref'";
         }
     }
     my $ok;
     if( $diag ) {
         $ok = $tb->ok( 0, $name );
         $tb->diag("    $diag\n");
     }
     else {
         $ok = $tb->ok( 1, $name );
     }
     return $ok;
}

---

Follow-Ups from:

Matt S Trout <dbix-class@trout.me.uk>

---

[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

---