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