This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Plural nit.
[perl5.git] / t / op / method.t
CommitLineData
92d69e20
IZ
1#!./perl
2
3#
4# test method calls and autoloading.
5#
6
4755096e
GS
7BEGIN {
8 chdir 't' if -d 't';
20822f61 9 @INC = '../lib';
4755096e
GS
10}
11
a397c3d9 12print "1..73\n";
92d69e20
IZ
13
14@A::ISA = 'B';
15@B::ISA = 'C';
16
17sub C::d {"C::d"}
18sub D::d {"D::d"}
19
20my $cnt = 0;
21sub test {
22 print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1];
23 # print "not " unless shift eq shift;
a82f768a 24 print "ok ", ++$cnt, "\n"
92d69e20
IZ
25}
26
567ce7b1
SM
27# First, some basic checks of method-calling syntax:
28$obj = bless [], "Pack";
29sub Pack::method { shift; join(",", "method", @_) }
30$mname = "method";
31
32test(Pack->method("a","b","c"), "method,a,b,c");
33test(Pack->$mname("a","b","c"), "method,a,b,c");
34test(method Pack ("a","b","c"), "method,a,b,c");
35test((method Pack "a","b","c"), "method,a,b,c");
36
37test(Pack->method(), "method");
38test(Pack->$mname(), "method");
39test(method Pack (), "method");
40test(Pack->method, "method");
41test(Pack->$mname, "method");
42test(method Pack, "method");
43
44test($obj->method("a","b","c"), "method,a,b,c");
45test($obj->$mname("a","b","c"), "method,a,b,c");
46test((method $obj ("a","b","c")), "method,a,b,c");
47test((method $obj "a","b","c"), "method,a,b,c");
145eb477
RH
48
49test($obj->method(0), "method,0");
50test($obj->method(1), "method,1");
567ce7b1
SM
51
52test($obj->method(), "method");
53test($obj->$mname(), "method");
54test((method $obj ()), "method");
55test($obj->method, "method");
56test($obj->$mname, "method");
57test(method $obj, "method");
58
92d69e20
IZ
59test( A->d, "C::d"); # Update hash table;
60
61*B::d = \&D::d; # Import now.
62test (A->d, "D::d"); # Update hash table;
63
44a8e56a 64{
fb73857a
PP
65 local @A::ISA = qw(C); # Update hash table with split() assignment
66 test (A->d, "C::d");
67 $#A::ISA = -1;
68 test (eval { A->d } || "fail", "fail");
69}
70test (A->d, "D::d");
71
72{
44a8e56a
PP
73 local *B::d;
74 eval 'sub B::d {"B::d1"}'; # Import now.
75 test (A->d, "B::d1"); # Update hash table;
76 undef &B::d;
77 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
78}
92d69e20 79
44a8e56a 80test (A->d, "D::d"); # Back to previous state
92d69e20
IZ
81
82eval 'sub B::d {"B::d2"}'; # Import now.
83test (A->d, "B::d2"); # Update hash table;
84
85# What follows is hardly guarantied to work, since the names in scripts
86# are already linked to "pruned" globs. Say, `undef &B::d' if it were
87# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
88
89undef &B::d;
90delete $B::{d};
91test (A->d, "C::d"); # Update hash table;
92
93eval 'sub B::d {"B::d3"}'; # Import now.
94test (A->d, "B::d3"); # Update hash table;
95
96delete $B::{d};
97*dummy::dummy = sub {}; # Mark as updated
98test (A->d, "C::d");
99
100eval 'sub B::d {"B::d4"}'; # Import now.
101test (A->d, "B::d4"); # Update hash table;
102
103delete $B::{d}; # Should work without any help too
104test (A->d, "C::d");
105
fae75791
CS
106{
107 local *C::d;
108 test (eval { A->d } || "nope", "nope");
109}
110test (A->d, "C::d");
111
44a8e56a
PP
112*A::x = *A::d; # See if cache incorrectly follows synonyms
113A->d;
114test (eval { A->x } || "nope", "nope");
115
92d69e20
IZ
116eval <<'EOF';
117sub C::e;
09280a33 118BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
92d69e20
IZ
119sub Y::f;
120$counter = 0;
121
54310121 122@X::ISA = 'Y';
dc848c6f 123@Y::ISA = 'B';
92d69e20
IZ
124
125sub B::AUTOLOAD {
126 my $c = ++$counter;
127 my $method = $B::AUTOLOAD;
09280a33
CS
128 my $msg = "B: In $method, $c";
129 eval "sub $method { \$msg }";
130 goto &$method;
92d69e20
IZ
131}
132sub C::AUTOLOAD {
133 my $c = ++$counter;
134 my $method = $C::AUTOLOAD;
09280a33
CS
135 my $msg = "C: In $method, $c";
136 eval "sub $method { \$msg }";
137 goto &$method;
92d69e20
IZ
138}
139EOF
140
141test(A->e(), "C: In C::e, 1"); # We get a correct autoload
142test(A->e(), "C: In C::e, 1"); # Which sticks
143
144test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
145test(A->ee(), "B: In A::ee, 2"); # Which sticks
146
147test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method
148test(Y->f(), "B: In Y::f, 3"); # Which sticks
149
150# This test is not intended to be reasonable. It is here just to let you
151# know that you broke some old construction. Feel free to rewrite the test
152# if your patch breaks it.
153
154*B::AUTOLOAD = sub {
155 my $c = ++$counter;
44a8e56a
PP
156 my $method = $AUTOLOAD;
157 *$AUTOLOAD = sub { "new B: In $method, $c" };
158 goto &$AUTOLOAD;
92d69e20
IZ
159};
160
161test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload
162test(A->eee(), "new B: In A::eee, 4"); # Which sticks
fb73857a
PP
163
164# this test added due to bug discovery
6051dbdb 165test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
f6ec51f7
GS
166
167# test that failed subroutine calls don't affect method calls
168{
169 package A1;
170 sub foo { "foo" }
171 package A2;
172 @ISA = 'A1';
173 package main;
174 test(A2->foo(), "foo");
175 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
176 test(A2->foo(), "foo");
177}
c1899e02 178
af09ea45
IK
179## This test was totally misguided. It passed before only because the
180## code to determine if a package was loaded used to look for the hash
181## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just
182## happens to export %Config.
183# {
184# test(do { use Config; eval 'Config->foo()';
185# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
186# test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()';
187# $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
188# }
189
190
191# test error messages if method loading fails
192test(do { eval '$e = bless {}, "E::A"; E::A->foo()';
193 $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1);
194test(do { eval '$e = bless {}, "E::B"; $e->foo()';
195 $@ =~ /^\QCan't locate object method "foo" via package "E::B" at/ ? 1 : $@}, 1);
196test(do { eval 'E::C->foo()';
197 $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1);
198
199test(do { eval 'UNIVERSAL->E::D::foo()';
200 $@ =~ /^\QCan't locate object method "foo" via package "E::D" (perhaps / ? 1 : $@}, 1);
201test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
202 $@ =~ /^\QCan't locate object method "foo" via package "E::E" (perhaps / ? 1 : $@}, 1);
203
204$e = bless {}, "E::F"; # force package to exist
205test(do { eval 'UNIVERSAL->E::F::foo()';
206 $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
207test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
208 $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
209
210# TODO: we need some tests for the SUPER:: pseudoclass
211
212# failed method call or UNIVERSAL::can() should not autovivify packages
213test( $::{"Foo::"} || "none", "none"); # sanity check 1
214test( $::{"Foo::"} || "none", "none"); # sanity check 2
c1899e02 215
af09ea45
IK
216test( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" );
217test( $::{"Foo::"} || "none", "none"); # still missing?
218
219test( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" );
220test( $::{"Foo::"} || "none", "none"); # still missing?
221
222test( Foo->can("boogie") ? "yes":"no", "no" );
223test( $::{"Foo::"} || "none", "none"); # still missing?
224
225test( eval 'Foo->boogie(); 1' ? "yes":"no", "no" );
226test( $::{"Foo::"} || "none", "none"); # still missing?
227
228test(do { eval 'Foo->boogie()';
229 $@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1);
230
231eval 'sub Foo::boogie { "yes, sir!" }';
232test( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now
233test( Foo->boogie(), "yes, sir!");
234
235# TODO: universal.t should test NoSuchPackage->isa()/can()
c1899e02 236
f0670693
SC
237# This is actually testing parsing of indirect objects and undefined subs
238# print foo("bar") where foo does not exist is not an indirect object.
239# print foo "bar" where foo does not exist is an indirect object.
240eval { sub AUTOLOAD { "ok ", shift, "\n"; } };
241print nonsuch(++$cnt);
af09ea45 242
a397c3d9
RGS
243# Bug ID 20010902.002
244test (
245 eval q[
246 $x = 'x';
247 sub Foo::x : lvalue { $x }
248 Foo->$x = 'ok';
249 ] || $@, 'ok'
250);
251
af09ea45 252print "# $cnt tests completed\n";