#!/usr/bin/perl use strict; use warnings; use Test::More tests => 19; use Test::Exception; use Perl6::MetaModel; =pod This test is primarily focues on Role methods =cut my $Foo = $::Role->new('$:name' => 'Foo'); isa_ok($Foo, 'Role'); ok(!$Foo->isa('Foo'), '... $Foo is not a Foo'); is_deeply( [ $Foo->get_method_list ], [], '... no $Foo methods yet'); $Foo->add_method('foo' => ::make_method(sub { 'Foo::foo' })); ok($Foo->has_method('foo'), '... $Foo.has_method(foo)'); is($Foo->get_method('foo')->(), 'Foo::foo', '... $Foo.get_method(foo)'); ok(!$Foo->has_method('blarch'), '... no $Foo.has_method(blarch)'); is($Foo->get_method('blarch'), undef, '... $Foo.get_method(blarch) returns undef'); is_deeply( [ $Foo->get_method_list ], [ 'foo' ], '... got the list of $Foo methods'); $Foo->add_method('bar' => undef); ok($Foo->has_method('bar'), '... $Foo.has_method(bar)'); throws_ok { $Foo->get_method('bar')->() } qr/^Stub Method\!/, '... $Foo.get_method(bar)'; is_deeply( [ sort $Foo->get_method_list ], [ 'bar', 'foo' ], '... got the list of $Foo methods'); $Foo->add_method('baz' => ::make_class_method(sub { $::ROLE })); ok($Foo->has_method('baz'), '... $Foo.has_method(baz)'); is($Foo->get_method('baz')->(), $Foo, '... $Foo.get_method(baz)'); is_deeply( [ sort $Foo->get_method_list ], [ 'bar', 'baz', 'foo' ], '... got the list of $Foo methods'); # dont bother calling the submethod it will break $Foo->add_method('bing' => ::make_submethod(sub { 'Foo::bing (sub method)' })); is_deeply( [ sort $Foo->get_method_list ], [ 'bar', 'baz', 'bing', 'foo' ], '... got the list of $Foo methods'); # make sure all our methods are still of the same type isa_ok($Foo->get_method('foo'), 'Perl6::Method'); isa_ok($Foo->get_method('bar'), 'Perl6::StubMethod'); isa_ok($Foo->get_method('baz'), 'Perl6::ClassMethod'); isa_ok($Foo->get_method('bing'), 'Perl6::Submethod');