First of all, I have Test::More 0.62 installed and Devel::Cover 0.55 under
Perl 5.8.2. I also have a simple test script:
$ cat test.pl
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 1;
$a = {};
isa_ok($a,'HASH');
...which works well under prove:
$ prove test.pl
test....ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.03 cusr + 0.00 csys = 0.03 CPU)
When I throw Devel::Cover into the mix, however, prove gets a little sick:
$ HARNESS_PERL_SWITCHES="-MDevel::Cover" prove test.pl
test....ok 1/1# Looks like your test died just after 1.
test....dubious
Test returned status 255 (wstat 65280, 0xff00)
after all the subtests completed successfully
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
test.pl 255 65280 1 0 0.00% ??
Failed 1/1 test scripts, 0.00% okay. 0/1 subtests failed, 100.00% okay.
After tracing this for a while, I found out this is because Test::More is
attempting to call ->isa on the empty, unblessed hashref. There's a
comment in the code about honoring isa() overrides, which I understand.
The problem lies in that Test::Builder overrides $SIG{__DIE__} with
something that checks the caller stack for an eval. However, for some
reason under D::C 0.55, this doesn't catch and prove thinks the test dies,
when it doesn't.
The solution I see is to make sure the object can() isa(), thus avoiding
the die in the process:
============================================================================
diff -ur Test-Simple-0.62/lib/Test/More.pm
Test-Simple-0.62-patched/lib/Test/More.pm
--- Test-Simple-0.62/lib/Test/More.pm 2005-10-08 01:56:17.000000000 -0500
+++ Test-Simple-0.62-patched/lib/Test/More.pm 2005-11-03 10:47:39.000000000
-0600
@@ -531,7 +531,7 @@
elsif( !ref $object ) {
$diag = "$obj_name isn't a reference";
}
- else {
+ elsif( UNIVERSAL::can($object,'isa') ) {
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
local($@, $!); # eval sometimes resets $!
my $rslt = eval { $object->isa($class) };
@@ -555,6 +555,12 @@
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
}
+ else {
+ if ( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
============================================================================
And that makes prove happy once more.
Thanks,
-Pete K
--
Pete Krawczyk
perl at bsod dot net
