Commit | Line | Data |
---|---|---|
44a8e56a | 1 | #!./perl |
2 | # | |
3 | # check UNIVERSAL | |
4 | # | |
5 | ||
e09f3e01 MG |
6 | BEGIN { |
7 | chdir 't' if -d 't'; | |
20822f61 | 8 | @INC = '../lib'; |
46e4b22b | 9 | $| = 1; |
e09f3e01 MG |
10 | } |
11 | ||
22b06de7 | 12 | print "1..87\n"; |
44a8e56a | 13 | |
14 | $a = {}; | |
15 | bless $a, "Bob"; | |
ff0cee69 | 16 | print "not " unless $a->isa("Bob"); |
17 | print "ok 1\n"; | |
44a8e56a | 18 | |
ff0cee69 | 19 | package Human; |
20 | sub eat {} | |
44a8e56a | 21 | |
ff0cee69 | 22 | package Female; |
23 | @ISA=qw(Human); | |
44a8e56a | 24 | |
ff0cee69 | 25 | package Alice; |
26 | @ISA=qw(Bob Female); | |
39d11b7f TB |
27 | sub sing; |
28 | sub drink { return "drinking " . $_[1] } | |
ff0cee69 | 29 | sub new { bless {} } |
44a8e56a | 30 | |
e09f3e01 MG |
31 | $Alice::VERSION = 2.718; |
32 | ||
46e4b22b GS |
33 | { |
34 | package Cedric; | |
35 | our @ISA; | |
36 | use base qw(Human); | |
37 | } | |
38 | ||
39 | { | |
40 | package Programmer; | |
41 | our $VERSION = 1.667; | |
42 | ||
43 | sub write_perl { 1 } | |
44 | } | |
45 | ||
44a8e56a | 46 | package main; |
e09f3e01 | 47 | |
39d11b7f TB |
48 | { my $i = 2; |
49 | sub test { print "not " unless shift; print "ok $i\n"; $i++; } | |
50 | } | |
e09f3e01 | 51 | |
ff0cee69 | 52 | $a = new Alice; |
44a8e56a | 53 | |
e09f3e01 | 54 | test $a->isa("Alice"); |
44a8e56a | 55 | |
e09f3e01 MG |
56 | test $a->isa("Bob"); |
57 | ||
58 | test $a->isa("Female"); | |
59 | ||
60 | test $a->isa("Human"); | |
61 | ||
62 | test ! $a->isa("Male"); | |
63 | ||
46e4b22b GS |
64 | test ! $a->isa('Programmer'); |
65 | ||
e09f3e01 | 66 | test $a->can("eat"); |
e09f3e01 | 67 | test ! $a->can("sleep"); |
39d11b7f TB |
68 | test my $ref = $a->can("drink"); # returns a coderef |
69 | test $a->$ref("tea") eq "drinking tea"; # ... which works | |
70 | test $ref = $a->can("sing"); | |
444e39b5 | 71 | eval { $a->$ref() }; |
39d11b7f | 72 | test $@; # ... but not if no actual subroutine |
e09f3e01 | 73 | |
46e4b22b GS |
74 | test (!Cedric->isa('Programmer')); |
75 | ||
76 | test (Cedric->isa('Human')); | |
77 | ||
78 | push(@Cedric::ISA,'Programmer'); | |
79 | ||
80 | test (Cedric->isa('Programmer')); | |
81 | ||
82 | { | |
83 | package Alice; | |
84 | base::->import('Programmer'); | |
85 | } | |
86 | ||
87 | test $a->isa('Programmer'); | |
88 | test $a->isa("Female"); | |
89 | ||
90 | @Cedric::ISA = qw(Bob); | |
91 | ||
92 | test (!Cedric->isa('Programmer')); | |
93 | ||
e09f3e01 MG |
94 | my $b = 'abc'; |
95 | my @refs = qw(SCALAR SCALAR LVALUE GLOB ARRAY HASH CODE); | |
96 | my @vals = ( \$b, \3.14, \substr($b,1,1), \*b, [], {}, sub {} ); | |
97 | for ($p=0; $p < @refs; $p++) { | |
98 | for ($q=0; $q < @vals; $q++) { | |
99 | test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1); | |
100 | }; | |
101 | }; | |
102 | ||
103 | test ! UNIVERSAL::can(23, "can"); | |
104 | ||
105 | test $a->can("VERSION"); | |
106 | ||
107 | test $a->can("can"); | |
84902520 | 108 | test ! $a->can("export_tags"); # a method in Exporter |
e09f3e01 MG |
109 | |
110 | test (eval { $a->VERSION }) == 2.718; | |
111 | ||
112 | test ! (eval { $a->VERSION(2.719) }) && | |
ae165b0c | 113 | $@ =~ /^Alice version 2.71(?:9|8999\d+) required--this is only version 2.718 at /; |
44a8e56a | 114 | |
e09f3e01 | 115 | test (eval { $a->VERSION(2.718) }) && ! $@; |
ff0cee69 | 116 | |
e09f3e01 | 117 | my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; |
9d116dd7 JH |
118 | if ('a' lt 'A') { |
119 | test $subs eq "can isa VERSION"; | |
120 | } else { | |
121 | test $subs eq "VERSION can isa"; | |
122 | } | |
ff0cee69 | 123 | |
e09f3e01 | 124 | test $a->isa("UNIVERSAL"); |
ff0cee69 | 125 | |
b4c2bf25 MG |
126 | test ! UNIVERSAL::isa([], "UNIVERSAL"); |
127 | ||
128 | test ! UNIVERSAL::can({}, "can"); | |
129 | ||
130 | test UNIVERSAL::isa(Alice => "UNIVERSAL"); | |
131 | ||
132 | test UNIVERSAL::can(Alice => "can") == \&UNIVERSAL::can; | |
133 | ||
84902520 | 134 | # now use UNIVERSAL.pm and see what changes |
e09f3e01 | 135 | eval "use UNIVERSAL"; |
ff0cee69 | 136 | |
e09f3e01 | 137 | test $a->isa("UNIVERSAL"); |
44a8e56a | 138 | |
46e4b22b | 139 | my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; |
84902520 | 140 | # XXX import being here is really a bug |
9d116dd7 JH |
141 | if ('a' lt 'A') { |
142 | test $sub2 eq "can import isa VERSION"; | |
143 | } else { | |
144 | test $sub2 eq "VERSION can import isa"; | |
145 | } | |
44a8e56a | 146 | |
e09f3e01 MG |
147 | eval 'sub UNIVERSAL::sleep {}'; |
148 | test $a->can("sleep"); | |
44a8e56a | 149 | |
e09f3e01 | 150 | test ! UNIVERSAL::can($b, "can"); |
84902520 TB |
151 | |
152 | test ! $a->can("export_tags"); # a method in Exporter | |
83f7a2bc GS |
153 | |
154 | test ! UNIVERSAL::isa("\xff\xff\xff\0", 'HASH'); |