Commit | Line | Data |
92d69e20 |
1 | #!./perl |
2 | |
3 | # |
4 | # test method calls and autoloading. |
5 | # |
6 | |
44a8e56a |
7 | print "1..20\n"; |
92d69e20 |
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 |
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 |
65 | eval <<'EOF'; |
66 | sub C::e; |
09280a33 |
67 | BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg |
92d69e20 |
68 | sub Y::f; |
69 | $counter = 0; |
70 | |
54310121 |
71 | @X::ISA = 'Y'; |
dc848c6f |
72 | @Y::ISA = 'B'; |
92d69e20 |
73 | |
74 | sub B::AUTOLOAD { |
75 | my $c = ++$counter; |
76 | my $method = $B::AUTOLOAD; |
09280a33 |
77 | my $msg = "B: In $method, $c"; |
78 | eval "sub $method { \$msg }"; |
79 | goto &$method; |
92d69e20 |
80 | } |
81 | sub C::AUTOLOAD { |
82 | my $c = ++$counter; |
83 | my $method = $C::AUTOLOAD; |
09280a33 |
84 | my $msg = "C: In $method, $c"; |
85 | eval "sub $method { \$msg }"; |
86 | goto &$method; |
92d69e20 |
87 | } |
88 | EOF |
89 | |
90 | test(A->e(), "C: In C::e, 1"); # We get a correct autoload |
91 | test(A->e(), "C: In C::e, 1"); # Which sticks |
92 | |
93 | test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top |
94 | test(A->ee(), "B: In A::ee, 2"); # Which sticks |
95 | |
96 | test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method |
97 | test(Y->f(), "B: In Y::f, 3"); # Which sticks |
98 | |
99 | # This test is not intended to be reasonable. It is here just to let you |
100 | # know that you broke some old construction. Feel free to rewrite the test |
101 | # if your patch breaks it. |
102 | |
103 | *B::AUTOLOAD = sub { |
104 | my $c = ++$counter; |
44a8e56a |
105 | my $method = $AUTOLOAD; |
106 | *$AUTOLOAD = sub { "new B: In $method, $c" }; |
107 | goto &$AUTOLOAD; |
92d69e20 |
108 | }; |
109 | |
110 | test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload |
111 | test(A->eee(), "new B: In A::eee, 4"); # Which sticks |