The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
use strict;

package submain;
our @ISA = ('main');
sub foo {
    push @main::foo, ['submain', @_ ]
}

package main;

use Test::More;

our @foo;

sub foo {
    push @foo, \@_;
}
{
    # XXX: using string eval blows up b::hooks::parser here
    my $sub = eval { sub {
                     use invoker;
                     sub {
                         my $self = shift;
                         $->foo("x", @_);
                     }
                 }} ;
    ok($sub);
    diag $@ if $@;

    my $self = bless {}, 'main';
    $sub->()->($self, 1,2);

    my $subself = bless {}, 'submain';
    $sub->()->($subself, 1,2);

    is_deeply(\@foo, [[$self, 'x', 1,2],
                      ['submain', $subself, 'x', 1, 2]]);
}

{
    @foo = ();
    my $sub = eval q{ sub {
                     use invoker;
                     sub {
                         my $self = shift;
                         $->foo;
                     }
                 } };
    ok($sub);
    diag $@ if $@;

    my $self = bless {}, 'main';
    $sub->()->($self, 1,2);

    my $subself = bless {}, 'submain';
    $sub->()->($subself, 1,2);

    is_deeply(\@foo, [[$self],
                      ['submain', $subself]]);
}

{
    @foo = ();
    my $sub = eval q{ sub {
                     use invoker;
                     sub {
                         my $self = shift;
                         $->bar('x');
                     }
                 } };

    no warnings 'once';
    *bar = sub {
        push @foo, ['bar', @_];
    };
    ok($sub);
    diag $@ if $@;

    my $self = bless {}, 'main';
    $sub->()->($self, 1,2);

    my $subself = bless {}, 'submain';
    $sub->()->($subself, 1,2);

    is_deeply(\@foo, [['bar', $self, 'x'],
                      ['bar', $subself, 'x']]);
    @foo = ();
}

{
    @foo = ();
    my $sub = eval q{ sub {
                     use invoker;
                     my $name = 'bar';
                     sub {
                         my $self = shift;
                         $->$name;
                     }
                 } };


    ok($sub);
    diag $@ if $@;

    my $self = bless {}, 'main';
    $sub->()->($self, 1,2);

    my $subself = bless {}, 'submain';
    $sub->()->($subself, 1,2);

    is_deeply(\@foo, [['bar', $self],
                      ['bar', $subself]]);
    @foo = ();
}

{
    @foo = ();
    my $sub = eval q{ sub {
                     use invoker;
                     my $name = 'bar';
                     sub {
                         $->$name;
                     }
                 } };


    ok(!$sub);
    like($@, qr'\$self not found');

}


done_testing;