This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5db: add tests for v command
[perl5.git] / t / uni / universal.t
CommitLineData
072cb3f5
BF
1#!./perl
2#
3# check UNIVERSAL
4#
5
6BEGIN {
7 chdir 't' if -d 't';
072cb3f5
BF
8 $| = 1;
9 require "./test.pl";
624c42e2 10 set_up_inc(qw '../lib ../dist/base/lib');
072cb3f5
BF
11}
12
13use utf8;
14use open qw( :utf8 :std );
15
1178d2cf 16plan tests => 90;
072cb3f5
BF
17
18$a = {};
19bless $a, "Bòb";
20ok $a->isa("Bòb");
21
22package Hùmàn;
23sub èàt {}
24
25package Fèmàlè;
26@ISA=qw(Hùmàn);
27
28package Àlìcè;
29@ISA=qw(Bòb Fèmàlè);
30sub sìng;
31sub drìnk { return "drinking " . $_[1] }
32sub 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
49package main;
50
51$a = nèw Àlìcè;
52
53ok $a->isa("Àlìcè");
1b48ba24 54ok $a->isa("main::Àlìcè"); # check that alternate class names work
072cb3f5
BF
55ok(("main::Àlìcè"->nèw)->isa("Àlìcè"));
56
57ok $a->isa("Bòb");
1b48ba24 58ok $a->isa("main::Bòb");
072cb3f5
BF
59
60ok $a->isa("Fèmàlè");
61
62ok $a->isa("Hùmàn");
63
64ok ! $a->isa("Màlè");
65
66ok ! $a->isa('Prògràmmèr');
67
68ok $a->isa("HASH");
69
70ok $a->can("èàt");
71ok ! $a->can("sleep");
72ok my $ref = $a->can("drìnk"); # returns a coderef
73is $a->$ref("tèà"), "drinking tèà"; # ... which works
74ok $ref = $a->can("sìng");
75eval { $a->$ref() };
76ok $@; # ... but not if no actual subroutine
77
78ok $a->can("VERSION");
79cmp_ok eval { $a->VERSION }, '==', 2.718;
80ok ! (eval { $a->VERSION(2.719) });
81like $@, qr/^Àlìcè version 2.719 required--this is only version 2.718 at /u;
82
83ok (!Cèdrìc->isa('Prògràmmèr'));
84
85ok (Cèdrìc->isa('Hùmàn'));
86
87push(@Cèdrìc::ISA,'Prògràmmèr');
88
89ok (Cèdrìc->isa('Prògràmmèr'));
90
91{
92 package Àlìcè;
93 base::->import('Prògràmmèr');
94}
95
96ok $a->isa('Prògràmmèr');
97ok $a->isa("Fèmàlè");
98
99@Cèdrìc::ISA = qw(Bòb);
100
101ok (!Cèdrìc->isa('Prògràmmèr'));
102
103my $b = 'abc';
104my @refs = qw(SCALAR SCALAR LVALUE GLOB ARRAY HASH CODE);
105my @vals = ( \$b, \3.14, \substr($b,1,1), \*b, [], {}, sub {} );
106for ($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
113ok UNIVERSAL::isa(Àlìcè => "UNIVERSAL");
114
115cmp_ok UNIVERSAL::can(Àlìcè => "can"), '==', \&UNIVERSAL::can;
116
117eval 'sub UNIVERSAL::slèèp {}';
118ok $a->can("slèèp");
119
072cb3f5
BF
120package Fòò;
121
122sub DOES { 1 }
123
124package Bàr;
125
126@Bàr::ISA = 'Fòò';
127
128package Bàz;
129
130package main;
131ok( Fòò->DOES( 'bàr' ), 'DOES() should call DOES() on class' );
132ok( Bàr->DOES( 'Bàr' ), '... and should fall back to isa()' );
133ok( Bàr->DOES( 'Fòò' ), '... even when inherited' );
134ok( Bàz->DOES( 'Bàz' ), '... even without inheriting any other DOES()' );
135ok( ! Bàz->DOES( 'Fòò' ), '... returning true or false appropriately' );
136
137package Pìg;
138package Bòdìnè;
139Bòdìnè->isa('Pìg');
140
141package main;
142eval { UNIVERSAL::DOES([], "fòò") };
143like( $@, 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.
150is(UNIVERSAL->can("NòSùchPàckàgè::fòò"), undef);
151
152@splàtt::ISA = 'zlòpp';
153ok (splàtt->isa('zlòpp'));
154ok (!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.
159ok (!splàtt->isa('zlòpp'));
160ok (splàtt->isa('plòp'));
161
162