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;