Commit | Line | Data |
---|---|---|
92d69e20 IZ |
1 | #!./perl |
2 | ||
3 | # | |
4 | # test method calls and autoloading. | |
5 | # | |
6 | ||
44a8e56a | 7 | print "1..20\n"; |
92d69e20 IZ |
8 | |
9 | @A::ISA = 'B'; | |
10 | @B::ISA = 'C'; | |
11 | ||
12 | sub C::d {"C::d"} | |
13 | sub D::d {"D::d"} | |
14 | ||
15 | my $cnt = 0; | |
16 | sub 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 | ||
22 | test( A->d, "C::d"); # Update hash table; | |
23 | ||
24 | *B::d = \&D::d; # Import now. | |
25 | test (A->d, "D::d"); # Update hash table; | |
26 | ||
44a8e56a | 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 | 35 | test (A->d, "D::d"); # Back to previous state |
92d69e20 IZ |
36 | |
37 | eval 'sub B::d {"B::d2"}'; # Import now. | |
38 | test (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 | ||
44 | undef &B::d; | |
45 | delete $B::{d}; | |
46 | test (A->d, "C::d"); # Update hash table; | |
47 | ||
48 | eval 'sub B::d {"B::d3"}'; # Import now. | |
49 | test (A->d, "B::d3"); # Update hash table; | |
50 | ||
51 | delete $B::{d}; | |
52 | *dummy::dummy = sub {}; # Mark as updated | |
53 | test (A->d, "C::d"); | |
54 | ||
55 | eval 'sub B::d {"B::d4"}'; # Import now. | |
56 | test (A->d, "B::d4"); # Update hash table; | |
57 | ||
58 | delete $B::{d}; # Should work without any help too | |
59 | test (A->d, "C::d"); | |
60 | ||
44a8e56a | 61 | *A::x = *A::d; # See if cache incorrectly follows synonyms |
62 | A->d; | |
63 | test (eval { A->x } || "nope", "nope"); | |
64 | ||
92d69e20 IZ |
65 | eval <<'EOF'; |
66 | sub C::e; | |
67 | sub Y::f; | |
68 | $counter = 0; | |
69 | ||
54310121 | 70 | @X::ISA = 'Y'; |
dc848c6f | 71 | @Y::ISA = 'B'; |
92d69e20 IZ |
72 | |
73 | sub B::AUTOLOAD { | |
74 | my $c = ++$counter; | |
75 | my $method = $B::AUTOLOAD; | |
76 | *$B::AUTOLOAD = sub { "B: In $method, $c" }; | |
77 | goto &$B::AUTOLOAD; | |
78 | } | |
79 | sub C::AUTOLOAD { | |
80 | my $c = ++$counter; | |
81 | my $method = $C::AUTOLOAD; | |
82 | *$C::AUTOLOAD = sub { "C: In $method, $c" }; | |
83 | goto &$C::AUTOLOAD; | |
84 | } | |
85 | EOF | |
86 | ||
87 | test(A->e(), "C: In C::e, 1"); # We get a correct autoload | |
88 | test(A->e(), "C: In C::e, 1"); # Which sticks | |
89 | ||
90 | test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top | |
91 | test(A->ee(), "B: In A::ee, 2"); # Which sticks | |
92 | ||
93 | test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method | |
94 | test(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 | 102 | my $method = $AUTOLOAD; |
103 | *$AUTOLOAD = sub { "new B: In $method, $c" }; | |
104 | goto &$AUTOLOAD; | |
92d69e20 IZ |
105 | }; |
106 | ||
107 | test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload | |
108 | test(A->eee(), "new B: In A::eee, 4"); # Which sticks |