This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix spelling: precede
[perl5.git] / t / uni / universal.t
1 #!./perl
2 #
3 # check UNIVERSAL
4 #
5
6 BEGIN {
7     chdir 't' if -d 't';
8     $| = 1;
9     require "./test.pl";
10     set_up_inc(qw '../lib ../dist/base/lib');
11 }
12
13 use utf8;
14 use open qw( :utf8 :std );
15
16 plan tests => 90;
17
18 $a = {};
19 bless $a, "Bòb";
20 ok $a->isa("Bòb");
21
22 package Hùmàn;
23 sub èàt {}
24
25 package Fèmàlè;
26 @ISA=qw(Hùmàn);
27
28 package Àlìcè;
29 @ISA=qw(Bòb Fèmàlè);
30 sub sìng;
31 sub drìnk { return "drinking " . $_[1]  }
32 sub nèw { bless {} }
33
34 $Àlìcè::VERSION = 2.718;
35
36 {
37     package Cèdrìc;
38     our @ISA;
39     use base qw(Hùmàn);
40 }
41
42 {
43     package Prògràmmèr;
44     our $VERSION = 1.667;
45
46     sub wrìtè_perl { 1 }
47 }
48
49 package main;
50
51 $a = nèw Àlìcè;
52
53 ok $a->isa("Àlìcè");
54 ok $a->isa("main::Àlìcè");    # check that alternate class names work
55 ok(("main::Àlìcè"->nèw)->isa("Àlìcè"));
56
57 ok $a->isa("Bòb");
58 ok $a->isa("main::Bòb");
59
60 ok $a->isa("Fèmàlè");
61
62 ok $a->isa("Hùmàn");
63
64 ok ! $a->isa("Màlè");
65
66 ok ! $a->isa('Prògràmmèr');
67
68 ok $a->isa("HASH");
69
70 ok $a->can("èàt");
71 ok ! $a->can("sleep");
72 ok my $ref = $a->can("drìnk");        # returns a coderef
73 is $a->$ref("tèà"), "drinking tèà"; # ... which works
74 ok $ref = $a->can("sìng");
75 eval { $a->$ref() };
76 ok $@;                                # ... but not if no actual subroutine
77
78 ok $a->can("VERSION");
79 cmp_ok eval { $a->VERSION }, '==', 2.718;
80 ok ! (eval { $a->VERSION(2.719) });
81 like $@, qr/^Àlìcè version 2.719 required--this is only version 2.718 at /u;
82
83 ok (!Cèdrìc->isa('Prògràmmèr'));
84
85 ok (Cèdrìc->isa('Hùmàn'));
86
87 push(@Cèdrìc::ISA,'Prògràmmèr');
88
89 ok (Cèdrìc->isa('Prògràmmèr'));
90
91 {
92     package Àlìcè;
93     base::->import('Prògràmmèr');
94 }
95
96 ok $a->isa('Prògràmmèr');
97 ok $a->isa("Fèmàlè");
98
99 @Cèdrìc::ISA = qw(Bòb);
100
101 ok (!Cèdrìc->isa('Prògràmmèr'));
102
103 my $b = 'abc';
104 my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
105 my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
106 for ($p=0; $p < @refs; $p++) {
107     for ($q=0; $q < @vals; $q++) {
108         is UNIVERSAL::isa($vals[$p], $refs[$q]), ($p==$q or $p+$q==1);
109     };
110 };
111
112
113 ok UNIVERSAL::isa(Àlìcè => "UNIVERSAL");
114
115 cmp_ok UNIVERSAL::can(Àlìcè => "can"), '==', \&UNIVERSAL::can;
116
117 eval 'sub UNIVERSAL::slèèp {}';
118 ok $a->can("slèèp");
119
120 package Fòò;
121
122 sub DOES { 1 }
123
124 package Bàr;
125
126 @Bàr::ISA = 'Fòò';
127
128 package Bàz;
129
130 package main;
131 ok( Fòò->DOES( 'bàr' ), 'DOES() should call DOES() on class' );
132 ok( Bàr->DOES( 'Bàr' ), '... and should fall back to isa()' );
133 ok( Bàr->DOES( 'Fòò' ), '... even when inherited' );
134 ok( Bàz->DOES( 'Bàz' ), '... even without inheriting any other DOES()' );
135 ok( ! Bàz->DOES( 'Fòò' ), '... returning true or false appropriately' );
136
137 package Pìg;
138 package Bòdìnè;
139 Bòdìnè->isa('Pìg');
140
141 package main;
142 eval { UNIVERSAL::DOES([], "fòò") };
143 like( $@, qr/Can't call method "DOES" on unblessed reference/,
144     'DOES call error message says DOES, not isa' );
145
146 # Tests for can seem to be split between here and method.t
147 # Add the verbatim perl code mentioned in the comments of
148 # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-05/msg01710.html
149 # but never actually tested.
150 is(UNIVERSAL->can("NòSùchPàckàgè::fòò"), undef);
151
152 @splàtt::ISA = 'zlòpp';
153 ok (splàtt->isa('zlòpp'));
154 ok (!splàtt->isa('plòp'));
155
156 # This should reset the ->isa lookup cache
157 @splàtt::ISA = 'plòp';
158 # And here is the new truth.
159 ok (!splàtt->isa('zlòpp'));
160 ok (splàtt->isa('plòp'));
161
162