Skip distro which requires rpm

[gitmo/Moose.git] / t / basics / moose_object_does.t

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;