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.96;

use Specio::Declare;

## no critic (Modules::ProhibitMultiplePackages)
{
    package Class::DoesNoRoles;

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

{
    package Role::MooseStyle;

    use Role::Tiny;
}

{
    package Class::MooseStyle;

    use Role::Tiny::With;

    with 'Role::MooseStyle';

    sub new {
        bless {}, __PACKAGE__;
    }
}

{
    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'
    );
}

{
    is(
        exception {
            is(
                object_does_type('Role::MooseStyle') . q{},
                object_does_type('Role::MooseStyle') . q{},
                'object_does_type returns the same type for the same role each time'
            );
        },
        undef,
        'no exception calling object_does_type repeatedly with the same role name'
    );

    is(
        exception {
            is(
                any_does_type('Role::MooseStyle') . q{},
                any_does_type('Role::MooseStyle') . q{},
                'any_does_type returns the same type for the same role each time'
            );
        },
        undef,
        'no exception calling any_does_type repeatedly with the same role name'
    );
}

SKIP:
{
    skip 'These tests require Mouse', 8
        unless eval { require Mouse; 1 };

    ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
    eval <<'EOF';
{
    package Role::MouseStyle;

    use Mouse::Role;
}

{
    package Class::MouseStyle;

    use Mouse;

    with 'Role::MouseStyle';
}
EOF

    die $@ if $@;

    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 eval { require Moo; 1 };

    ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
    eval <<'EOF';
{
    package Role::MooStyle;

    use Moo::Role;
}

{
    package Class::MooStyle;

    use Moo;

    with 'Role::MooStyle';
}
EOF
    ## use critic

    die $@ if $@;

    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"
    );
}