This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Invalidate method cache on C<local *subname>
[perl5.git] / t / op / method.t
CommitLineData
92d69e20
IZ
1#!./perl
2
3#
4# test method calls and autoloading.
5#
6
fae75791 7print "1..26\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
22test( A->d, "C::d"); # Update hash table;
23
24*B::d = \&D::d; # Import now.
25test (A->d, "D::d"); # Update hash table;
26
44a8e56a 27{
fb73857a
PP
28 local @A::ISA = qw(C); # Update hash table with split() assignment
29 test (A->d, "C::d");
30 $#A::ISA = -1;
31 test (eval { A->d } || "fail", "fail");
32}
33test (A->d, "D::d");
34
35{
44a8e56a
PP
36 local *B::d;
37 eval 'sub B::d {"B::d1"}'; # Import now.
38 test (A->d, "B::d1"); # Update hash table;
39 undef &B::d;
40 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
41}
92d69e20 42
44a8e56a 43test (A->d, "D::d"); # Back to previous state
92d69e20
IZ
44
45eval 'sub B::d {"B::d2"}'; # Import now.
46test (A->d, "B::d2"); # Update hash table;
47
48# What follows is hardly guarantied to work, since the names in scripts
49# are already linked to "pruned" globs. Say, `undef &B::d' if it were
50# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
51
52undef &B::d;
53delete $B::{d};
54test (A->d, "C::d"); # Update hash table;
55
56eval 'sub B::d {"B::d3"}'; # Import now.
57test (A->d, "B::d3"); # Update hash table;
58
59delete $B::{d};
60*dummy::dummy = sub {}; # Mark as updated
61test (A->d, "C::d");
62
63eval 'sub B::d {"B::d4"}'; # Import now.
64test (A->d, "B::d4"); # Update hash table;
65
66delete $B::{d}; # Should work without any help too
67test (A->d, "C::d");
68
fae75791
CS
69{
70 local *C::d;
71 test (eval { A->d } || "nope", "nope");
72}
73test (A->d, "C::d");
74
44a8e56a
PP
75*A::x = *A::d; # See if cache incorrectly follows synonyms
76A->d;
77test (eval { A->x } || "nope", "nope");
78
92d69e20
IZ
79eval <<'EOF';
80sub C::e;
09280a33 81BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
92d69e20
IZ
82sub Y::f;
83$counter = 0;
84
54310121 85@X::ISA = 'Y';
dc848c6f 86@Y::ISA = 'B';
92d69e20
IZ
87
88sub B::AUTOLOAD {
89 my $c = ++$counter;
90 my $method = $B::AUTOLOAD;
09280a33
CS
91 my $msg = "B: In $method, $c";
92 eval "sub $method { \$msg }";
93 goto &$method;
92d69e20
IZ
94}
95sub C::AUTOLOAD {
96 my $c = ++$counter;
97 my $method = $C::AUTOLOAD;
09280a33
CS
98 my $msg = "C: In $method, $c";
99 eval "sub $method { \$msg }";
100 goto &$method;
92d69e20
IZ
101}
102EOF
103
104test(A->e(), "C: In C::e, 1"); # We get a correct autoload
105test(A->e(), "C: In C::e, 1"); # Which sticks
106
107test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
108test(A->ee(), "B: In A::ee, 2"); # Which sticks
109
110test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method
111test(Y->f(), "B: In Y::f, 3"); # Which sticks
112
113# This test is not intended to be reasonable. It is here just to let you
114# know that you broke some old construction. Feel free to rewrite the test
115# if your patch breaks it.
116
117*B::AUTOLOAD = sub {
118 my $c = ++$counter;
44a8e56a
PP
119 my $method = $AUTOLOAD;
120 *$AUTOLOAD = sub { "new B: In $method, $c" };
121 goto &$AUTOLOAD;
92d69e20
IZ
122};
123
124test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload
125test(A->eee(), "new B: In A::eee, 4"); # Which sticks
fb73857a
PP
126
127# this test added due to bug discovery
128test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");