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