X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Funiversal.t;h=b7d452fc5a643d7facc8ae9946dfeec2505f5139;hb=e24631be6ac297b562086a055de17c5bd4247797;hp=f8c15d761f1f196707d1e95c7723b2ff2369d36d;hpb=ea8fae293543a7d3ec6f09254a20517959143189;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/universal.t b/t/op/universal.t index f8c15d7..b7d452f 100755 --- a/t/op/universal.t +++ b/t/op/universal.t @@ -9,7 +9,7 @@ BEGIN { $| = 1; } -print "1..90\n"; +print "1..101\n"; $a = {}; bless $a, "Bob"; @@ -49,7 +49,7 @@ package main; sub test { print "not " unless $_[0]; print "ok ", $i++; - print "# at ", (caller)[1], ", line ", (caller)[2] unless $_[0]; + print " # at ", (caller)[1], ", line ", (caller)[2] unless $_[0]; print "\n"; } } @@ -57,8 +57,12 @@ package main; $a = new Alice; test $a->isa("Alice"); +test $a->isa("main::Alice"); # check that alternate class names work + +test(("main::Alice"->new)->isa("Alice")); test $a->isa("Bob"); +test $a->isa("main::Bob"); test $a->isa("Female"); @@ -68,6 +72,8 @@ test ! $a->isa("Male"); test ! $a->isa('Programmer'); +test $a->isa("HASH"); + test $a->can("eat"); test ! $a->can("sleep"); test my $ref = $a->can("drink"); # returns a coderef @@ -115,7 +121,7 @@ test ! $a->can("export_tags"); # a method in Exporter test (eval { $a->VERSION }) == 2.718; test ! (eval { $a->VERSION(2.719) }) && - $@ =~ /^Alice version 2.71(?:9|8999\d+) required--this is only version 2.718 at /; + $@ =~ /^Alice version 2.719 \(2\.719\.0\) required--this is only version 2.718 \(2\.718\.0\) at /; test (eval { $a->VERSION(2.718) }) && ! $@; @@ -168,3 +174,30 @@ test ! UNIVERSAL::isa("\xff\xff\xff\0", 'HASH'); main::test can( "Pickup", "can" ) == \&UNIVERSAL::can; main::test VERSION "UNIVERSAL" ; } + +{ + # test isa() and can() on magic variables + "Human" =~ /(.*)/; + test $1->isa("Human"); + test $1->can("eat"); + package HumanTie; + sub TIESCALAR { bless {} } + sub FETCH { "Human" } + tie my($x), "HumanTie"; + ::test $x->isa("Human"); + ::test $x->can("eat"); +} + +# bugid 3284 +# a second call to isa('UNIVERSAL') when @ISA is null failed due to caching + +@X::ISA=(); +my $x = {}; bless $x, 'X'; +test $x->isa('UNIVERSAL'); +test $x->isa('UNIVERSAL'); + + +# Check that the "historical accident" of UNIVERSAL having an import() +# method doesn't effect anyone else. +eval { Some::Package->import("bar") }; +test !$@;