1package Base1; 2use Class::Std; 3BEGIN{ @ISA = qw( Base2 ); } 4{ 5 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 6 sub der_first :CUMULATIVE { return __PACKAGE__ } 7 sub shift_obj :CUMULATIVE { return shift } 8} 9 10package Base2; 11use Class::Std; 12{ 13 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 14 sub der_first :CUMULATIVE { return __PACKAGE__ } 15 sub shift_obj :CUMULATIVE { return shift } 16} 17 18package Base3; 19use Class::Std; 20use base qw( Base2 ); 21{ 22 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 23 sub der_first :CUMULATIVE { return __PACKAGE__ } 24 sub shift_obj :CUMULATIVE { return shift } 25} 26 27package Base4; 28use Class::Std; 29{ 30 sub base_first { return __PACKAGE__ } 31 sub der_first { return __PACKAGE__ } 32 sub shift_obj { return shift } 33} 34 35package Der1; 36use Class::Std; 37use base qw(Base1 Base2 Base3 Base4); 38{ 39 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 40 sub der_first :CUMULATIVE { return __PACKAGE__ } 41 sub shift_obj :CUMULATIVE { return shift } 42} 43 44package Der2; 45use Class::Std; 46use base qw(Base1 Base2 Base3 Base4); 47{ 48 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 49 sub der_first :CUMULATIVE { return __PACKAGE__ } 50 sub shift_obj :CUMULATIVE { return shift } 51} 52 53package Reder1; 54use Class::Std; 55use base qw(Der1 Der2); 56{ 57 sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ } 58 sub der_first :CUMULATIVE { return __PACKAGE__ } 59 sub shift_obj :CUMULATIVE { return shift } 60} 61 62package main; 63 64use Test::More tests => 62; 65 66my $obj = Reder1->new(); 67 68my @up_order = qw( Reder1 Der1 Der2 Base1 Base3 Base2 ); 69my @down_order = qw( Base2 Base1 Base3 Der1 Der2 Reder1 ); 70 71my $up_string = join q{}, @up_order; 72my $down_string = join q{}, @down_order; 73 74my @objs = ($obj) x 6; 75 76for my $test_run (1..2) { 77 my $res_up = $obj->der_first(); 78 my $res_down = $obj->base_first(); 79 my $res_objs = $obj->shift_obj(); 80 81 is int $res_up, int @up_order => 'Numeric cumulative up'; 82 is int $res_down, int @down_order => 'Numeric cumulative down'; 83 84 is "$res_up", $up_string => 'String cumulative up'; 85 is "$res_down", $down_string => 'String cumulative down'; 86 87 is_deeply \@$res_up, \@up_order => 'List cumulative up'; 88 is_deeply \@$res_down, \@down_order => 'List cumulative down'; 89 90 for my $classname (keys %$res_up) { 91 ok grep($classname, @up_order) => "Valid up hash key ($classname)"; 92 is $classname, $res_up->{$classname} => "Valid up hash value ($classname)"; 93 } 94 95 for my $classname (keys %$res_down) { 96 ok grep($classname, @down_order) => "Valid down hash key ($classname)"; 97 is $classname, $res_up->{$classname} => "Valid down hash value ($classname)"; 98 } 99 100 is_deeply \@$res_objs, \@objs => "shift(\@_) used in method"; 101} 102