1 #! /usr/local/bin/perl -w
9 BEGIN { print "1..20\n"; }
16 sub A::method { return ( 3, $_[0]->NEXT::method() ) }
17 sub A::DESTROY { $_[0]->NEXT::DESTROY() }
21 sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) }
22 sub B::DESTROY { $_[0]->NEXT::DESTROY() }
25 sub C::DESTROY { print "ok 18\n"; $_[0]->NEXT::DESTROY() }
28 @D::ISA = qw( B C E );
29 sub D::method { return ( 2, $_[0]->NEXT::method() ) }
30 sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
31 sub D::DESTROY { print "ok 17\n"; $_[0]->NEXT::DESTROY() }
32 sub D::oops { $_[0]->NEXT::method() }
36 sub E::method { return ( 4, $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
37 sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) }
38 sub E::DESTROY { print "ok 19\n"; $_[0]->NEXT::DESTROY() }
41 sub F::method { return ( 5 ) }
42 sub F::AUTOLOAD { return ( 11 ) }
43 sub F::DESTROY { print "ok 20\n" }
46 sub G::method { return ( 6 ) }
47 sub G::AUTOLOAD { print "not "; return }
48 sub G::DESTROY { print "not ok 21"; return }
52 my $obj = bless {}, "D";
56 # TEST NORMAL REDISPATCH (ok 2..6)
57 @vals = $obj->method();
58 print map "ok $_\n", @vals;
60 # RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
61 @vals = $obj->method();
62 print "not " unless join("", @vals) == "23456";
65 # TEST AUTOLOAD REDISPATCH (ok 8..11)
66 @vals = $obj->missing_method();
67 print map "ok $_\n", @vals;
69 # NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
70 eval { $obj->oops() } && print "not ";
73 # AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
76 sub AUTOLOAD { $_[0]->NEXT::method() };
78 eval { $obj->missing_method(); } && print "not ";
81 # NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
84 sub method { $_[0]->NEXT::AUTOLOAD() };
86 eval { $obj->method(); } && print "not ";
89 # BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
90 my $ob2 = bless {}, "B";
91 @val = $ob2->method();
92 print "not " unless @val==1 && $val[0]==3;
95 @val = $ob2->missing_method();
96 print "not " unless @val==1 && $val[0]==9;
99 # CAN REDISPATCH DESTRUCTORS (ok 17..20)