1#!./perl 2 3# 4# test method calls and autoloading. 5# 6 7print "1..49\n"; 8 9@A::ISA = 'B'; 10@B::ISA = 'C'; 11 12sub C::d {"C::d"} 13sub D::d {"D::d"} 14 15my $cnt = 0; 16sub 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# First, some basic checks of method-calling syntax: 23$obj = bless [], "Pack"; 24sub Pack::method { shift; join(",", "method", @_) } 25$mname = "method"; 26 27test(Pack->method("a","b","c"), "method,a,b,c"); 28test(Pack->$mname("a","b","c"), "method,a,b,c"); 29test(method Pack ("a","b","c"), "method,a,b,c"); 30test((method Pack "a","b","c"), "method,a,b,c"); 31 32test(Pack->method(), "method"); 33test(Pack->$mname(), "method"); 34test(method Pack (), "method"); 35test(Pack->method, "method"); 36test(Pack->$mname, "method"); 37test(method Pack, "method"); 38 39test($obj->method("a","b","c"), "method,a,b,c"); 40test($obj->$mname("a","b","c"), "method,a,b,c"); 41test((method $obj ("a","b","c")), "method,a,b,c"); 42test((method $obj "a","b","c"), "method,a,b,c"); 43 44test($obj->method(), "method"); 45test($obj->$mname(), "method"); 46test((method $obj ()), "method"); 47test($obj->method, "method"); 48test($obj->$mname, "method"); 49test(method $obj, "method"); 50 51test( A->d, "C::d"); # Update hash table; 52 53*B::d = \&D::d; # Import now. 54test (A->d, "D::d"); # Update hash table; 55 56{ 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} 62test (A->d, "D::d"); 63 64{ 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} 71 72test (A->d, "D::d"); # Back to previous state 73 74eval 'sub B::d {"B::d2"}'; # Import now. 75test (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 81undef &B::d; 82delete $B::{d}; 83test (A->d, "C::d"); # Update hash table; 84 85eval 'sub B::d {"B::d3"}'; # Import now. 86test (A->d, "B::d3"); # Update hash table; 87 88delete $B::{d}; 89*dummy::dummy = sub {}; # Mark as updated 90test (A->d, "C::d"); 91 92eval 'sub B::d {"B::d4"}'; # Import now. 93test (A->d, "B::d4"); # Update hash table; 94 95delete $B::{d}; # Should work without any help too 96test (A->d, "C::d"); 97 98{ 99 local *C::d; 100 test (eval { A->d } || "nope", "nope"); 101} 102test (A->d, "C::d"); 103 104*A::x = *A::d; # See if cache incorrectly follows synonyms 105A->d; 106test (eval { A->x } || "nope", "nope"); 107 108eval <<'EOF'; 109sub C::e; 110BEGIN { *B::e = \&C::e } # Shouldn't prevent AUTOLOAD in original pkg 111sub Y::f; 112$counter = 0; 113 114@X::ISA = 'Y'; 115@Y::ISA = 'B'; 116 117sub B::AUTOLOAD { 118 my $c = ++$counter; 119 my $method = $B::AUTOLOAD; 120 my $msg = "B: In $method, $c"; 121 eval "sub $method { \$msg }"; 122 goto &$method; 123} 124sub C::AUTOLOAD { 125 my $c = ++$counter; 126 my $method = $C::AUTOLOAD; 127 my $msg = "C: In $method, $c"; 128 eval "sub $method { \$msg }"; 129 goto &$method; 130} 131EOF 132 133test(A->e(), "C: In C::e, 1"); # We get a correct autoload 134test(A->e(), "C: In C::e, 1"); # Which sticks 135 136test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top 137test(A->ee(), "B: In A::ee, 2"); # Which sticks 138 139test(Y->f(), "B: In Y::f, 3"); # We vivify a correct method 140test(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; 148 my $method = $AUTOLOAD; 149 *$AUTOLOAD = sub { "new B: In $method, $c" }; 150 goto &$AUTOLOAD; 151}; 152 153test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload 154test(A->eee(), "new B: In A::eee, 4"); # Which sticks 155 156# this test added due to bug discovery 157test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); 158 159# test that failed subroutine calls don't affect method calls 160{ 161 package A1; 162 sub foo { "foo" } 163 package A2; 164 @ISA = 'A1'; 165 package main; 166 test(A2->foo(), "foo"); 167 test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1); 168 test(A2->foo(), "foo"); 169} 170