use strict;
use warnings;
use Test::More;
use Test::Moose;
{
package Role::A;
use Moose::Role
}
{
package Role::B;
use Moose::Role
}
{
package Foo;
use Moose;
}
{
package Bar;
use Moose;
with 'Role::A';
}
{
package Baz;
use Moose;
with qw( Role::A Role::B );
}
{
package Foo::Child;
use Moose;
extends 'Foo';
}
{
package Bar::Child;
use Moose;
extends 'Bar';
}
{
package Baz::Child;
use Moose;
extends 'Baz';
}
with_immutable {
for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) {
my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
$name .= ' (immutable)' if $thing->meta->is_immutable;
ok(
!$thing->does('Role::A'),
"$name does not do Role::A"
);
ok(
!$thing->does('Role::B'),
"$name does not do Role::B"
);
ok(
!$thing->does( Role::A->meta ),
"$name does not do Role::A (passed as object)"
);
ok(
!$thing->does( Role::B->meta ),
"$name does not do Role::B (passed as object)"
);
ok(
!$thing->DOES('Role::A'),
"$name does not do Role::A (using DOES)"
);
ok(
!$thing->DOES('Role::B'),
"$name does not do Role::B (using DOES)"
);
}
for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
$name .= ' (immutable)' if $thing->meta->is_immutable;
ok(
$thing->does('Role::A'),
"$name does Role::A"
);
ok(
!$thing->does('Role::B'),
"$name does not do Role::B"
);
ok(
$thing->does( Role::A->meta ),
"$name does Role::A (passed as object)"
);
ok(
!$thing->does( Role::B->meta ),
"$name does not do Role::B (passed as object)"
);
ok(
$thing->DOES('Role::A'),
"$name does Role::A (using DOES)"
);
ok(
!$thing->DOES('Role::B'),
"$name does not do Role::B (using DOES)"
);
}
for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
$name .= ' (immutable)' if $thing->meta->is_immutable;
ok(
$thing->does('Role::A'),
"$name does Role::A"
);
ok(
$thing->does('Role::B'),
"$name does Role::B"
);
ok(
$thing->does( Role::A->meta ),
"$name does Role::A (passed as object)"
);
ok(
$thing->does( Role::B->meta ),
"$name does Role::B (passed as object)"
);
ok(
$thing->DOES('Role::A'),
"$name does Role::A (using DOES)"
);
ok(
$thing->DOES('Role::B'),
"$name does Role::B (using DOES)"
);
}
}
qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
done_testing;