| Subject: | assert_isa does ref(), not isa() |
Distribution name and version: Carp::Assert::More version 1.02
Perl version: This is perl, v5.8.4 built for i386-linux-thread-multi
OS vendor and version: Linux passoa 2.4.27-i686 #3 SMP
The function assert_isa is misleading and does not support objects that are blessed into subclasses of the supplied $type argument.
Please try the following code:
-----------------
#!/usr/bin/perl
use Carp::Assert::More;
package A; our @ISA = qw/B/; sub new { bless {}, "A"; }
package main;
my $a = new A;
print "Object is B\n" if $a->isa("B");
assert_isa($a, "B");
-----------------
The attached patch resolves this and also fixes the tests in t/.
diff -urb Carp-Assert-More-1.02.orig/More.pm Carp-Assert-More-1.02/More.pm
--- Carp-Assert-More-1.02.orig/More.pm 2004-10-06 00:30:49.000000000 +0200
+++ Carp-Assert-More-1.02/More.pm 2004-10-18 15:09:11.000000000 +0200
@@ -335,10 +335,21 @@
assert_defined( $this, $name );
- if ( ref($this) ne $type ) {
+ # The assertion is true if
+ # 1) For objects, $this is of class $type or of a subclass of $type
+ # 2) For non-objects, $this is a reference to a HASH, SCALAR, ARRAY, etc.
+
+ require Scalar::Util;
+
+ if ( blessed( $this ) && $this->isa( $type ) ) {
+ return; # assertion is true for objects
+ }
+
+ elsif ( ref($this) ne $type ) {
+ return; # assertion is true for non-objects
+
require Carp;
&Carp::confess( _fail_msg($name) );
- }
}
=head2 assert_like( $string, qr/regex/ [,$name] )
diff -urb Carp-Assert-More-1.02.orig/t/assert_hashref.t Carp-Assert-More-1.02/t/assert_hashref.t
--- Carp-Assert-More-1.02.orig/t/assert_hashref.t 2004-10-05 21:38:15.000000000 +0200
+++ Carp-Assert-More-1.02/t/assert_hashref.t 2004-10-18 15:01:00.000000000 +0200
@@ -47,8 +47,9 @@
};
like( $@, qr/Assertion.*failed/ );
-# Foo->new isn't, strictly speaking, a hashref
+# Foo->new->isa("HASH") returns true, so do we
eval {
assert_hashref( Foo->new );
};
-like( $@, qr/Assertion.*failed/ );
+is( $@, '' );
+
diff -urb Carp-Assert-More-1.02.orig/t/assert_isa.t Carp-Assert-More-1.02/t/assert_isa.t
--- Carp-Assert-More-1.02.orig/t/assert_isa.t 2004-10-06 00:28:42.000000000 +0200
+++ Carp-Assert-More-1.02/t/assert_isa.t 2004-10-18 14:44:19.000000000 +0200
@@ -14,6 +14,7 @@
eval {
my $fh = new IO::File;
assert_isa( $fh, 'IO::File', 'Created an IO::File object' );
+ assert_isa( $fh, 'GLOB', 'Created an IO::File object, which is a GLOB' );
};
is( $@, '' );
diff -urb Carp-Assert-More-1.02.orig/t/assert_listref.t Carp-Assert-More-1.02/t/assert_listref.t
--- Carp-Assert-More-1.02.orig/t/assert_listref.t 2004-10-05 21:38:09.000000000 +0200
+++ Carp-Assert-More-1.02/t/assert_listref.t 2004-10-18 15:01:40.000000000 +0200
@@ -54,8 +54,8 @@
};
like( $@, qr/Assertion.*failed/ );
-# Foo->new isn't, strictly speaking, a listref
+# Foo->new->isa("ARRAY") returns true, so do we
eval {
assert_listref( Foo->new );
};
-like( $@, qr/Assertion.*failed/ );
+is( $@, '' );