This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7de819913248bf11785dc6f3cf0b371f2a1ac88f
[perl5.git] / t / op / universal.t
1 #!./perl
2 #
3 # check UNIVERSAL
4 #
5
6 BEGIN {
7     chdir 't' if -d 't';
8     unshift @INC, '../lib' if -d '../lib';
9 }
10
11 print "1..72\n";
12
13 $a = {};
14 bless $a, "Bob";
15 print "not " unless $a->isa("Bob");
16 print "ok 1\n";
17
18 package Human;
19 sub eat {}
20
21 package Female;
22 @ISA=qw(Human);
23
24 package Alice;
25 @ISA=qw(Bob Female);
26 sub drink {}
27 sub new { bless {} }
28
29 $Alice::VERSION = 2.718;
30
31 package main;
32
33 my $i = 2;
34 sub test { print "not " unless shift; print "ok $i\n"; $i++; }
35
36 $a = new Alice;
37
38 test $a->isa("Alice");
39
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");
68 test ! $a->can("export_tags");  # a method in Exporter
69
70 test (eval { $a->VERSION }) == 2.718;
71
72 test ! (eval { $a->VERSION(2.719) }) &&
73          $@ =~ /^Alice version 2.71(?:9|8999\d+) required--this is only version 2.718 at /;
74
75 test (eval { $a->VERSION(2.718) }) && ! $@;
76
77 my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
78 if ('a' lt 'A') {
79     test $subs eq "can isa VERSION";
80 } else {
81     test $subs eq "VERSION can isa";
82 }
83
84 test $a->isa("UNIVERSAL");
85
86 # now use UNIVERSAL.pm and see what changes
87 eval "use UNIVERSAL";
88
89 test $a->isa("UNIVERSAL");
90
91 my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
92 # XXX import being here is really a bug
93 if ('a' lt 'A') {
94     test $sub2 eq "can import isa VERSION";
95 } else {
96     test $sub2 eq "VERSION can import isa";
97 }
98
99 eval 'sub UNIVERSAL::sleep {}';
100 test $a->can("sleep");
101
102 test ! UNIVERSAL::can($b, "can");
103
104 test ! $a->can("export_tags");  # a method in Exporter