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;

use Moose();

use Moose::Util 'find_meta';

{
    my $exception = exception {
        package Bar;
        use Moose::Role;
        extends 'Foo';
    };

    like(
        $exception,
        qr/\QRoles do not support 'extends' (you can use 'with' to specialize a role)/,
        "Roles do not support extends");

    isa_ok(
        $exception,
        "Moose::Exception::RolesDoNotSupportExtends",
        "Roles do not support extends");
}

{
    my $exception = exception {
        package Bar;
        use Moose::Role;
        requires;
    };

    like(
        $exception,
        qr/Must specify at least one method/,
        "requires expects atleast one method name");

    isa_ok(
        $exception,
        "Moose::Exception::MustSpecifyAtleastOneMethod",
        "requires expects atleast one method name");

    is(
        $exception->role_name,
        'Bar',
        'requires expects atleast one method name');
}

{
    my $exception = exception {
        package Bar;
        use Moose::Role;
        excludes;
    };

    like(
        $exception,
        qr/Must specify at least one role/,
        "excludes expects atleast one role name");

    isa_ok(
        $exception,
        "Moose::Exception::MustSpecifyAtleastOneRole",
        "excludes expects atleast one role name");

    is(
        $exception->role_name,
        'Bar',
        'excludes expects atleast one role name');
}

{
    my $exception = exception {
        package Bar;
        use Moose::Role;
        inner;
    };

    like(
        $exception,
        qr/Roles cannot support 'inner'/,
        "Roles do not support 'inner'");

    isa_ok(
        $exception,
        "Moose::Exception::RolesDoNotSupportInner",
        "Roles do not support 'inner'");
}

{
    my $exception = exception {
        package Bar;
        use Moose::Role;
        augment 'foo' => sub {};
    };

    like(
        $exception,
        qr/Roles cannot support 'augment'/,
        "Roles do not support 'augment'");

    isa_ok(
        $exception,
        "Moose::Exception::RolesDoNotSupportAugment",
        "Roles do not support 'augment'");
}

{
    my $exception = exception {
        {
            package Foo1;
            use Moose::Role;
            has 'bar' => (
                is =>
            );
        }
    };

    like(
        $exception,
        qr/\QUsage: has 'name' => ( key => value, ... )/,
        "has takes a hash");

    isa_ok(
        $exception,
        "Moose::Exception::InvalidHasProvidedInARole",
        "has takes a hash");

    is(
        $exception->attribute_name,
        'bar',
        "has takes a hash");

    is(
        $exception->role_name,
        'Foo1',
        "has takes a hash");
}

{
    my $exception = exception {
        use Moose::Role;
        Moose::Role->init_meta;
    };

    like(
        $exception,
        qr/Cannot call init_meta without specifying a for_class/,
        "for_class is not given");

    isa_ok(
        $exception,
        "Moose::Exception::InitMetaRequiresClass",
        "for_class is not given");
}

{
    my $exception = exception {
        use Moose::Role;
        Moose::Role->init_meta( (for_class => 'Foo2', metaclass => 'Foo2' ));
    };

    like(
        $exception,
        qr/\QThe Metaclass Foo2 must be loaded. (Perhaps you forgot to 'use Foo2'?)/,
        "Foo2 is not loaded");

    isa_ok(
        $exception,
        "Moose::Exception::MetaclassNotLoaded",
        "Foo2 is not loaded");

    is(
        $exception->class_name,
        "Foo2",
        "Foo2 is not loaded");
}

{
    {
        package Foo3;
        use Moose;
    }

    my $exception = exception {
        use Moose::Role;
        Moose::Role->init_meta( (for_class => 'Foo3', metaclass => 'Foo3' ));
    };

    like(
        $exception,
        qr/\QThe Metaclass Foo3 must be a subclass of Moose::Meta::Role./,
        "Foo3 is a Moose::Role");

    isa_ok(
        $exception,
        "Moose::Exception::MetaclassMustBeASubclassOfMooseMetaRole",
        "Foo3 is a Moose::Role");

    is(
        $exception->role_name,
        "Foo3",
        "Foo3 is a Moose::Role");
}

{
    {
        package Foo3;
        use Moose;
    }

    my $exception = exception {
        use Moose::Role;
        Moose::Role->init_meta( (for_class => 'Foo3' ));
    };

    my $foo3 = Foo3->meta;

    like(
        $exception,
        qr/\QFoo3 already has a metaclass, but it does not inherit Moose::Meta::Role ($foo3). You cannot make the same thing a role and a class. Remove either Moose or Moose::Role./,
        "Foo3 is a Moose class");
        #Foo3 already has a metaclass, but it does not inherit Moose::Meta::Role (Moose::Meta::Class=HASH(0x2d5d160)). You cannot make the same thing a role and a class. Remove either Moose or Moose::Role.

    isa_ok(
        $exception,
        "Moose::Exception::MetaclassIsAClassNotASubclassOfGivenMetaclass",
        "Foo3 is a Moose class");

    is(
        $exception->class_name,
        "Foo3",
        "Foo3 is a Moose class");

    is(
        find_meta($exception->class_name),
        Foo3->meta,
        "Foo3 is a Moose class");

    is(
        $exception->metaclass,
        "Moose::Meta::Role",
        "Foo3 is a Moose class");
}

{
    my $foo;
    {
        $foo = Class::MOP::Class->create("Foo4");
    }

    my $exception = exception {
        use Moose::Role;
        Moose::Role->init_meta( (for_class => 'Foo4' ));
    };

    like(
        $exception,
        qr/\QFoo4 already has a metaclass, but it does not inherit Moose::Meta::Role ($foo)./,
        "Foo4 is a Class::MOP::Class, not a Moose::Meta::Role");
        #Foo4 already has a metaclass, but it does not inherit Moose::Meta::Role (Class::MOP::Class=HASH(0x2c385a8)).

    isa_ok(
        $exception,
        "Moose::Exception::MetaclassIsNotASubclassOfGivenMetaclass",
        "Foo4 is a Class::MOP::Class, not a Moose::Meta::Role");

    is(
        $exception->class_name,
        "Foo4",
        "Foo4 is a Class::MOP::Class, not a Moose::Meta::Role");

    is(
        find_meta( $exception->class_name ),
        $foo,
        "Foo4 is a Class::MOP::Class, not a Moose::Meta::Role");

    is(
        $exception->metaclass,
        "Moose::Meta::Role",
        "Foo4 is a Class::MOP::Class, not a Moose::Meta::Role");
}

{
    my $exception = exception {
        package Foo;
        use Moose::Role;

        before qr/foo/;
    };

    like(
        $exception,
        qr/\QRoles do not currently support regex references for before method modifiers/,
        "a regex reference is given to before");

    isa_ok(
        $exception,
        "Moose::Exception::RolesDoNotSupportRegexReferencesForMethodModifiers",
        "a regex reference is given to before");

    is(
        $exception->role_name,
        "Foo",
        "a regex reference is given to before");

    is(
        find_meta($exception->role_name),
        Foo->meta,
        "a regex reference is given to before");

    is(
        $exception->modifier_type,
        "before",
        "a regex reference is given to before");
}

done_testing;