Commit | Line | Data |
92d69e20 |
1 | #!./perl |
2 | |
3 | # |
4 | # test method calls and autoloading. |
5 | # |
6 | |
fae75791 |
7 | print "1..26\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 | { |
fb73857a |
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 | } |
33 | test (A->d, "D::d"); |
34 | |
35 | { |
44a8e56a |
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 |
43 | test (A->d, "D::d"); # Back to previous state |
92d69e20 |
44 | |
45 | eval 'sub B::d {"B::d2"}'; # Import now. |
46 | test (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 | |
52 | undef &B::d; |
53 | delete $B::{d}; |
54 | test (A->d, "C::d"); # Update hash table; |
55 | |
56 | eval 'sub B::d {"B::d3"}'; # Import now. |
57 | test (A->d, "B::d3"); # Update hash table; |
58 | |
59 | delete $B::{d}; |
60 | *dummy::dummy = sub {}; # Mark as updated |
61 | test (A->d, "C::d"); |
62 | |
63 | eval 'sub B::d {"B::d4"}'; # Import now. |
64 | test (A->d, "B::d4"); # Update hash table; |
65 | |
66 | delete $B::{d}; # Should work without any help too |
67 | test (A->d, "C::d"); |
68 | |
fae75791 |
69 | { |
70 | local *C::d; |
71 | test (eval { A->d } || "nope", "nope"); |
72 | } |
73 | test (A->d, "C::d"); |
74 | |
44a8e56a |
75 | *A::x = *A::d; # See if cache incorrectly follows synonyms |
76 | A->d; |
77 | test (eval { A->x } || "nope", "nope"); |
78 | |
92d69e20 |
79 | eval <<'EOF'; |
80 | sub C::e; |
09280a33 |
81 | BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg |
92d69e20 |
82 | sub Y::f; |
83 | $counter = 0; |
84 | |
54310121 |
85 | @X::ISA = 'Y'; |
dc848c6f |
86 | @Y::ISA = 'B'; |
92d69e20 |
87 | |
88 | sub B::AUTOLOAD { |
89 | my $c = ++$counter; |
90 | my $method = $B::AUTOLOAD; |
09280a33 |
91 | my $msg = "B: In $method, $c"; |
92 | eval "sub $method { \$msg }"; |
93 | goto &$method; |
92d69e20 |
94 | } |
95 | sub C::AUTOLOAD { |
96 | my $c = ++$counter; |
97 | my $method = $C::AUTOLOAD; |
09280a33 |
98 | my $msg = "C: In $method, $c"; |
99 | eval "sub $method { \$msg }"; |
100 | goto &$method; |
92d69e20 |
101 | } |
102 | EOF |
103 | |
104 | test(A->e(), "C: In C::e, 1"); # We get a correct autoload |
105 | test(A->e(), "C: In C::e, 1"); # Which sticks |
106 | |
107 | test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top |
108 | test(A->ee(), "B: In A::ee, 2"); # Which sticks |
109 | |
110 | test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method |
111 | test(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 |
119 | my $method = $AUTOLOAD; |
120 | *$AUTOLOAD = sub { "new B: In $method, $c" }; |
121 | goto &$AUTOLOAD; |
92d69e20 |
122 | }; |
123 | |
124 | test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload |
125 | test(A->eee(), "new B: In A::eee, 4"); # Which sticks |
fb73857a |
126 | |
127 | # this test added due to bug discovery |
128 | test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); |