4 # test method calls and autoloading.
17 print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1];
18 # print "not " unless shift eq shift;
19 print "ok ", ++$cnt, "\n"
22 # First, some basic checks of method-calling syntax:
23 $obj = bless [], "Pack";
24 sub Pack::method { shift; join(",", "method", @_) }
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");
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");
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");
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");
51 test( A->d, "C::d"); # Update hash table;
53 *B::d = \&D::d; # Import now.
54 test (A->d, "D::d"); # Update hash table;
57 local @A::ISA = qw(C); # Update hash table with split() assignment
60 test (eval { A->d } || "fail", "fail");
66 eval 'sub B::d {"B::d1"}'; # Import now.
67 test (A->d, "B::d1"); # Update hash table;
69 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
72 test (A->d, "D::d"); # Back to previous state
74 eval 'sub B::d {"B::d2"}'; # Import now.
75 test (A->d, "B::d2"); # Update hash table;
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.
83 test (A->d, "C::d"); # Update hash table;
85 eval 'sub B::d {"B::d3"}'; # Import now.
86 test (A->d, "B::d3"); # Update hash table;
89 *dummy::dummy = sub {}; # Mark as updated
92 eval 'sub B::d {"B::d4"}'; # Import now.
93 test (A->d, "B::d4"); # Update hash table;
95 delete $B::{d}; # Should work without any help too
100 test (eval { A->d } || "nope", "nope");
104 *A::x = *A::d; # See if cache incorrectly follows synonyms
106 test (eval { A->x } || "nope", "nope");
110 BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg
119 my $method = $B::AUTOLOAD;
120 my $msg = "B: In $method, $c";
121 eval "sub $method { \$msg }";
126 my $method = $C::AUTOLOAD;
127 my $msg = "C: In $method, $c";
128 eval "sub $method { \$msg }";
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
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
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
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.
148 my $method = $AUTOLOAD;
149 *$AUTOLOAD = sub { "new B: In $method, $c" };
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
156 # this test added due to bug discovery
157 test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
159 # test that failed subroutine calls don't affect method calls
166 test(A2->foo(), "foo");
167 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
168 test(A2->foo(), "foo");