This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
skip integrate of problematic change#6292 from cfgperl into mainline
[perl5.git] / t / op / method.t
CommitLineData
92d69e20
IZ
1#!./perl
2
3#
4# test method calls and autoloading.
5#
6
c1899e02 7print "1..53\n";
92d69e20
IZ
8
9@A::ISA = 'B';
10@B::ISA = 'C';
11
12sub C::d {"C::d"}
13sub D::d {"D::d"}
14
15my $cnt = 0;
16sub test {
17 print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1];
18 # print "not " unless shift eq shift;
19 print "ok ", ++$cnt, "\n"
20}
21
567ce7b1
SM
22# First, some basic checks of method-calling syntax:
23$obj = bless [], "Pack";
24sub Pack::method { shift; join(",", "method", @_) }
25$mname = "method";
26
27test(Pack->method("a","b","c"), "method,a,b,c");
28test(Pack->$mname("a","b","c"), "method,a,b,c");
29test(method Pack ("a","b","c"), "method,a,b,c");
30test((method Pack "a","b","c"), "method,a,b,c");
31
32test(Pack->method(), "method");
33test(Pack->$mname(), "method");
34test(method Pack (), "method");
35test(Pack->method, "method");
36test(Pack->$mname, "method");
37test(method Pack, "method");
38
39test($obj->method("a","b","c"), "method,a,b,c");
40test($obj->$mname("a","b","c"), "method,a,b,c");
41test((method $obj ("a","b","c")), "method,a,b,c");
42test((method $obj "a","b","c"), "method,a,b,c");
43
44test($obj->method(), "method");
45test($obj->$mname(), "method");
46test((method $obj ()), "method");
47test($obj->method, "method");
48test($obj->$mname, "method");
49test(method $obj, "method");
50
92d69e20
IZ
51test( A->d, "C::d"); # Update hash table;
52
53*B::d = \&D::d; # Import now.
54test (A->d, "D::d"); # Update hash table;
55
44a8e56a 56{
fb73857a
PP
57 local @A::ISA = qw(C); # Update hash table with split() assignment
58 test (A->d, "C::d");
59 $#A::ISA = -1;
60 test (eval { A->d } || "fail", "fail");
61}
62test (A->d, "D::d");
63
64{
44a8e56a
PP
65 local *B::d;
66 eval 'sub B::d {"B::d1"}'; # Import now.
67 test (A->d, "B::d1"); # Update hash table;
68 undef &B::d;
69 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
70}
92d69e20 71
44a8e56a 72test (A->d, "D::d"); # Back to previous state
92d69e20
IZ
73
74eval 'sub B::d {"B::d2"}'; # Import now.
75test (A->d, "B::d2"); # Update hash table;
76
77# What follows is hardly guarantied to work, since the names in scripts
78# are already linked to "pruned" globs. Say, `undef &B::d' if it were
79# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
80
81undef &B::d;
82delete $B::{d};
83test (A->d, "C::d"); # Update hash table;
84
85eval 'sub B::d {"B::d3"}'; # Import now.
86test (A->d, "B::d3"); # Update hash table;
87
88delete $B::{d};
89*dummy::dummy = sub {}; # Mark as updated
90test (A->d, "C::d");
91
92eval 'sub B::d {"B::d4"}'; # Import now.
93test (A->d, "B::d4"); # Update hash table;
94
95delete $B::{d}; # Should work without any help too
96test (A->d, "C::d");
97
fae75791
CS
98{
99 local *C::d;
100 test (eval { A->d } || "nope", "nope");
101}
102test (A->d, "C::d");
103
44a8e56a
PP
104*A::x = *A::d; # See if cache incorrectly follows synonyms
105A->d;
106test (eval { A->x } || "nope", "nope");
107
92d69e20
IZ
108eval <<'EOF';
109sub C::e;
09280a33 110BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
92d69e20
IZ
111sub Y::f;
112$counter = 0;
113
54310121 114@X::ISA = 'Y';
dc848c6f 115@Y::ISA = 'B';
92d69e20
IZ
116
117sub B::AUTOLOAD {
118 my $c = ++$counter;
119 my $method = $B::AUTOLOAD;
09280a33
CS
120 my $msg = "B: In $method, $c";
121 eval "sub $method { \$msg }";
122 goto &$method;
92d69e20
IZ
123}
124sub C::AUTOLOAD {
125 my $c = ++$counter;
126 my $method = $C::AUTOLOAD;
09280a33
CS
127 my $msg = "C: In $method, $c";
128 eval "sub $method { \$msg }";
129 goto &$method;
92d69e20
IZ
130}
131EOF
132
133test(A->e(), "C: In C::e, 1"); # We get a correct autoload
134test(A->e(), "C: In C::e, 1"); # Which sticks
135
136test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
137test(A->ee(), "B: In A::ee, 2"); # Which sticks
138
139test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method
140test(Y->f(), "B: In Y::f, 3"); # Which sticks
141
142# This test is not intended to be reasonable. It is here just to let you
143# know that you broke some old construction. Feel free to rewrite the test
144# if your patch breaks it.
145
146*B::AUTOLOAD = sub {
147 my $c = ++$counter;
44a8e56a
PP
148 my $method = $AUTOLOAD;
149 *$AUTOLOAD = sub { "new B: In $method, $c" };
150 goto &$AUTOLOAD;
92d69e20
IZ
151};
152
153test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload
154test(A->eee(), "new B: In A::eee, 4"); # Which sticks
fb73857a
PP
155
156# this test added due to bug discovery
6051dbdb 157test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
f6ec51f7
GS
158
159# test that failed subroutine calls don't affect method calls
160{
161 package A1;
162 sub foo { "foo" }
163 package A2;
164 @ISA = 'A1';
165 package main;
166 test(A2->foo(), "foo");
167 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
168 test(A2->foo(), "foo");
169}
c1899e02
GS
170
171{
172 test(do { use Config; eval 'Config->foo()';
173 $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
174 test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()';
175 $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
176}
177
178test(do { eval 'E->foo()';
179 $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1);
180test(do { eval '$e = bless {}, "E"; $e->foo()';
181 $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1);
182