The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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