The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

BEGIN {
    if ($] == 5.008) {
        print("1..0 # Skip due to Perl 5.8.0 bug\n");
        exit(0);
    }
}

use Test::More 'tests' => 6;

package My::Data; {
    use Object::InsideOut;

    my @data :Field('Accessor' => 'data');

    sub auto : Automethod
    {
        my $self = $_[0];
        my $class = ref($self) || $self;
        my $name = $_;

        # No data
        if (! exists($data[$$self])) {
            return;
        }

        my $data = \@data;      # Workaround for 5.6.X bug

        if ($$self == 1) {
            return (sub {
                        my $self = $_[0];
                        my $class = ref($self) || $self;
                        return (join(' ', $$self, $class, __PACKAGE__, $name, $$data[$$self]));
                   }, 'CUM');
        }

        return (sub {
                        my $self = shift;
                        my $class = ref($self) || $self;
                        return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$data[$$self]));
                   }, 'CHA(BOT)');
    }
}


package My::Info; {
    use Object::InsideOut qw(My::Data);

    my @info :Field('Accessor' => 'info');

    sub auto : Automethod
    {
        my $self = $_[0];
        my $class = ref($self) || $self;
        my $name = $_;

        # No info
        if (! exists($info[$$self])) {
            return;
        }

        my $info = \@info;      # Workaround for 5.6.X bug

        if ($$self == 1) {
            return (sub {
                        my $self = $_[0];
                        my $class = ref($self) || $self;
                        return (join(' ', $$self, $class, __PACKAGE__, $name, $$info[$$self]));
                   }, 'CUM');
        }
        return (sub {
                        my $self = shift;
                        my $class = ref($self) || $self;
                        return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$info[$$self]));
                   }, 'CHA(BOT)');
    }
}


package My::Comment; {
    use Object::InsideOut qw(My::Info);

    my @comment :Field('Accessor' => 'comment');

    sub AUTOMETHOD {
        if (/^foo$/) {
            return sub { return 'Bar->foo' }
        }
        return;
    }

    sub auto : Automethod
    {
        my $self = $_[0];
        my $class = ref($self) || $self;
        my $name = $_;

        # No comment
        if (! exists($comment[$$self])) {
            return;
        }

        my $comment = \@comment;      # Workaround for 5.6.X bug

        if ($$self == 1) {
            return (sub {
                        my $self = $_[0];
                        my $class = ref($self) || $self;
                        return (join(' ', $$self, $class, __PACKAGE__, $name, $$comment[$$self]));
                   }, 'CUM');
        }
        return (sub {
                        my $self = shift;
                        my $class = ref($self) || $self;
                        return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$comment[$$self]));
                   }, 'CHA(BOT)');
    }
}


package main;

MAIN:
{
    my $obj = My::Comment->new();

    my (@results, @data);

    $obj->info('test');
    @results = @{$obj->flog()};
    #print(join("\n", @results), "\n\n");

    @data = ('1 My::Comment My::Info flog test');
    is_deeply(\@results, \@data, 'Accumulation 1');

    $obj->data('tool');
    @results = @{$obj->bork()};
    #print(join("\n", @results), "\n\n");

    @data = ('1 My::Comment My::Data bork tool',
             '1 My::Comment My::Info bork test');
    is_deeply(\@results, \@data, 'Accumulation 2');

    $obj->comment('tassel');
    @results = @{$obj->funge()};
    #print(join("\n", @results), "\n\n");

    @data = ('1 My::Comment My::Data funge tool',
             '1 My::Comment My::Info funge test',
             '1 My::Comment My::Comment funge tassel');
    is_deeply(\@results, \@data, 'Accumulation 3');


    $obj = My::Comment->new();

    $obj->info('test');
    @results = $obj->flog();
    #print(join("\n", @results), "\n\n");

    @data = ('2 My::Comment My::Info flog test');
    is_deeply(\@results, \@data, 'Chained 1');

    $obj->data('tool');
    @results = $obj->bork();
    #print(join("\n", @results), "\n\n");

    @data = ('2 My::Comment My::Info bork test',
             '2 My::Comment My::Data bork tool');
    is_deeply(\@results, \@data, 'Chained 2');

    $obj->comment('tassel');
    @results = $obj->funge();
    #print(join("\n", @results), "\n\n");

    @data = ('2 My::Comment My::Comment funge tassel',
             '2 My::Comment My::Info funge test',
             '2 My::Comment My::Data funge tool');
    is_deeply(\@results, \@data, 'Chained 3');
}

exit(0);

# EOF