require "./test.pl";
}
-plan tests => 109;
+plan tests => 117;
$a = {};
bless $a, "Bob";
cmp_ok eval { $a->VERSION }, '==', 2.718;
ok ! (eval { $a->VERSION(2.719) });
-like $@, qr/^Alice version 2.719 \(v2\.719\.0\) required--this is only version 2.718 \(v2\.718\.0\) at /;
+like $@, qr/^Alice version 2.719 required--this is only version 2.718 at /;
ok (eval { $a->VERSION(2.718) });
is $@, '';
## The test for import here is *not* because we want to ensure that UNIVERSAL
## can always import; it is an historical accident that UNIVERSAL can import.
if ('a' lt 'A') {
- is $subs, "can does import isa VERSION";
+ is $subs, "can import isa DOES VERSION";
} else {
- is $subs, "VERSION can does import isa";
+ is $subs, "DOES VERSION can import isa";
}
ok $a->isa("UNIVERSAL");
my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
# XXX import being here is really a bug
if ('a' lt 'A') {
- is $sub2, "can does import isa VERSION";
+ is $sub2, "can import isa DOES VERSION";
} else {
- is $sub2, "VERSION can does import isa";
+ is $sub2, "DOES VERSION can import isa";
}
eval 'sub UNIVERSAL::sleep {}';
package Foo;
-sub does { 1 }
+sub DOES { 1 }
package Bar;
package Baz;
package main;
-ok( Foo->does( 'bar' ), 'does() should call does() on class' );
-ok( Bar->does( 'Bar' ), '... and should fall back to isa()' );
-ok( Bar->does( 'Foo' ), '... even when inherited' );
-ok( Baz->does( 'Baz' ), '... even without inheriting any other does()' );
-ok( ! Baz->does( 'Foo' ), '... returning true or false appropriately' );
+ok( Foo->DOES( 'bar' ), 'DOES() should call DOES() on class' );
+ok( Bar->DOES( 'Bar' ), '... and should fall back to isa()' );
+ok( Bar->DOES( 'Foo' ), '... even when inherited' );
+ok( Baz->DOES( 'Baz' ), '... even without inheriting any other DOES()' );
+ok( ! Baz->DOES( 'Foo' ), '... returning true or false appropriately' );
+
+package Pig;
+package Bodine;
+Bodine->isa('Pig');
+*isa = \&UNIVERSAL::isa;
+eval { isa({}, 'HASH') };
+::is($@, '', "*isa correctly found");
+
+package main;
+eval { UNIVERSAL::DOES([], "foo") };
+like( $@, qr/Can't call method "DOES" on unblessed reference/,
+ 'DOES call error message says DOES, not isa' );
+
+# Tests for can seem to be split between here and method.t
+# Add the verbatim perl code mentioned in the comments of
+# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-05/msg01710.html
+# but never actually tested.
+is(UNIVERSAL->can("NoSuchPackage::foo"), undef);
+
+@splatt::ISA = 'zlopp';
+ok (splatt->isa('zlopp'));
+ok (!splatt->isa('plop'));
+
+# This should reset the ->isa lookup cache
+@splatt::ISA = 'plop';
+# And here is the new truth.
+ok (!splatt->isa('zlopp'));
+ok (splatt->isa('plop'));
+
+use warnings "deprecated";
+{
+ my $m;
+ local $SIG{__WARN__} = sub { $m = $_[0] };
+ eval "use UNIVERSAL";
+ like($m, qr/^UNIVERSAL->import is deprecated/,
+ "deprecation warning for UNIVERSAL->import");
+}