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