1#!./perl 2 3# 4# test method calls and autoloading. 5# 6 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = '../lib'; 10} 11 12print "1..53\n"; 13 14@A::ISA = 'B'; 15@B::ISA = 'C'; 16 17sub C::d {"C::d"} 18sub D::d {"D::d"} 19 20my $cnt = 0; 21sub test { 22 print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1]; 23 # print "not " unless shift eq shift; 24 print "ok ", ++$cnt, "\n" 25} 26 27# First, some basic checks of method-calling syntax: 28$obj = bless [], "Pack"; 29sub Pack::method { shift; join(",", "method", @_) } 30$mname = "method"; 31 32test(Pack->method("a","b","c"), "method,a,b,c"); 33test(Pack->$mname("a","b","c"), "method,a,b,c"); 34test(method Pack ("a","b","c"), "method,a,b,c"); 35test((method Pack "a","b","c"), "method,a,b,c"); 36 37test(Pack->method(), "method"); 38test(Pack->$mname(), "method"); 39test(method Pack (), "method"); 40test(Pack->method, "method"); 41test(Pack->$mname, "method"); 42test(method Pack, "method"); 43 44test($obj->method("a","b","c"), "method,a,b,c"); 45test($obj->$mname("a","b","c"), "method,a,b,c"); 46test((method $obj ("a","b","c")), "method,a,b,c"); 47test((method $obj "a","b","c"), "method,a,b,c"); 48 49test($obj->method(), "method"); 50test($obj->$mname(), "method"); 51test((method $obj ()), "method"); 52test($obj->method, "method"); 53test($obj->$mname, "method"); 54test(method $obj, "method"); 55 56test( A->d, "C::d"); # Update hash table; 57 58*B::d = \&D::d; # Import now. 59test (A->d, "D::d"); # Update hash table; 60 61{ 62 local @A::ISA = qw(C); # Update hash table with split() assignment 63 test (A->d, "C::d"); 64 $#A::ISA = -1; 65 test (eval { A->d } || "fail", "fail"); 66} 67test (A->d, "D::d"); 68 69{ 70 local *B::d; 71 eval 'sub B::d {"B::d1"}'; # Import now. 72 test (A->d, "B::d1"); # Update hash table; 73 undef &B::d; 74 test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1); 75} 76 77test (A->d, "D::d"); # Back to previous state 78 79eval 'sub B::d {"B::d2"}'; # Import now. 80test (A->d, "B::d2"); # Update hash table; 81 82# What follows is hardly guarantied to work, since the names in scripts 83# are already linked to "pruned" globs. Say, `undef &B::d' if it were 84# after `delete $B::{d}; sub B::d {}' would reach an old subroutine. 85 86undef &B::d; 87delete $B::{d}; 88test (A->d, "C::d"); # Update hash table; 89 90eval 'sub B::d {"B::d3"}'; # Import now. 91test (A->d, "B::d3"); # Update hash table; 92 93delete $B::{d}; 94*dummy::dummy = sub {}; # Mark as updated 95test (A->d, "C::d"); 96 97eval 'sub B::d {"B::d4"}'; # Import now. 98test (A->d, "B::d4"); # Update hash table; 99 100delete $B::{d}; # Should work without any help too 101test (A->d, "C::d"); 102 103{ 104 local *C::d; 105 test (eval { A->d } || "nope", "nope"); 106} 107test (A->d, "C::d"); 108 109*A::x = *A::d; # See if cache incorrectly follows synonyms 110A->d; 111test (eval { A->x } || "nope", "nope"); 112 113eval <<'EOF'; 114sub C::e; 115BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg 116sub Y::f; 117$counter = 0; 118 119@X::ISA = 'Y'; 120@Y::ISA = 'B'; 121 122sub B::AUTOLOAD { 123 my $c = ++$counter; 124 my $method = $B::AUTOLOAD; 125 my $msg = "B: In $method, $c"; 126 eval "sub $method { \$msg }"; 127 goto &$method; 128} 129sub C::AUTOLOAD { 130 my $c = ++$counter; 131 my $method = $C::AUTOLOAD; 132 my $msg = "C: In $method, $c"; 133 eval "sub $method { \$msg }"; 134 goto &$method; 135} 136EOF 137 138test(A->e(), "C: In C::e, 1"); # We get a correct autoload 139test(A->e(), "C: In C::e, 1"); # Which sticks 140 141test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top 142test(A->ee(), "B: In A::ee, 2"); # Which sticks 143 144test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method 145test(Y->f(), "B: In Y::f, 3"); # Which sticks 146 147# This test is not intended to be reasonable. It is here just to let you 148# know that you broke some old construction. Feel free to rewrite the test 149# if your patch breaks it. 150 151*B::AUTOLOAD = sub { 152 my $c = ++$counter; 153 my $method = $AUTOLOAD; 154 *$AUTOLOAD = sub { "new B: In $method, $c" }; 155 goto &$AUTOLOAD; 156}; 157 158test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload 159test(A->eee(), "new B: In A::eee, 4"); # Which sticks 160 161# this test added due to bug discovery 162test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); 163 164# test that failed subroutine calls don't affect method calls 165{ 166 package A1; 167 sub foo { "foo" } 168 package A2; 169 @ISA = 'A1'; 170 package main; 171 test(A2->foo(), "foo"); 172 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); 173 test(A2->foo(), "foo"); 174} 175 176{ 177 test(do { use Config; eval 'Config->foo()'; 178 $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); 179 test(do { use Config; eval '$d = bless {}, "Config"; $d->foo()'; 180 $@ =~ /^\QCan't locate object method "foo" via package "Config" at/ ? 1 : $@}, 1); 181} 182 183test(do { eval 'E->foo()'; 184 $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1); 185test(do { eval '$e = bless {}, "E"; $e->foo()'; 186 $@ =~ /^\QCan't locate object method "foo" via package "E" (perhaps / ? 1 : $@}, 1); 187 188