Commit | Line | Data |
44a8e56a |
1 | #!./perl |
2 | # |
3 | # check UNIVERSAL |
4 | # |
5 | |
e09f3e01 |
6 | BEGIN { |
7 | chdir 't' if -d 't'; |
93430cb4 |
8 | unshift @INC, '../lib' if -d '../lib'; |
e09f3e01 |
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 |
29 | $Alice::VERSION = 2.718; |
30 | |
44a8e56a |
31 | package main; |
e09f3e01 |
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 |
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 |
69 | |
70 | test (eval { $a->VERSION }) == 2.718; |
71 | |
72 | test ! (eval { $a->VERSION(2.719) }) && |
ae165b0c |
73 | $@ =~ /^Alice version 2.71(?:9|8999\d+) 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 |
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 |
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 |
99 | eval 'sub UNIVERSAL::sleep {}'; |
100 | test $a->can("sleep"); |
44a8e56a |
101 | |
e09f3e01 |
102 | test ! UNIVERSAL::can($b, "can"); |
84902520 |
103 | |
104 | test ! $a->can("export_tags"); # a method in Exporter |