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