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
103