4 # test method calls and autoloading.
22 print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1];
23 # print "not " unless shift eq shift;
24 print "ok ", ++$cnt, "\n"
27 # First, some basic checks of method-calling syntax:
28 $obj = bless [], "Pack";
29 sub Pack::method { shift; join(",", "method", @_) }
32 test(Pack->method("a","b","c"), "method,a,b,c");
33 test(Pack->$mname("a","b","c"), "method,a,b,c");
34 test(method Pack ("a","b","c"), "method,a,b,c");
35 test((method Pack "a","b","c"), "method,a,b,c");
37 test(Pack->method(), "method");
38 test(Pack->$mname(), "method");
39 test(method Pack (), "method");
40 test(Pack->method, "method");
41 test(Pack->$mname, "method");
42 test(method Pack, "method");
44 test($obj->method("a","b","c"), "method,a,b,c");
45 test($obj->$mname("a","b","c"), "method,a,b,c");
46 test((method $obj ("a","b","c")), "method,a,b,c");
47 test((method $obj "a","b","c"), "method,a,b,c");
49 test($obj->method(0), "method,0");
50 test($obj->method(1), "method,1");
52 test($obj->method(), "method");
53 test($obj->$mname(), "method");
54 test((method $obj ()), "method");
55 test($obj->method, "method");
56 test($obj->$mname, "method");
57 test(method $obj, "method");
59 test( A->d, "C::d"); # Update hash table;
61 *B::d = \&D::d; # Import now.
62 test (A->d, "D::d"); # Update hash table;
65 local @A::ISA = qw(C); # Update hash table with split() assignment
68 test (eval { A->d } || "fail", "fail");
74 eval 'sub B::d {"B::d1"}'; # Import now.
75 test (A->d, "B::d1"); # Update hash table;
77 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
80 test (A->d, "D::d"); # Back to previous state
82 eval 'sub B::d {"B::d2"}'; # Import now.
83 test (A->d, "B::d2"); # Update hash table;
85 # What follows is hardly guarantied to work, since the names in scripts
86 # are already linked to "pruned" globs. Say, `undef &B::d' if it were
87 # after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
91 test (A->d, "C::d"); # Update hash table;
93 eval 'sub B::d {"B::d3"}'; # Import now.
94 test (A->d, "B::d3"); # Update hash table;
97 *dummy::dummy = sub {}; # Mark as updated
100 eval 'sub B::d {"B::d4"}'; # Import now.
101 test (A->d, "B::d4"); # Update hash table;
103 delete $B::{d}; # Should work without any help too
108 test (eval { A->d } || "nope", "nope");
112 *A::x = *A::d; # See if cache incorrectly follows synonyms
114 test (eval { A->x } || "nope", "nope");
118 BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
127 my $method = $B::AUTOLOAD;
128 my $msg = "B: In $method, $c";
129 eval "sub $method { \$msg }";
134 my $method = $C::AUTOLOAD;
135 my $msg = "C: In $method, $c";
136 eval "sub $method { \$msg }";
141 test(A->e(), "C: In C::e, 1"); # We get a correct autoload
142 test(A->e(), "C: In C::e, 1"); # Which sticks
144 test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
145 test(A->ee(), "B: In A::ee, 2"); # Which sticks
147 test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method
148 test(Y->f(), "B: In Y::f, 3"); # Which sticks
150 # This test is not intended to be reasonable. It is here just to let you
151 # know that you broke some old construction. Feel free to rewrite the test
152 # if your patch breaks it.
156 my $method = $AUTOLOAD;
157 *$AUTOLOAD = sub { "new B: In $method, $c" };
161 test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload
162 test(A->eee(), "new B: In A::eee, 4"); # Which sticks
164 # this test added due to bug discovery
165 test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
167 # test that failed subroutine calls don't affect method calls
174 test(A2->foo(), "foo");
175 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
176 test(A2->foo(), "foo");
179 ## This test was totally misguided. It passed before only because the
180 ## code to determine if a package was loaded used to look for the hash
181 ## %Foo::Bar instead of the package Foo::Bar:: -- and Config.pm just
182 ## happens to export %Config.
184 # test(do { use Config; eval 'Config->foo()';
185 # $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
186 # test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()';
187 # $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1);
191 # test error messages if method loading fails
192 test(do { eval '$e = bless {}, "E::A"; E::A->foo()';
193 $@ =~ /^\QCan't locate object method "foo" via package "E::A" at/ ? 1 : $@}, 1);
194 test(do { eval '$e = bless {}, "E::B"; $e->foo()';
195 $@ =~ /^\QCan't locate object method "foo" via package "E::B" at/ ? 1 : $@}, 1);
196 test(do { eval 'E::C->foo()';
197 $@ =~ /^\QCan't locate object method "foo" via package "E::C" (perhaps / ? 1 : $@}, 1);
199 test(do { eval 'UNIVERSAL->E::D::foo()';
200 $@ =~ /^\QCan't locate object method "foo" via package "E::D" (perhaps / ? 1 : $@}, 1);
201 test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::E::foo()';
202 $@ =~ /^\QCan't locate object method "foo" via package "E::E" (perhaps / ? 1 : $@}, 1);
204 $e = bless {}, "E::F"; # force package to exist
205 test(do { eval 'UNIVERSAL->E::F::foo()';
206 $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
207 test(do { eval '$e = bless {}, "UNIVERSAL"; $e->E::F::foo()';
208 $@ =~ /^\QCan't locate object method "foo" via package "E::F" at/ ? 1 : $@}, 1);
210 # TODO: we need some tests for the SUPER:: pseudoclass
212 # failed method call or UNIVERSAL::can() should not autovivify packages
213 test( $::{"Foo::"} || "none", "none"); # sanity check 1
214 test( $::{"Foo::"} || "none", "none"); # sanity check 2
216 test( UNIVERSAL::can("Foo", "boogie") ? "yes":"no", "no" );
217 test( $::{"Foo::"} || "none", "none"); # still missing?
219 test( Foo->UNIVERSAL::can("boogie") ? "yes":"no", "no" );
220 test( $::{"Foo::"} || "none", "none"); # still missing?
222 test( Foo->can("boogie") ? "yes":"no", "no" );
223 test( $::{"Foo::"} || "none", "none"); # still missing?
225 test( eval 'Foo->boogie(); 1' ? "yes":"no", "no" );
226 test( $::{"Foo::"} || "none", "none"); # still missing?
228 test(do { eval 'Foo->boogie()';
229 $@ =~ /^\QCan't locate object method "boogie" via package "Foo" (perhaps / ? 1 : $@}, 1);
231 eval 'sub Foo::boogie { "yes, sir!" }';
232 test( $::{"Foo::"} ? "ok" : "none", "ok"); # should exist now
233 test( Foo->boogie(), "yes, sir!");
235 # TODO: universal.t should test NoSuchPackage->isa()/can()
237 # This is actually testing parsing of indirect objects and undefined subs
238 # print foo("bar") where foo does not exist is not an indirect object.
239 # print foo "bar" where foo does not exist is an indirect object.
240 eval { sub AUTOLOAD { "ok ", shift, "\n"; } };
241 print nonsuch(++$cnt);
243 # Bug ID 20010902.002
247 sub Foo::x : lvalue { $x }
252 # An autoloaded, inherited DESTROY may be invoked differently than normal
253 # methods, and has been known to give rise to spurious warnings
254 # eg <200203121600.QAA11064@gizmo.fdgroup.co.uk>
259 local $SIG{__WARN__} = sub { $w = $_[0] };
261 sub AutoDest::Base::AUTOLOAD {}
262 @AutoDest::ISA = qw(AutoDest::Base);
263 { my $x = bless {}, 'AutoDest'; }
268 print "# $cnt tests completed\n";