1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir('t') if -d 't'; 4 @INC = qw(../lib); 5 } 6} 7 8BEGIN { print "1..25\n"; } 9 10use NEXT; 11 12print "ok 1\n"; 13 14package A; 15sub A::method { return ( 3, $_[0]->NEXT::method() ) } 16sub A::DESTROY { $_[0]->NEXT::DESTROY() } 17 18package B; 19use base qw( A ); 20sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) 21 if $AUTOLOAD =~ /.*(missing_method|secondary)/ } 22sub B::DESTROY { $_[0]->NEXT::DESTROY() } 23 24package C; 25sub C::DESTROY { print "ok 23\n"; $_[0]->NEXT::DESTROY() } 26 27package D; 28@D::ISA = qw( B C E ); 29sub D::method { return ( 2, $_[0]->NEXT::method() ) } 30sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) } 31sub D::DESTROY { print "ok 22\n"; $_[0]->NEXT::DESTROY() } 32sub D::oops { $_[0]->NEXT::method() } 33sub D::secondary { return ( 17, 18, map { $_+10 } $_[0]->NEXT::secondary() ) } 34 35package E; 36@E::ISA = qw( F G ); 37sub E::method { return ( 4, $_[0]->NEXT::method(), $_[0]->NEXT::method() ) } 38sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) 39 if $AUTOLOAD =~ /.*(missing_method|secondary)/ } 40sub E::DESTROY { print "ok 24\n"; $_[0]->NEXT::DESTROY() } 41 42package F; 43sub F::method { return ( 5 ) } 44sub F::AUTOLOAD { return ( 11 ) if $AUTOLOAD =~ /.*(missing_method|secondary)/ } 45sub F::DESTROY { print "ok 25\n" } 46 47package G; 48sub G::method { return ( 6 ) } 49sub G::AUTOLOAD { print "not "; return } 50sub G::DESTROY { print "not ok 21"; return } 51 52package main; 53 54my $obj = bless {}, "D"; 55 56my @vals; 57 58# TEST NORMAL REDISPATCH (ok 2..6) 59@vals = $obj->method(); 60print map "ok $_\n", @vals; 61 62# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7) 63@vals = $obj->method(); 64print "not " unless join("", @vals) == "23456"; 65print "ok 7\n"; 66 67# TEST AUTOLOAD REDISPATCH (ok 8..11) 68@vals = $obj->missing_method(); 69print map "ok $_\n", @vals; 70 71# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12) 72eval { $obj->oops() } && print "not "; 73print "ok 12\n"; 74 75# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13) 76 77eval { 78 local *C::AUTOLOAD = sub { $_[0]->NEXT::method() }; 79 *C::AUTOLOAD = *C::AUTOLOAD; 80 eval { $obj->missing_method(); } && print "not "; 81}; 82print "ok 13\n"; 83 84# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14) 85eval { 86 *C::method = sub{ $_[0]->NEXT::AUTOLOAD() }; 87 *C::method = *C::method; 88 eval { $obj->method(); } && print "not "; 89}; 90print "ok 14\n"; 91 92# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16) 93my $ob2 = bless {}, "B"; 94@val = $ob2->method(); 95print "not " unless @val==1 && $val[0]==3; 96print "ok 15\n"; 97 98@val = $ob2->missing_method(); 99print "not " unless @val==1 && $val[0]==9; 100print "ok 16\n"; 101 102# TEST SECONDARY AUTOLOAD REDISPATCH (ok 17..21) 103@vals = $obj->secondary(); 104print map "ok $_\n", @vals; 105 106# CAN REDISPATCH DESTRUCTORS (ok 22..25) 107