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

use mop;

role R1 {
    method foo { 'R1' }
}

role R2 {
    method foo { 'R2' }
}

class C1 { }
my $C1 = mop::meta('C1');

ok(!C1->can('foo'));

$C1->add_role('R1');
$C1->FINALIZE;

ok(C1->can('foo'));
is(C1->new->foo, 'R1');

$C1->add_role('R2');
eval {
    $C1->FINALIZE;
};
like($@, qr/^Required method\(s\) \[foo\] are not allowed in C1 unless class is declared abstract/);

$C1->add_method(mop::method->new(name => 'foo', body => sub { 'C1' }));
$C1->FINALIZE;

ok(C1->can('foo'));
is(C1->new->foo, 'C1');

role R3 {
    has $!foo = 'R3';
}

role R4 {
    has $!foo = 'R4';
}

class C2 { }
my $C2 = mop::meta('C2');

$C2->add_role('R3');
$C2->FINALIZE;
$C2->add_role('R4');
eval {
    $C2->FINALIZE;
};
like($@, qr/^Attribute conflict \$!foo when composing/);

class C3 {
    method foo { 'C3' }
}
my $C3 = mop::meta('C3');

is(C3->new->foo, 'C3');

$C3->add_role('R1');
$C3->FINALIZE;

is(C3->new->foo, 'C3');

$C3->add_role('R2');
$C3->FINALIZE;

is(C3->new->foo, 'C3');

class C4 is abstract {
    method bar;
}
my $C4 = mop::meta('C4');

eval '
class C5 extends C4 { }
';
like($@, qr/^Required method\(s\) \[bar\] are not allowed in C5 unless class is declared abstract/);

$C4->add_role('R1');
$C4->FINALIZE;
can_ok('C4', 'foo');
is(C4->foo, 'R1');

eval '
class C6 extends C4 { }
';
{ local $TODO = "we don't track the source of required methods yet";
like($@, qr/^Required method\(s\) \[bar\] are not allowed in C6 unless class is declared abstract/);
}

done_testing;