8 BEGIN { print "1..26\n"; }
15 sub A::method { return ( 3, $_[0]->NEXT::method() ) }
16 sub A::DESTROY { $_[0]->NEXT::DESTROY() }
17 sub A::evaled { eval { $_[0]->NEXT::evaled(); return 'evaled' } }
21 sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() )
22 if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
23 sub B::DESTROY { $_[0]->NEXT::DESTROY() }
26 sub C::DESTROY { print "ok 24\n"; $_[0]->NEXT::DESTROY() }
29 @D::ISA = qw( B C E );
30 sub D::method { return ( 2, $_[0]->NEXT::method() ) }
31 sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
32 sub D::DESTROY { print "ok 23\n"; $_[0]->NEXT::DESTROY() }
33 sub D::oops { $_[0]->NEXT::method() }
34 sub D::secondary { return ( 17, 18, map { $_+10 } $_[0]->NEXT::secondary() ) }
38 sub E::method { return ( 4, $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
39 sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() )
40 if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
41 sub E::DESTROY { print "ok 25\n"; $_[0]->NEXT::DESTROY() }
44 sub F::method { return ( 5 ) }
45 sub F::AUTOLOAD { return ( 11 ) if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
46 sub F::DESTROY { print "ok 26\n" }
49 sub G::method { return ( 6 ) }
50 sub G::AUTOLOAD { print "not "; return }
51 sub G::DESTROY { print "not ok 22"; return }
55 my $obj = bless {}, "D";
59 # TEST NORMAL REDISPATCH (ok 2..6)
60 @vals = $obj->method();
61 print map "ok $_\n", @vals;
63 # RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
64 @vals = $obj->method();
65 print "not " unless join("", @vals) == "23456";
68 # TEST AUTOLOAD REDISPATCH (ok 8..11)
69 @vals = $obj->missing_method();
70 print map "ok $_\n", @vals;
72 # NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
73 eval { $obj->oops() } && print "not ";
76 # AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
79 local *C::AUTOLOAD = sub { $_[0]->NEXT::method() };
80 *C::AUTOLOAD = *C::AUTOLOAD;
81 eval { $obj->missing_method(); } && print "not ";
85 # NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
87 *C::method = sub{ $_[0]->NEXT::AUTOLOAD() };
88 *C::method = *C::method;
89 eval { $obj->method(); } && print "not ";
93 # BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
94 my $ob2 = bless {}, "B";
95 @val = $ob2->method();
96 print "not " unless @val==1 && $val[0]==3;
99 @val = $ob2->missing_method();
100 print "not " unless @val==1 && $val[0]==9;
103 # TEST SECONDARY AUTOLOAD REDISPATCH (ok 17..21)
104 @vals = $obj->secondary();
105 print map "ok $_\n", @vals;
107 # TEST HANDLING OF NEXT:: INSIDE EVAL (22)
114 # CAN REDISPATCH DESTRUCTORS (ok 23..26)