use strict; use warnings; use Test::More 'tests' => 62; package Base1; { use Object::InsideOut; sub base_first :Cumulative(top down) { shift; return(@_, __PACKAGE__); } sub der_first :Cumulative(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cumulative { return shift; } } package Base2; { use Object::InsideOut qw(Base1); sub base_first :Cumulative { shift; return(@_, __PACKAGE__); } sub der_first :Cumulative(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cumulative { return shift; } } package Base3; { use Object::InsideOut qw(Base1); sub base_first :Cumulative { shift; return(@_, __PACKAGE__); } sub der_first :Cumulative(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cumulative { return shift; } } package Base4; { use Object::InsideOut; sub base_first { shift; return(@_, __PACKAGE__); } sub der_first { shift; return(@_, __PACKAGE__); } } package Der1; { use Object::InsideOut qw(Base2 Base3 Base4); sub base_first :Cumulative { shift; return(@_, __PACKAGE__); } sub der_first :Cumulative(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cumulative { return shift; } } package Der2; { use Object::InsideOut qw(Base2 Base3 Base4); sub base_first :Cumulative { shift; return(@_, __PACKAGE__); } sub der_first :Cumulative(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cumulative { return shift; } } package Reder1; { use Object::InsideOut qw(Der1 Der2); sub base_first :Cum { shift; return(@_, __PACKAGE__); } sub der_first :Cum(bottom up) { shift; return(@_, __PACKAGE__); } sub shift_obj :Cum(top down) { return shift; } } package main; MAIN: { my $obj = Reder1->new(); for (1..2) { my $top_down = $obj->base_first(); my $bot_up = $obj->der_first(); my $objs = $obj->shift_obj(); my @top_down = qw(Base1 Base2 Base3 Der1 Der2 Reder1); my @bot_up = qw(Reder1 Der2 Der1 Base3 Base2 Base1); my @objs = ($obj) x 6; is_deeply(\@$top_down, \@top_down => 'List chained down'); is_deeply(\@$bot_up, \@bot_up => 'List chained up'); is(int $bot_up, int @bot_up => 'Numeric chained up'); is(int $top_down, int @top_down => 'Numeric chained down'); is("$bot_up", join(q{}, @bot_up) => 'String chained up'); is("$top_down", join(q{}, @top_down) => 'String chained down'); for my $pkg (keys(%{$bot_up})) { ok(grep($pkg, @bot_up) => "Valid up hash key ($pkg)"); is($pkg, $bot_up->{$pkg} => "Valid up hash value ($pkg)"); } while(my $pkg = each(%{$top_down})) { ok(grep($pkg, @top_down) => "Valid down hash key ($pkg)"); is($pkg, $bot_up->{$pkg} => "Valid down hash value ($pkg)"); } is_deeply(\@$objs, \@objs => 'shift(@_) used in method'); } } exit(0); # EOF