Commit | Line | Data |
---|---|---|
44a8e56a | 1 | #!./perl |
2 | # | |
3 | # check UNIVERSAL | |
4 | # | |
5 | ||
e09f3e01 MG |
6 | BEGIN { |
7 | chdir 't' if -d 't'; | |
8 | @INC = '../lib' if -d '../lib'; | |
9 | } | |
10 | ||
84902520 | 11 | print "1..72\n"; |
44a8e56a | 12 | |
13 | $a = {}; | |
14 | bless $a, "Bob"; | |
ff0cee69 | 15 | print "not " unless $a->isa("Bob"); |
16 | print "ok 1\n"; | |
44a8e56a | 17 | |
ff0cee69 | 18 | package Human; |
19 | sub eat {} | |
44a8e56a | 20 | |
ff0cee69 | 21 | package Female; |
22 | @ISA=qw(Human); | |
44a8e56a | 23 | |
ff0cee69 | 24 | package Alice; |
25 | @ISA=qw(Bob Female); | |
26 | sub drink {} | |
27 | sub new { bless {} } | |
44a8e56a | 28 | |
e09f3e01 MG |
29 | $Alice::VERSION = 2.718; |
30 | ||
44a8e56a | 31 | package main; |
e09f3e01 MG |
32 | |
33 | my $i = 2; | |
34 | sub test { print "not " unless shift; print "ok $i\n"; $i++; } | |
35 | ||
ff0cee69 | 36 | $a = new Alice; |
44a8e56a | 37 | |
e09f3e01 | 38 | test $a->isa("Alice"); |
44a8e56a | 39 | |
e09f3e01 MG |
40 | test $a->isa("Bob"); |
41 | ||
42 | test $a->isa("Female"); | |
43 | ||
44 | test $a->isa("Human"); | |
45 | ||
46 | test ! $a->isa("Male"); | |
47 | ||
48 | test $a->can("drink"); | |
49 | ||
50 | test $a->can("eat"); | |
51 | ||
52 | test ! $a->can("sleep"); | |
53 | ||
54 | my $b = 'abc'; | |
55 | my @refs = qw(SCALAR SCALAR LVALUE GLOB ARRAY HASH CODE); | |
56 | my @vals = ( \$b, \3.14, \substr($b,1,1), \*b, [], {}, sub {} ); | |
57 | for ($p=0; $p < @refs; $p++) { | |
58 | for ($q=0; $q < @vals; $q++) { | |
59 | test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1); | |
60 | }; | |
61 | }; | |
62 | ||
63 | test ! UNIVERSAL::can(23, "can"); | |
64 | ||
65 | test $a->can("VERSION"); | |
66 | ||
67 | test $a->can("can"); | |
84902520 | 68 | test ! $a->can("export_tags"); # a method in Exporter |
e09f3e01 MG |
69 | |
70 | test (eval { $a->VERSION }) == 2.718; | |
71 | ||
72 | test ! (eval { $a->VERSION(2.719) }) && | |
73 | $@ =~ /^Alice version 2.719 required--this is only version 2.718 at /; | |
44a8e56a | 74 | |
e09f3e01 | 75 | test (eval { $a->VERSION(2.718) }) && ! $@; |
ff0cee69 | 76 | |
e09f3e01 | 77 | my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; |
9d116dd7 JH |
78 | if ('a' lt 'A') { |
79 | test $subs eq "can isa VERSION"; | |
80 | } else { | |
81 | test $subs eq "VERSION can isa"; | |
82 | } | |
ff0cee69 | 83 | |
e09f3e01 | 84 | test $a->isa("UNIVERSAL"); |
ff0cee69 | 85 | |
84902520 | 86 | # now use UNIVERSAL.pm and see what changes |
e09f3e01 | 87 | eval "use UNIVERSAL"; |
ff0cee69 | 88 | |
e09f3e01 | 89 | test $a->isa("UNIVERSAL"); |
44a8e56a | 90 | |
e09f3e01 | 91 | my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; |
84902520 | 92 | # XXX import being here is really a bug |
9d116dd7 JH |
93 | if ('a' lt 'A') { |
94 | test $sub2 eq "can import isa VERSION"; | |
95 | } else { | |
96 | test $sub2 eq "VERSION can import isa"; | |
97 | } | |
44a8e56a | 98 | |
e09f3e01 MG |
99 | eval 'sub UNIVERSAL::sleep {}'; |
100 | test $a->can("sleep"); | |
44a8e56a | 101 | |
e09f3e01 | 102 | test ! UNIVERSAL::can($b, "can"); |
84902520 TB |
103 | |
104 | test ! $a->can("export_tags"); # a method in Exporter |