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::More;
use Test::Fatal;

{
    my $exception =  exception {
        Moose::Meta::Class->create(
            'Made::Of::Fail',
            superclasses => ['Class'],
            roles        => 'Foo',
            );
    };

    like(
        $exception,
        qr/You must pass an ARRAY ref of roles/,
        "create takes an Array of roles");

    isa_ok(
        $exception,
        "Moose::Exception::RolesInCreateTakesAnArrayRef",
        "create takes an Array of roles");
}

{
    use Moose::Meta::Class;

    {
        package Foo;
        use Moose;
    }

    my $exception = exception {
        Foo->meta->add_role('Bar');
    };

    like(
        $exception,
        qr/Roles must be instances of Moose::Meta::Role/,
        "add_role takes an instance of Moose::Meta::Role");

    isa_ok(
        $exception,
        'Moose::Exception::AddRoleTakesAMooseMetaRoleInstance',
        "add_role takes an instance of Moose::Meta::Role");

    is(
        $exception->class_name,
        'Foo',
        "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role");

    is(
        $exception->role_to_be_added,
        "Bar",
        "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role");
}

{
    my $exception = exception {
        package Foo;
        use Moose;
        Foo->meta->add_role_application();
    };

    like(
        $exception,
        qr/Role applications must be instances of Moose::Meta::Role::Application::ToClass/,
        "bar is not an instance of Moose::Meta::Role::Application::ToClass");

    isa_ok(
        $exception,
        "Moose::Exception::InvalidRoleApplication",
        "bar is not an instance of Moose::Meta::Role::Application::ToClass");
}

# tests for Moose::Meta::Class::does_role
{
    use Moose::Meta::Class;

    {
        package Foo;
        use Moose;
    }

    my $exception = exception {
        Foo->meta->does_role;
    };

    like(
        $exception,
        qr/You must supply a role name to look for/,
        "Cannot call does_role without a role name");

    isa_ok(
        $exception,
        'Moose::Exception::RoleNameRequired',
        "Cannot call does_role without a role name");

    is(
        $exception->class_name,
        'Foo',
        "Cannot call does_role without a role name");
}

# tests for Moose::Meta::Class::excludes_role
{
    use Moose::Meta::Class;

    {
        package Foo;
        use Moose;
    }

    my $exception = exception {
        Foo->meta->excludes_role;
    };

    like(
        $exception,
        qr/You must supply a role name to look for/,
        "Cannot call excludes_role without a role name");

    isa_ok(
        $exception,
        'Moose::Exception::RoleNameRequired',
        "Cannot call excludes_role without a role name");

    is(
        $exception->class_name,
        'Foo',
        "Cannot call excludes_role without a role name");
}

{
    my $exception = exception {
        package Foo;
        use Moose;
        __PACKAGE__->meta->make_immutable;
        Foo->new([])
    };

    like(
        $exception,
        qr/^\QSingle parameters to new() must be a HASH ref/,
        "A single non-hashref arg to a constructor throws an error");

    isa_ok(
        $exception,
        "Moose::Exception::SingleParamsToNewMustBeHashRef",
        "A single non-hashref arg to a constructor throws an error");
}

# tests for AttributeIsRequired for inline excpetions
{
    {
        package Foo2;
        use Moose;

        has 'baz' => (
            is       => 'ro',
            isa      => 'Int',
            required => 1,
        );
        __PACKAGE__->meta->make_immutable;
    }

    my $exception = exception {
        my $test1 = Foo2->new;
    };

    like(
        $exception,
        qr/\QAttribute (baz) is required/,
        "... must supply all the required attribute");

    isa_ok(
        $exception,
        "Moose::Exception::AttributeIsRequired",
        "... must supply all the required attribute");

    is(
        $exception->attribute_name,
        'baz',
        "... must supply all the required attribute");

    isa_ok(
        $exception->class_name,
        'Foo2',
        "... must supply all the required attribute");
}

{
    {
        package Bar;
        use Moose::Role;
    }

    my $exception = exception {
        package Foo3;
        use Moose;
        extends 'Bar';
    };

    like(
        $exception,
        qr/^\QYou cannot inherit from a Moose Role (Bar)/,
        "Class cannot extend a role");

    isa_ok(
        $exception,
        'Moose::Exception::CanExtendOnlyClasses',
        "Class cannot extend a role");

    is(
        $exception->role_name,
        'Bar',
        "Class cannot extend a role");
}

{
    my $exception = exception {
        package Foo;
        use Moose;
        sub foo2 {}
        override foo2 => sub {};
    };

    like(
        $exception,
        qr/Cannot add an override method if a local method is already present/,
        "there is already a method named foo2 defined in the class, so you can't override it");

    isa_ok(
        $exception,
        'Moose::Exception::CannotOverrideLocalMethodIsPresent',
        "there is already a method named foo2 defined in the class, so you can't override it");

    is(
        $exception->class_name,
        'Foo',
        "there is already a method named foo2 defined in the class, so you can't override it");

    is(
        $exception->method->name,
        'foo2',
        "there is already a method named foo2 defined in the class, so you can't override it");
}

{
    my $exception = exception {
        package Foo;
        use Moose;
        sub foo {}
        augment foo => sub {};
    };

    like(
        $exception,
        qr/Cannot add an augment method if a local method is already present/,
        "there is already a method named foo defined in the class");

    isa_ok(
        $exception,
        'Moose::Exception::CannotAugmentIfLocalMethodPresent',
        "there is already a method named foo defined in the class");

    is(
        $exception->class_name,
        'Foo',
        "there is already a method named foo defined in the class");

    is(
        $exception->method->name,
        'foo',
        "there is already a method named foo defined in the class");
}

{
    {
        package Test;
        use Moose;
    }

    my $exception = exception {
        package Test2;
        use Moose;
        extends 'Test';
        has '+bar' => ( default => 100 );
    };

    like(
        $exception,
        qr/Could not find an attribute by the name of 'bar' to inherit from in Test2/,
        "attribute 'bar' is not defined in the super class");

    isa_ok(
        $exception,
        "Moose::Exception::NoAttributeFoundInSuperClass",
        "attribute 'bar' is not defined in the super class");
}

done_testing;