Add failing test for mutually dependent roles

[gitmo/Role-Tiny.git] / t / role-basic-composition.t

#!/usr/bin/env perl

use lib 'lib', 't/role-basic/lib';
use MyTests;
require Role::Tiny;

{

    package My::Does::Basic1;
    use Role::Tiny;
    requires 'turbo_charger';

    sub method {
        return __PACKAGE__ . " method";
    }
}
{

    package My::Does::Basic2;
    use Role::Tiny;
    requires 'turbo_charger';

    sub method2 {
        return __PACKAGE__ . " method2";
    }
}

eval <<'END_PACKAGE';
package My::Class1;
use Role::Tiny 'with';
with qw(
    My::Does::Basic1
    My::Does::Basic2
);
sub turbo_charger {}
END_PACKAGE
ok !$@, 'We should be able to use two roles with the same requirements'
    or die $@;

{

    package My::Does::Basic3;
    use Role::Tiny;
    with 'My::Does::Basic2';

    sub method3 {
        return __PACKAGE__ . " method3";
    }
}

eval <<'END_PACKAGE';
package My::Class2;
use Role::Tiny 'with';
with qw(
    My::Does::Basic3
);
sub new { bless {} => shift }
sub turbo_charger {}
END_PACKAGE
ok !$@, 'We should be able to use roles which consume roles'
    or die $@;
can_ok 'My::Class2', 'method2';
is My::Class2->method2, 'My::Does::Basic2 method2',
  '... and it should be the correct method';
can_ok 'My::Class2', 'method3';
is My::Class2->method3, 'My::Does::Basic3 method3',
  '... and it should be the correct method';

ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes';
ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'),
  '... and should do roles which its roles consumes';
ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'),
  '... but not roles which it never consumed';

my $object = My::Class2->new;
ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes';
ok $object->Role::Tiny::does_role('My::Does::Basic2'),
  '... and should do roles which its roles consumes';
ok !$object->Role::Tiny::does_role('My::Does::Basic1'),
  '... but not roles which it never consumed';

{
    {
        package Role::Which::Imports;
        use Role::Tiny allow => 'TestMethods';
        use TestMethods qw(this that);
    }
    {
       package Class::With::ImportingRole;
       use Role::Tiny 'with';
       with 'Role::Which::Imports';
       sub new { bless {} => shift }
    }
    my $o = Class::With::ImportingRole->new;

    foreach my $method (qw/this that/) {
        can_ok $o, $method;
        ok $o->$method($method), '... and calling "allow"ed methods should succeed';
        is $o->$method, $method, '... and it should function correctly';
    }
}

{
    {
        package Role::WithImportsOnceRemoved;
        use Role::Tiny;
        with 'Role::Which::Imports';
    }
    {
        package Class::With::ImportingRole2;
        use Role::Tiny 'with';
$ENV{DEBUG} = 1;
        with 'Role::WithImportsOnceRemoved';
        sub new { bless {} => shift }
    }
    ok my $o = Class::With::ImportingRole2->new,
        'We should be able to use roles which compose roles which import';

    foreach my $method (qw/this that/) {
        can_ok $o, $method;
        ok $o->$method($method), '... and calling "allow"ed methods should succeed';
        is $o->$method, $method, '... and it should function correctly';
    }
}

{
	{
		package Role1;
		use Role::Tiny;
		sub method1 { }
		requires 'method2';
	}

	{
		package Role2;
		use Role::Tiny;
		sub method2 { }
		requires 'method1';
	}
	my $success = eval <<'END';
		package Class;
		use Role::Tiny::With;
		with 'Role1', 'Role2';
		1;
END
	is $success, 1, 'composed mutually dependent roles successfully' or diag "Error: $@";
}

done_testing;