The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..7\n"; }
END {print "not ok 1\n" unless $loaded;}
use Class::Delegate;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

@Stub::ISA  = 'Class::Delegate';
my $stub    = bless {}, 'Stub';

sub Stub::a                 { return 'Stub::a' }

sub Stub::hello             { return 'hello' }


sub Delegate1::b            { return "Delegate1::b" }

sub Delegate2::b            { return "Delegate2::b" }

sub Delegate1::c            { return "Delegate1::c" }

sub Delegate2::set_owner
{
    my ($self, $owner)  = @_;
    
    $$self{owner}   = $owner;
}

sub Delegate2::talk_to_owner
{
    my ($self)  = @_;

    $$self{owner}->hello;
}

@Delegate3::PUBLIC  = qw(d);

sub Delegate3::c            { return "Delegate3::c" }


$stub->add_delegate(bless({}, 'Delegate1'));
$stub->add_delegate(visible => bless({}, 'Delegate2'));
$stub->add_delegate(bless{}, 'Delegate3');


my $return;

### First, let's see if call-throughs to a(), b(), and c() do the
### right thing.
# The `a' method should call Stub::a():
eval { $return = $stub->a };
if ($@ or $return ne 'Stub::a' )        { print "not ok 2\n" }
else                                    { print "ok 2\n" }

# The `b' method is ambiguous; calling it should fail:
eval { $return = $stub->b };
if ($@)                                 { print "ok 3\n" }
else                                    { print "not ok 3\n" }

# The `c' method should call Delegate1::c():
eval { $return = $stub->c };
if ($@ or $return ne 'Delegate1::c')    { print "not ok 4\n" }
else                                    { print "ok 4\n" }

### Let's do some introspection.
# Can we find the delegate named `visible'?
if (ref $stub->delegate('visible'))     { print "ok 5\n" }
else                                    { print "not ok 5\n" }

### Disambiguate the `b' method, so that it will call Delgate2::b():
$stub->resolve('b', 'visible');
eval { $return = $stub->b };
if ($@ or $return ne 'Delegate2::b')    { print "not ok 6\n" }
else                                    { print "ok 6\n" }

### Test the callback mechanism:
if ($stub->delegate('visible')->talk_to_owner eq 'hello') {
    print "ok 7\n";
} else {
    print "not ok 7\n";
}


### Just some diagnostics, no test here:
my (%delegates) = $stub->_delegates;

print "\nDelegation table:\n";
foreach (sort keys %delegates) {
    if ("$_" eq "$delegates{$_}") {
        printf "%-30s  %s\n", '(anonymous)', $delegates{$_};
    } else {
        printf "%-30s  %s\n", $_, $delegates{$_};
    }
}