The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::Fatal;
use Test::More 0.88;

use Class::Load qw( try_load_class );
use Type::Declare;

{
    package Class::DoesNoRoles;

    sub new {
        return bless {}, shift;
    }
}

{
    package Role::MooseStyle;

    use Moose::Role;
}

{
    package Class::MooseStyle;

    use Moose;

    with 'Role::MooseStyle';
}

{
    my $any_does_moose = any_does_type(
        'AnyDoesMoose',
        role => 'Role::MooseStyle',
    );

    _test_any_type(
        $any_does_moose,
        'Class::MooseStyle'
    );

    my $object_does_moose = object_does_type(
        'ObjectDoesMoose',
        role => 'Role::MooseStyle',
    );

    _test_object_type(
        $object_does_moose,
        'Class::MooseStyle'
    );
}

SKIP:
{
    skip 'These tests require Mouse', 8
        unless try_load_class('Mouse');

    eval <<'EOF';
{
    package Role::MouseStyle;

    use Mouse::Role;
}

{
    package Class::MouseStyle;

    use Mouse;

    with 'Role::MouseStyle';
}
EOF

    my $any_does_moose = any_does_type(
        'AnyDoesMouse',
        role => 'Role::MouseStyle',
    );

    _test_any_type(
        $any_does_moose,
        'Class::MouseStyle'
    );

    my $object_does_moose = object_does_type(
        'ObjectDoesMouse',
        role => 'Role::MouseStyle',
    );

    _test_object_type(
        $object_does_moose,
        'Class::MouseStyle'
    );
}

SKIP:
{
    skip 'These tests require Moo', 8
        unless try_load_class('Moo');

    eval <<'EOF';
{
    package Role::MooStyle;

    use Moo::Role;
}

{
    package Class::MooStyle;

    use Moo;

    with 'Role::MooStyle';
}
EOF

    my $any_does_moose = any_does_type(
        'AnyDoesMoo',
        role => 'Role::MooStyle',
    );

    _test_any_type(
        $any_does_moose,
        'Class::MooStyle'
    );

    my $object_does_moose = object_does_type(
        'ObjectDoesMoo',
        role => 'Role::MooStyle',
    );

    _test_object_type(
        $object_does_moose,
        'Class::MooStyle'
    );
}

done_testing();

sub _test_any_type {
    my $type       = shift;
    my $class_name = shift;

    my $type_name = $type->name();

    ok(
        $type->value_is_valid($class_name),
        "$class_name class name is valid for $type_name"
    );

    ok(
        $type->value_is_valid( $class_name->new() ),
        "$class_name object is valid for $type_name"
    );

    ok(
        !$type->value_is_valid('Class::DoesNoRoles'),
        "Class::DoesNoRoles class name is not valid for $type_name"
    );

    ok(
        !$type->value_is_valid( Class::DoesNoRoles->new() ),
        "Class::DoesNoRoles object is not valid for $type_name"
    );
}

sub _test_object_type {
    my $type       = shift;
    my $class_name = shift;

    my $type_name = $type->name();

    ok(
        !$type->value_is_valid($class_name),
        "$class_name class name is not valid for $type_name"
    );

    ok(
        $type->value_is_valid( $class_name->new() ),
        "$class_name object is valid for $type_name"
    );

    ok(
        !$type->value_is_valid('Class::DoesNoRoles'),
        "Class::DoesNoRoles class name is not valid for $type_name"
    );

    ok(
        !$type->value_is_valid( Class::DoesNoRoles->new() ),
        "Class::DoesNoRoles object is not valid for $type_name"
    );
}