The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/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');