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