The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;

use Test::More;

use mop;


class Foo {
    method foo { "FOO" }
    method baz { "BAZ" }
}

class FooBar extends Foo {
    method foo { $self->next::method . "-FOOBAR" }
    method bar { $self->next::can }
    method baz { $self->next::can }
}

class FooBarBaz extends FooBar {
    method foo { $self->next::method . "-FOOBARBAZ" }
}

class FooBarBazGorch extends FooBarBaz {
    method foo { $self->next::method . "-FOOBARBAZGORCH" }
}

my $foo = FooBarBazGorch->new;
ok( $foo->isa( 'FooBarBazGorch' ), '... the object is from class FooBarBazGorch' );
ok( $foo->isa( 'FooBarBaz' ), '... the object is from class FooBarBaz' );
ok( $foo->isa( 'FooBar' ), '... the object is from class FooBar' );
ok( $foo->isa( 'Foo' ), '... the object is from class Foo' );
ok( $foo->isa( 'mop::object' ), '... the object is derived from class Object' );

is( $foo->foo, 'FOO-FOOBAR-FOOBARBAZ-FOOBARBAZGORCH', '... got the chained super calls as expected');

is($foo->bar, undef, '... no next method');

my $method = $foo->baz;
is(ref $method, 'CODE', '... got back a code ref');
is($method->($foo), 'BAZ', '... got the method we expected');

done_testing;