diff options
Diffstat (limited to 't/exceptions')
64 files changed, 8992 insertions, 0 deletions
diff --git a/t/exceptions/attribute.t b/t/exceptions/attribute.t new file mode 100644 index 0000000..600f51f --- /dev/null +++ b/t/exceptions/attribute.t @@ -0,0 +1,1194 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +# tests for AccessorMustReadWrite +{ + use Moose; + + my $exception = exception { + has 'test' => ( + is => 'ro', + isa => 'Int', + accessor => 'bar', + ) + }; + + like( + $exception, + qr!Cannot define an accessor name on a read-only attribute, accessors are read/write!, + "Read-only attributes can't have accessor"); + + isa_ok( + $exception, + "Moose::Exception::AccessorMustReadWrite", + "Read-only attributes can't have accessor"); + + is( + $exception->attribute_name, + 'test', + "Read-only attributes can't have accessor"); +} + +# tests for AttributeIsRequired +{ + { + package Foo; + use Moose; + + has 'baz' => ( + is => 'ro', + isa => 'Int', + required => 1, + ); + } + + my $exception = exception { + Foo->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, + 'Foo', + "... must supply all the required attribute"); +} + +# tests for invalid value for is +{ + my $exception = exception { + use Moose; + has 'foo' => ( + is => 'bar', + ); + }; + + like( + $exception, + qr/^\QI do not understand this option (is => bar) on attribute (foo)/, + "invalid value for is"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidValueForIs', + "invalid value for is"); +} + +{ + { + package Foo; + use Moose; + } + + my $exception = exception { + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Foo', + does => 'Not::A::Role' + ); + }; + + like( + $exception, + qr/^\QCannot have an isa option and a does option if the isa does not do the does on attribute (bar)/, + "isa option should does the role on the given attribute"); + + isa_ok( + $exception, + 'Moose::Exception::IsaDoesNotDoTheRole', + "isa option should does the role on the given attribute"); +} + +{ + { + package Foo; + use Moose; + } + + my $exception = exception { + has 'bar' => ( + is => 'ro', + isa => 'Not::A::Class', + does => 'Not::A::Role', + ); + }; + + like( + $exception, + qr/^\QCannot have an isa option which cannot ->does() on attribute (bar)/, + "isa option which is not a class cannot ->does the role specified in does"); + + isa_ok( + $exception, + 'Moose::Exception::IsaLacksDoesMethod', + "isa option which is not a class cannot ->does the role specified in does"); +} + +{ + my $exception = exception { + use Moose; + has 'bar' => ( + is => 'ro', + coerce => 1, + ); + }; + + like( + $exception, + qr/^\QYou cannot have coercion without specifying a type constraint on attribute (bar)/, + "cannot coerce if type constraint i.e. isa option is not given"); + + isa_ok( + $exception, + 'Moose::Exception::CoercionNeedsTypeConstraint', + "cannot coerce if type constraint i.e. isa option is not given"); +} + +{ + my $exception = exception { + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Int', + weak_ref => 1, + coerce => 1, + ); + }; + + like( + $exception, + qr/^\QYou cannot have a weak reference to a coerced value on attribute (bar)/, + "cannot coerce if attribute is a weak_ref"); + + isa_ok( + $exception, + 'Moose::Exception::CannotCoerceAWeakRef', + "cannot coerce if attribute is a weak_ref"); +} + +{ + my $exception = exception { + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Int', + trigger => "foo", + ); + }; + + like( + $exception, + qr/^\QTrigger must be a CODE ref on attribute (bar)/, + "Trigger must be a CODE ref"); + + isa_ok( + $exception, + 'Moose::Exception::TriggerMustBeACodeRef', + "Trigger must be a CODE ref"); +} + +{ + { + package Foo; + use Moose; + has 'baz' => ( + is => 'ro', + isa => 'Int', + builder => "_build_baz", + ); + } + + my $exception = exception { + Foo->new; + }; + + like( + $exception, + qr/^\QFoo does not support builder method '_build_baz' for attribute 'baz'/, + "Correct error when a builder method is not present"); + + isa_ok( + $exception, + 'Moose::Exception::BuilderDoesNotExist', + "Correct error when a builder method is not present"); + + isa_ok( + $exception->instance, + 'Foo', + "Correct error when a builder method is not present"); + + is( + $exception->attribute->name, + 'baz', + "Correct error when a builder method is not present"); + + is( + $exception->attribute->builder, + '_build_baz', + "Correct error when a builder method is not present"); +} + +# tests for CannotDelegateWithoutIsa +{ + my $exception = exception { + package Foo; + use Moose; + has 'bar' => ( + is => 'ro', + handles => qr/baz/, + ); + }; + + like( + $exception, + qr/\QCannot delegate methods based on a Regexp without a type constraint (isa)/, + "isa is required while delegating methods based on a Regexp"); + + isa_ok( + $exception, + 'Moose::Exception::CannotDelegateWithoutIsa', + "isa is required while delegating methods based on a Regexp"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + has bar => ( + is => 'ro', + auto_deref => 1, + ); + }; + + like( + $exception, + qr/\QYou cannot auto-dereference without specifying a type constraint on attribute (bar)/, + "You cannot auto-dereference without specifying a type constraint on attribute"); + + isa_ok( + $exception, + 'Moose::Exception::CannotAutoDerefWithoutIsa', + "You cannot auto-dereference without specifying a type constraint on attribute"); + + is( + $exception->attribute_name, + 'bar', + "You cannot auto-dereference without specifying a type constraint on attribute"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + has 'bar' => ( + is => 'ro', + required => 1, + init_arg => undef, + ); + }; + + like( + $exception, + qr/\QYou cannot have a required attribute (bar) without a default, builder, or an init_arg/, + "No default, builder or init_arg is given"); + + isa_ok( + $exception, + 'Moose::Exception::RequiredAttributeNeedsADefault', + "No default, builder or init_arg is given"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + has 'bar' => ( + is => 'ro', + lazy => 1, + ); + }; + + like( + $exception, + qr/\QYou cannot have a lazy attribute (bar) without specifying a default value for it/, + "No default for a lazy attribute is given"); + + isa_ok( + $exception, + 'Moose::Exception::LazyAttributeNeedsADefault', + "No default for a lazy attribute is given"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Int', + auto_deref => 1, + ); + }; + + like( + $exception, + qr/\QYou cannot auto-dereference anything other than a ArrayRef or HashRef on attribute (bar)/, + "auto_deref needs either HashRef or ArrayRef"); + + isa_ok( + $exception, + 'Moose::Exception::AutoDeRefNeedsArrayRefOrHashRef', + "auto_deref needs either HashRef or ArrayRef"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + has 'bar' => ( + is => 'ro', + lazy_build => 1, + default => 1, + ); + }; + + like( + $exception, + qr/\QYou can not use lazy_build and default for the same attribute (bar)/, + "An attribute can't use lazy_build & default simultaneously"); + + isa_ok( + $exception, + 'Moose::Exception::CannotUseLazyBuildAndDefaultSimultaneously', + "An attribute can't use lazy_build & default simultaneously"); +} + +{ + my $exception = exception { + package Delegator; + use Moose; + + sub full { 1 } + sub stub; + + has d1 => ( + isa => 'X', + handles => ['full'], + ); + }; + + like( + $exception, + qr/\QYou cannot overwrite a locally defined method (full) with a delegation/, + 'got an error when trying to declare a delegation method that overwrites a local method'); + + isa_ok( + $exception, + 'Moose::Exception::CannotDelegateLocalMethodIsPresent', + "got an error when trying to declare a delegation method that overwrites a local method"); + + $exception = exception { + package Delegator; + use Moose; + + has d2 => ( + isa => 'X', + handles => ['stub'], + ); + }; + + is( + $exception, + undef, + 'no error when trying to declare a delegation method that overwrites a stub method'); +} + +{ + { + package Test; + use Moose; + has 'foo' => ( + is => 'rw', + clearer => 'clear_foo', + predicate => 'foo', + accessor => 'bar', + ); + } + + my $exception = exception { + package Test2; + use Moose; + extends 'Test'; + has '+foo' => ( + clearer => 'clear_foo1', + ); + }; + + like( + $exception, + qr/\QIllegal inherited options => (clearer)/, + "Illegal inherited option is given"); + + isa_ok( + $exception, + "Moose::Exception::IllegalInheritedOptions", + "Illegal inherited option is given"); + + $exception = exception { + package Test3; + use Moose; + extends 'Test'; + has '+foo' => ( + clearer => 'clear_foo1', + predicate => 'xyz', + accessor => 'bar2', + ); + }; + + like( + $exception, + qr/\QIllegal inherited options => (accessor, clearer, predicate)/, + "Illegal inherited option is given"); +} + +# tests for exception thrown is Moose::Meta::Attribute::set_value +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + required => 1, + ); + } + + my $instance = Foo1->new(bar => "test"); + my $bar_attr = Foo1->meta->get_attribute('bar'); + my $bar_writer = $bar_attr->get_write_method_ref; + $bar_writer->($instance); + }; + + like( + $exception, + qr/\QAttribute (bar) is required/, + "... must supply all the required attribute"); + + isa_ok( + $exception, + "Moose::Exception::AttributeIsRequired", + "... must supply all the required attribute"); + + is( + $exception->attribute_name, + 'bar', + "... must supply all the required attribute"); + + isa_ok( + $exception->class_name, + 'Foo1', + "... must supply all the required attribute"); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + handles => \*STDIN, + ); + } + }; + + my $handle = \*STDIN; + + like( + $exception, + qr/\QUnable to canonicalize the 'handles' option with $handle/, + "handles doesn't take file handle"); + #Unable to canonicalize the 'handles' option with GLOB(0x109d0b0) + + isa_ok( + $exception, + "Moose::Exception::UnableToCanonicalizeHandles", + "handles doesn't take file handle"); + +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + handles => 'Foo1', + ); + } + }; + + like( + $exception, + qr/\QUnable to canonicalize the 'handles' option with Foo1 because its metaclass is not a Moose::Meta::Role/, + "'Str' given to handles should be a metaclass of Moose::Meta::Role"); + + isa_ok( + $exception, + "Moose::Exception::UnableToCanonicalizeNonRolePackage", + "'Str' given to handles should be a metaclass of Moose::Meta::Role"); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Not::Loaded', + handles => qr/xyz/, + ); + } + }; + + like( + $exception, + qr/\QThe bar attribute is trying to delegate to a class which has not been loaded - Not::Loaded/, + "You cannot delegate to a class which has not yet loaded"); + + isa_ok( + $exception, + "Moose::Exception::DelegationToAClassWhichIsNotLoaded", + "You cannot delegate to a class which has not yet loaded"); + + is( + $exception->attribute->name, + 'bar', + "You cannot delegate to a class which has not yet loaded" + ); + + is( + $exception->class_name, + 'Not::Loaded', + "You cannot delegate to a class which has not yet loaded" + ); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has bar => ( + is => 'ro', + does => 'Role', + handles => qr/Role/, + ); + } + }; + + like( + $exception, + qr/\QThe bar attribute is trying to delegate to a role which has not been loaded - Role/, + "You cannot delegate to a role which has not yet loaded"); + + isa_ok( + $exception, + "Moose::Exception::DelegationToARoleWhichIsNotLoaded", + "You cannot delegate to a role which has not yet loaded"); + + is( + $exception->attribute->name, + 'bar', + "You cannot delegate to a role which has not yet loaded" + ); + + is( + $exception->role_name, + 'Role', + "You cannot delegate to a role which has not yet loaded" + ); +} + + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + isa => 'Int', + handles => qr/xyz/, + ); + } + }; + + like( + $exception, + qr/\QThe bar attribute is trying to delegate to a type (Int) that is not backed by a class/, + "Delegating to a type that is not backed by a class"); + + isa_ok( + $exception, + "Moose::Exception::DelegationToATypeWhichIsNotAClass", + "Delegating to a type that is not backed by a class"); + + is( + $exception->attribute->name, + 'bar', + "Delegating to a type that is not backed by a class"); + + is( + $exception->attribute->type_constraint->name, + 'Int', + "Delegating to a type that is not backed by a class"); + + $exception = exception { + { + package Foo1; + use Moose; + use Moose::Util::TypeConstraints; + + subtype 'PositiveInt', + as 'Int', + where { $_ > 0 }; + + has 'bar' => ( + is => 'ro', + isa => 'PositiveInt', + handles => qr/xyz/, + ); + } + }; + + like( + $exception, + qr/\QThe bar attribute is trying to delegate to a type (PositiveInt) that is not backed by a class/, + "Delegating to a type that is not backed by a class"); + + isa_ok( + $exception, + "Moose::Exception::DelegationToATypeWhichIsNotAClass", + "Delegating to a type that is not backed by a class"); + + is( + $exception->attribute->type_constraint->name, + 'PositiveInt', + "Delegating to a type that is not backed by a class"); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => 'ro', + does => '', + handles => qr/xyz/, + ); + } + }; + + like( + $exception, + qr/Cannot find delegate metaclass for attribute bar/, + "no does or isa is given"); + + isa_ok( + $exception, + "Moose::Exception::CannotFindDelegateMetaclass", + "no does or isa is given"); + + is( + $exception->attribute->name, + 'bar', + "no does or isa is given"); +} + +# tests for type coercions +{ + use Moose; + use Moose::Util::TypeConstraints; + subtype 'HexNum' => as 'Int', where { /[a-f0-9]/i }; + my $type_object = find_type_constraint 'HexNum'; + + my $exception = exception { + $type_object->coerce; + }; + + like( + $exception, + qr/Cannot coerce without a type coercion/, + "You cannot coerce a type unless coercion is supported by that type"); + + isa_ok( + $exception, + "Moose::Exception::CoercingWithoutCoercions", + "You cannot coerce a type unless coercion is supported by that type"); + + is( + $exception->type_name, + 'HexNum', + "You cannot coerce a type unless coercion is supported by that type"); +} + +{ + { + package Parent; + use Moose; + + has foo => ( + is => 'rw', + isa => 'Num', + default => 5.5, + ); + } + + { + package Child; + use Moose; + extends 'Parent'; + + has '+foo' => ( + isa => 'Int', + default => 100, + ); + } + + my $foo = Child->new; + my $exception = exception { + $foo->foo(10.5); + }; + + like( + $exception, + qr/\QAttribute (foo) does not pass the type constraint because: Validation failed for 'Int' with value 10.5/, + "10.5 is not an Int"); + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + "10.5 is not an Int"); + + is( + $exception->class_name, + "Child", + "10.5 is not an Int"); +} + +{ + { + package Foo2; + use Moose; + + has a4 => ( + traits => ['Array'], + is => 'rw', + isa => 'ArrayRef', + lazy => 1, + default => 'invalid', + clearer => '_clear_a4', + handles => { + get_a4 => 'get', + push_a4 => 'push', + accessor_a4 => 'accessor', + }, + ); + + has a5 => ( + traits => ['Array'], + is => 'rw', + isa => 'ArrayRef[Int]', + lazy => 1, + default => sub { [] }, + clearer => '_clear_a5', + handles => { + get_a5 => 'get', + push_a5 => 'push', + accessor_a5 => 'accessor', + }, + ); + } + + my $foo = Foo2->new; + + my $expect + = qr/\QAttribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value \E.*invalid.*/; + + my $exception = exception { $foo->accessor_a4(0); }; + + like( + $exception, + $expect, + 'invalid default is caught when trying to read via accessor'); + #Attribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value "invalid" + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + 'invalid default is caught when trying to read via accessor'); + + is( + $exception->class_name, + "Foo2", + 'invalid default is caught when trying to read via accessor'); + + $exception = exception { $foo->accessor_a4( 0 => 42 ); }; + + like( + $exception, + $expect, + 'invalid default is caught when trying to write via accessor'); + #Attribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value "invalid" + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + 'invalid default is caught when trying to write via accessor'); + + is( + $exception->class_name, + "Foo2", + 'invalid default is caught when trying to write via accessor'); + + $exception = exception { $foo->push_a4(42); }; + + like( + $exception, + $expect, + 'invalid default is caught when trying to push'); + #Attribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value "invalid" + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + 'invalid default is caught when trying to push'); + + is( + $exception->class_name, + "Foo2", + 'invalid default is caught when trying to push'); + + $exception = exception { $foo->get_a4(42); }; + + like( + $exception, + $expect, + 'invalid default is caught when trying to get'); + #Attribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value "invalid" + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + 'invalid default is caught when trying to get'); + + is( + $exception->class_name, + "Foo2", + 'invalid default is caught when trying to get'); +} + +{ + my $class = Moose::Meta::Class->create("RedundantClass"); + my $attr = Moose::Meta::Attribute->new('foo', (auto_deref => 1, + isa => 'ArrayRef', + is => 'ro' + ) + ); + my $attr2 = $attr->clone_and_inherit_options( isa => 'Int'); + + my $exception = exception { + $attr2->get_value($class); + }; + + like( + $exception, + qr/Can not auto de-reference the type constraint 'Int'/, + "Cannot auto-deref with 'Int'"); + + isa_ok( + $exception, + "Moose::Exception::CannotAutoDereferenceTypeConstraint", + "Cannot auto-deref with 'Int'"); + + is( + $exception->attribute->name, + "foo", + "Cannot auto-deref with 'Int'"); + + is( + $exception->type_name, + "Int", + "Cannot auto-deref with 'Int'"); +} + +{ + { + my $parameterizable = subtype 'ParameterizableArrayRef', as 'ArrayRef'; + my $int = find_type_constraint('Int'); + my $from_parameterizable = $parameterizable->parameterize($int); + + { + package Parameterizable; + use Moose; + + has from_parameterizable => ( is => 'rw', isa => $from_parameterizable ); + } + } + + my $params = Parameterizable->new(); + my $exception = exception { + $params->from_parameterizable( 'Hello' ); + }; + + like( + $exception, + qr/\QAttribute (from_parameterizable) does not pass the type constraint because: Validation failed for 'ParameterizableArrayRef[Int]'\E with value "?Hello"?/, + "'Hello' is a Str"); + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForInlineTypeConstraint", + "'Hello' is a Str"); + + is( + $exception->class_name, + "Parameterizable", + "'Hello' is a Str"); + + is( + $exception->value, + "Hello", + "'Hello' is a Str"); + + is( + $exception->attribute_name, + "from_parameterizable", + "'Hello' is a Str"); +} + +{ + { + package Test::LazyBuild::Attribute; + use Moose; + + has 'fool' => ( lazy_build => 1, is => 'ro'); + } + + my $instance = Test::LazyBuild::Attribute->new; + + my $exception = exception { + $instance->fool; + }; + + like( + $exception, + qr/\QTest::LazyBuild::Attribute does not support builder method '_build_fool' for attribute 'fool' /, + "builder method _build_fool doesn't exist"); + + isa_ok( + $exception, + "Moose::Exception::BuilderMethodNotSupportedForInlineAttribute", + "builder method _build_fool doesn't exist"); + + is( + $exception->attribute_name, + "fool", + "builder method _build_fool doesn't exist"); + + is( + $exception->builder, + "_build_fool", + "builder method _build_fool doesn't exist"); + + is( + $exception->class_name, + "Test::LazyBuild::Attribute", + "builder method _build_fool doesn't exist"); +} + +{ + { + package Foo::Required; + use Moose; + + has 'foo_required' => ( + reader => 'get_foo_required', + writer => 'set_foo_required', + required => 1, + ); + } + + my $foo = Foo::Required->new(foo_required => "required"); + + my $exception = exception { + $foo->set_foo_required(); + }; + + like( + $exception, + qr/\QAttribute (foo_required) is required/, + "passing no value to set_foo_required"); + + isa_ok( + $exception, + "Moose::Exception::AttributeIsRequired", + "passing no value to set_foo_required"); + + is( + $exception->attribute_name, + 'foo_required', + "passing no value to set_foo_required"); + + isa_ok( + $exception->class_name, + 'Foo::Required', + "passing no value to set_foo_required"); +} + +{ + use Moose::Util::TypeConstraints; + + my $exception = exception { + { + package BadMetaClass; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => "Moose::Util::TypeConstraints", + handles => qr/hello/ + ); + } + }; + + like( + $exception, + qr/Unable to recognize the delegate metaclass 'Class::MOP::Package/, + "unable to recognize metaclass of Moose::Util::TypeConstraints"); + + isa_ok( + $exception, + "Moose::Exception::UnableToRecognizeDelegateMetaclass", + "unable to recognize metaclass of Moose::Util::TypeConstraints"); + + is( + $exception->attribute->name, + 'foo', + "unable to recognize metaclass of Moose::Util::TypeConstraints"); + + is( + $exception->delegate_metaclass->name, + 'Moose::Util::TypeConstraints', + "unable to recognize metaclass of Moose::Util::TypeConstraints"); +} + +{ + my $exception = exception { + package Foo::CannotCoerce::WithoutCoercion; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + coerce => 1 + ) + }; + + like( + $exception, + qr/\QYou cannot coerce an attribute (foo) unless its type (Str) has a coercion/, + "has throws error with odd number of attribute options"); + + isa_ok( + $exception, + "Moose::Exception::CannotCoerceAttributeWhichHasNoCoercion", + "has throws error with odd number of attribute options"); + + is( + $exception->attribute_name, + 'foo', + "has throws error with odd number of attribute options"); + + is( + $exception->type_name, + 'Str', + "has throws error with odd number of attribute options"); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has 'bar' => ( + is => + ); + } + }; + + like( + $exception, + qr/\QYou must pass an even number of attribute options/, + 'has throws exception with odd number of attribute options'); + + isa_ok( + $exception, + "Moose::Exception::MustPassEvenNumberOfAttributeOptions", + 'has throws exception with odd number of attribute options'); + + is( + $exception->attribute_name, + 'bar', + 'has throws exception with odd number of attribute options'); +} + +{ + my $exception = exception { + { + package Foo1; + use Moose; + has bar => ( + is => 'ro', + required => 1, + isa => 'Int', + ); + } + + Foo1->new(bar => "test"); + }; + + like( + $exception, + qr/^Attribute \(bar\) does not pass the type constraint because: Validation failed for 'Int' with value "?test"?/, + "bar is an 'Int' and 'Str' is given"); + #Attribute (bar) does not pass the type constraint because: Validation failed for 'Int' with value "test" + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForTypeConstraint", + "bar is an 'Int' and 'Str' is given"); +} + +done_testing; diff --git a/t/exceptions/class-mop-attribute.t b/t/exceptions/class-mop-attribute.t new file mode 100644 index 0000000..d710699 --- /dev/null +++ b/t/exceptions/class-mop-attribute.t @@ -0,0 +1,213 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $class = Class::MOP::Attribute->new; + }; + + like( + $exception, + qr/You must provide a name for the attribute/, + "no attribute name given to new"); + + isa_ok( + $exception, + "Moose::Exception::MOPAttributeNewNeedsAttributeName", + "no attribute name given to new"); +} + +{ + my $exception = exception { + Class::MOP::Attribute->new( "foo", ( builder => [123] )); + }; + + like( + $exception, + qr/builder must be a defined scalar value which is a method name/, + "an array ref is given as builder"); + + isa_ok( + $exception, + "Moose::Exception::BuilderMustBeAMethodName", + "an array ref is given as builder"); +} + +{ + my $exception = exception { + Class::MOP::Attribute->new( "foo", ( builder => "bar", default => "xyz" )); + }; + + like( + $exception, + qr/\QSetting both default and builder is not allowed./, + "builder & default, both are given"); + + isa_ok( + $exception, + "Moose::Exception::BothBuilderAndDefaultAreNotAllowed", + "builder & default, both are given"); +} + +{ + my $exception = exception { + Class::MOP::Attribute->new( "foo", ( default => [1] ) ); + }; + + like( + $exception, + qr/\QReferences are not allowed as default values, you must wrap the default of 'foo' in a CODE reference (ex: sub { [] } and not [])/, + "default value can't take references"); + + isa_ok( + $exception, + "Moose::Exception::ReferencesAreNotAllowedAsDefault", + "default value can't take references"); + + is( + $exception->attribute_name, + "foo", + "default value can't take references"); +} + +{ + my $exception = exception { + Class::MOP::Attribute->new( "foo", ( required => 1, init_arg => undef ) ); + }; + + like( + $exception, + qr/A required attribute must have either 'init_arg', 'builder', or 'default'/, + "no 'init_arg', 'builder' or 'default' is given"); + + isa_ok( + $exception, + "Moose::Exception::RequiredAttributeLacksInitialization", + "no 'init_arg', 'builder' or 'default' is given"); +} + +{ + my $exception = exception { + my $foo = Class::MOP::Attribute->new("bar", ( required => 1, init_arg => undef, builder => 'foo')); + $foo->initialize_instance_slot( $foo->meta, $foo ); + }; + + like( + $exception, + qr/\QClass::MOP::Attribute does not support builder method 'foo' for attribute 'bar'/, + "given builder method doesn't exist"); + + isa_ok( + $exception, + "Moose::Exception::BuilderMethodNotSupportedForAttribute", + "given builder method doesn't exist"); + + is( + $exception->attribute->name, + "bar", + "given builder method doesn't exist"); + + is( + $exception->attribute->builder, + "foo", + "given builder method doesn't exist"); +} + +{ + my $exception = exception { + my $foo = Class::MOP::Attribute->new("foo"); + $foo->attach_to_class( "Foo" ); + }; + + like( + $exception, + qr/\QYou must pass a Class::MOP::Class instance (or a subclass)/, + "attach_to_class expects an instance Class::MOP::Class or its subclass"); + + isa_ok( + $exception, + "Moose::Exception::AttachToClassNeedsAClassMOPClassInstanceOrASubclass", + "attach_to_class expects an instance Class::MOP::Class or its subclass"); + + is( + $exception->attribute->name, + "foo", + "attach_to_class expects an instance Class::MOP::Class or its subclass"); + + is( + $exception->class, + "Foo", + "attach_to_class expects an instance Class::MOP::Class or its subclass"); +} + +{ + my $array = ["foo"]; + my $bar = Class::MOP::Attribute->new("bar", ( is => 'ro', predicate => $array)); + my $exception = exception { + $bar->install_accessors; + }; + + like( + $exception, + qr!bad accessor/reader/writer/predicate/clearer format, must be a HASH ref!, + "an array reference is given to predicate"); + + isa_ok( + $exception, + "Moose::Exception::BadOptionFormat", + "an array reference is given to predicate"); + + is( + $exception->attribute->name, + "bar", + "an array reference is given to predicate"); + + is( + $exception->option_name, + "predicate", + "an array reference is given to predicate"); + + is( + $exception->option_value, + $array, + "an array reference is given to predicate"); +} + +{ + my $bar = Class::MOP::Attribute->new("bar", ( is => 'ro', predicate => "foo")); + my $exception = exception { + $bar->install_accessors; + }; + + like( + $exception, + qr/\QCould not create the 'predicate' method for bar because : Can't call method "name" on an undefined value/, + "Can't call method 'name' on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotCreateMethod", + "Can't call method 'name' on an undefined value"); + + is( + $exception->attribute->name, + "bar", + "Can't call method 'name' on an undefined value"); + + is( + $exception->option_name, + "predicate", + "Can't call method 'name' on an undefined value"); + + is( + $exception->option_value, + "foo", + "Can't call method 'name' on an undefined value"); +} + +done_testing; diff --git a/t/exceptions/class-mop-class-immutable-trait.t b/t/exceptions/class-mop-class-immutable-trait.t new file mode 100644 index 0000000..abefba7 --- /dev/null +++ b/t/exceptions/class-mop-class-immutable-trait.t @@ -0,0 +1,57 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + package Foo; + use Moose; + __PACKAGE__->meta->make_immutable; + __PACKAGE__->meta->superclasses("Bar"); + }; + + like( + $exception, + qr/The 'superclasses' method is read-only when called on an immutable instance/, + "calling 'foo' on an immutable instance"); + + isa_ok( + $exception, + "Moose::Exception::CallingReadOnlyMethodOnAnImmutableInstance", + "calling 'foo' on an immutable instance"); + + is( + $exception->method_name, + "superclasses", + "calling 'foo' on an immutable instance"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + __PACKAGE__->meta->make_immutable; + __PACKAGE__->meta->add_method( foo => sub { "foo" } ); + }; + + like( + $exception, + qr/The 'add_method' method cannot be called on an immutable instance/, + "calling 'add_method' on an immutable instance"); + + isa_ok( + $exception, + "Moose::Exception::CallingMethodOnAnImmutableInstance", + "calling 'add_method' on an immutable instance"); + + is( + $exception->method_name, + "add_method", + "calling 'add_method' on an immutable instance"); +} + +done_testing; diff --git a/t/exceptions/class-mop-class.t b/t/exceptions/class-mop-class.t new file mode 100644 index 0000000..7e4a447 --- /dev/null +++ b/t/exceptions/class-mop-class.t @@ -0,0 +1,685 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $class = Class::MOP::Class::initialize; + }; + + like( + $exception, + qr/You must pass a package name and it cannot be blessed/, + "no package name given to initialize"); + + isa_ok( + $exception, + "Moose::Exception::InitializeTakesUnBlessedPackageName", + "no package name given to initialize"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( superclasses => ('foo') )); + }; + + like( + $exception, + qr/You must pass an ARRAY ref of superclasses/, + "an Array is of superclasses is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesArrayRefOfSuperclasses", + "an Array is of superclasses is passed"); + + is( + $exception->class, + 'Foo', + "an Array is of superclasses is passed"); +} + + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( attributes => ('foo') )); + }; + + like( + $exception, + qr/You must pass an ARRAY ref of attributes/, + "an Array is of attributes is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesArrayRefOfAttributes", + "an Array is of attributes is passed"); + + is( + $exception->class, + 'Foo', + "an Array is of attributes is passed"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( methods => ('foo') ) ); + }; + + like( + $exception, + qr/You must pass an HASH ref of methods/, + "a Hash is of methods is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesHashRefOfMethods", + "a Hash is of methods is passed"); + + is( + $exception->class, + 'Foo', + "a Hash is of methods is passed"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_method_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_method_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_method_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_method_by_name"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_all_methods_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_all_methods_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_all_methods_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_all_methods_by_name"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_next_method_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_next_method_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_next_method_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_next_method_by_name"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $foo = "foo"; + my $exception = exception { + $class->clone_object( $foo ); + }; + + like( + $exception, + qr/\QYou must pass an instance of the metaclass (Foo), not (foo)/, + "clone_object expects an instance of the metaclass"); + + isa_ok( + $exception, + "Moose::Exception::CloneObjectExpectsAnInstanceOfMetaclass", + "clone_object expects an instance of the metaclass"); + + is( + $exception->class_name, + 'Foo', + "clone_object expects an instance of the metaclass"); + + is( + $exception->instance, + 'foo', + "clone_object expects an instance of the metaclass"); +} + +{ + { + package Foo; + use Moose; + } + { + package Foo2; + use Moose; + } + my $foo2 = Foo2->new; + my $exception = exception { + Foo->meta->rebless_instance( $foo2 ); + }; + + like( + $exception, + qr/\QYou may rebless only into a subclass of (Foo2), of which (Foo) isn't./, + "you can rebless only into subclass"); + + isa_ok( + $exception, + "Moose::Exception::CanReblessOnlyIntoASubclass", + "you can rebless only into subclass"); + + is( + $exception->class_name, + 'Foo', + "you can rebless only into subclass"); + + is( + $exception->instance, + $foo2, + "you can rebless only into subclass"); +} + +{ + { + package Foo; + use Moose; + } + { + package Foo2; + use Moose; + } + my $foo = Foo->new; + my $exception = exception { + Foo2->meta->rebless_instance_back( $foo ); + }; + + like( + $exception, + qr/\QYou may rebless only into a superclass of (Foo), of which (Foo2) isn't./, + "you can rebless only into superclass"); + + isa_ok( + $exception, + "Moose::Exception::CanReblessOnlyIntoASuperclass", + "you can rebless only into superclass"); + + is( + $exception->instance, + $foo, + "you can rebless only into superclass"); + + is( + $exception->class_name, + "Foo2", + "you can rebless only into superclass"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_before_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_after_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_around_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->_construct_class_instance; + }; + + like( + $exception, + qr/You must pass a package name/, + "no package name given to _construct_class_instance"); + + isa_ok( + $exception, + "Moose::Exception::ConstructClassInstanceTakesPackageName", + "no package name given to _construct_class_instance"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->add_before_method_modifier("foo"); + }; + + like( + $exception, + qr/The method 'foo' was not found in the inheritance hierarchy for Foo/, + 'method "foo" is not defined in class "Foo"'); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotFoundInInheritanceHierarchy", + 'method "foo" is not defined in class "Foo"'); + + is( + $exception->class_name, + 'Foo', + 'method "foo" is not defined in class "Foo"'); + + is( + $exception->method_name, + 'foo', + 'method "foo" is not defined in class "Foo"'); +} + +{ + { + package Bar; + use Moose; + } + my $bar = Bar->new; + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->new_object( ( __INSTANCE__ => $bar ) ); + }; + + like( + $exception, + qr/\QObjects passed as the __INSTANCE__ parameter must already be blessed into the correct class, but $bar is not a Foo/, + "__INSTANCE__ is not blessed correctly"); + #Objects passed as the __INSTANCE__ parameter must already be blessed into the correct class, but Bar=HASH(0x2d77528) is not a Foo + + isa_ok( + $exception, + "Moose::Exception::InstanceBlessedIntoWrongClass", + "__INSTANCE__ is not blessed correctly"); + + is( + $exception->class_name, + 'Foo', + "__INSTANCE__ is not blessed correctly"); + + is( + $exception->instance, + $bar, + "__INSTANCE__ is not blessed correctly"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $array = [1,2,3]; + my $exception = exception { + $class->new_object( ( __INSTANCE__ => $array ) ); + }; + + like( + $exception, + qr/\QThe __INSTANCE__ parameter must be a blessed reference, not $array/, + "__INSTANCE__ is not a blessed reference"); + #The __INSTANCE__ parameter must be a blessed reference, not ARRAY(0x1d75d40) + + isa_ok( + $exception, + "Moose::Exception::InstanceMustBeABlessedReference", + "__INSTANCE__ is not a blessed reference"); + + is( + $exception->class_name, + 'Foo', + "__INSTANCE__ is not a blessed reference"); + + is( + $exception->instance, + $array, + "__INSTANCE__ is not a blessed reference"); +} + +{ + my $array = [1, 2, 3]; + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->_clone_instance($array); + }; + + like( + $exception, + qr/\QYou can only clone instances, ($array) is not a blessed instance/, + "array reference was passed to _clone_instance instead of a blessed instance"); + #You can only clone instances, (ARRAY(0x2162350)) is not a blessed instance + + isa_ok( + $exception, + "Moose::Exception::OnlyInstancesCanBeCloned", + "array reference was passed to _clone_instance instead of a blessed instance"); + + is( + $exception->class_name, + "Foo", + "array reference was passed to _clone_instance instead of a blessed instance"); + + is( + $exception->instance, + $array, + "array reference was passed to _clone_instance instead of a blessed instance"); +} + +{ + { + package My::Role; + use Moose::Role; + } + + my $exception = exception { + Class::MOP::Class->create("My::Class", superclasses => ["My::Role"]); + }; + + like( + $exception, + qr/\QThe metaclass of My::Class (Class::MOP::Class) is not compatible with the metaclass of its superclass, My::Role (Moose::Meta::Role) /, + "Trying to inherit a Role"); + + isa_ok( + $exception, + "Moose::Exception::IncompatibleMetaclassOfSuperclass", + "Trying to inherit a Role"); + + is( + $exception->class_name, + "My::Class", + "Trying to inherit a Role"); + + is( + $exception->superclass_name, + "My::Role", + "Trying to inherit a Role"); +} + +{ + { + package Super::Class; + use Moose; + } + + my $class = Class::MOP::Class->create("TestClass", superclasses => ["Super::Class"]); + $class->immutable_trait(undef); + my $exception = exception { + $class->make_immutable( immutable_trait => ''); + }; + + like( + $exception, + qr/\Qno immutable trait specified for $class/, + "immutable_trait set to undef"); + #no immutable trait specified for Moose::Meta::Class=HASH(0x19a2280) + + isa_ok( + $exception, + "Moose::Exception::NoImmutableTraitSpecifiedForClass", + "immutable_trait set to undef"); + + is( + $exception->class_name, + "TestClass", + "immutable_trait set to undef"); +} + +{ + my $exception = exception { + package NoDestructorClass; + use Moose; + + __PACKAGE__->meta->make_immutable( destructor_class => undef, inline_destructor => 1 ); + }; + + like( + $exception, + qr/The 'inline_destructor' option is present, but no destructor class was specified/, + "destructor_class is set to undef"); + + isa_ok( + $exception, + "Moose::Exception::NoDestructorClassSpecified", + "destructor_class is set to undef"); + + is( + $exception->class_name, + "NoDestructorClass", + "destructor_class is set to undef"); +} + +{ + { + package Foo9::Meta::Role; + use Moose::Role; + } + + { + package Foo9::SuperClass::WithMetaRole; + use Moose -traits =>'Foo9::Meta::Role'; + } + + { + package Foo9::Meta::OtherRole; + use Moose::Role; + } + + { + package Foo9::SuperClass::After::Attribute; + use Moose -traits =>'Foo9::Meta::OtherRole'; + } + + my $exception = exception { + { + package Foo9; + use Moose; + my @superclasses = ('Foo9::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo9::SuperClass::After::Attribute'); + + extends @superclasses; + } + }; + + like( + $exception, + qr/\QCan't fix metaclass incompatibility for Foo9 because it is not pristine./, + "cannot make metaclass compatible"); + + isa_ok( + $exception, + "Moose::Exception::CannotFixMetaclassCompatibility", + "cannot make metaclass compatible"); + + is( + $exception->class_name, + "Foo9", + "cannot make metaclass compatible"); +} + +{ + Class::MOP::Class->create( "Foo::Meta::Attribute", + superclasses => ["Class::MOP::Attribute"] + ); + + Class::MOP::Class->create( "Bar::Meta::Attribute", + superclasses => ["Class::MOP::Attribute"] + ); + + Class::MOP::Class->create( "Foo::Meta::Class", + superclasses => ["Class::MOP::Class"] + ); + + Foo::Meta::Class->create( + 'Foo::All', + attribute_metaclass => "Foo::Meta::Attribute", + ); + + { + Class::MOP::Class->create( + 'Foo::Unsafe', + attribute_metaclass => 'Foo::Meta::Attribute', + ); + + my $meta = Class::MOP::Class->create( + 'Foo::Unsafe::Sub', + ); + + $meta->add_attribute(foo => reader => 'foo'); + + my $exception = exception { + $meta->superclasses('Foo::Unsafe'); + }; + + like( + $exception, + qr/\QCan't fix metaclass incompatibility for Foo::Unsafe::Sub because it is not pristine./, + "cannot make metaclass compatible"); + + isa_ok( + $exception, + "Moose::Exception::CannotFixMetaclassCompatibility", + "cannot make metaclass compatible"); + + is( + $exception->class_name, + "Foo::Unsafe::Sub", + "cannot make metaclass compatible"); + } + + { + my $exception = exception { + Foo::Meta::Class->create( + "Foo::All::Sub::Attribute", + superclasses => ['Foo::All'], + attribute_metaclass => "Foo::Meta::Attribute", + attribute_metaclass => "Bar::Meta::Attribute", + ) + }; + + like( + $exception, + qr/\QThe attribute_metaclass metaclass for Foo::All::Sub::Attribute (Bar::Meta::Attribute) is not compatible with the attribute metaclass of its superclass, Foo::All (Foo::Meta::Attribute)/, + "incompatible attribute_metaclass"); + + isa_ok( + $exception, + "Moose::Exception::MetaclassTypeIncompatible", + "incompatible attribute_metaclass"); + + is( + $exception->class_name, + "Foo::All::Sub::Attribute", + "incompatible attribute_metaclass"); + + is( + $exception->superclass_name, + "Foo::All", + "incompatible attribute_metaclass"); + + is( + $exception->metaclass_type, + "attribute_metaclass", + "incompatible attribute_metaclass"); + } +} + +done_testing; diff --git a/t/exceptions/class-mop-method-accessor.t b/t/exceptions/class-mop-method-accessor.t new file mode 100644 index 0000000..b83a2df --- /dev/null +++ b/t/exceptions/class-mop-method-accessor.t @@ -0,0 +1,279 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method::Accessor->new; + }; + + like( + $exception, + qr/\QYou must supply an attribute to construct with/, + "no attribute is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAnAttributeToConstructWith", + "no attribute is given"); +} + +{ + my $exception = exception { + Class::MOP::Method::Accessor->new( attribute => "foo" ); + }; + + like( + $exception, + qr/\QYou must supply an accessor_type to construct with/, + "no accessor_type is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAnAccessorTypeToConstructWith", + "no accessor_type is given"); +} + +{ + my $exception = exception { + Class::MOP::Method::Accessor->new( accessor_type => 'reader', attribute => "foo" ); + }; + + like( + $exception, + qr/\QYou must supply an attribute which is a 'Class::MOP::Attribute' instance/, + "attribute isn't an instance of Class::MOP::Attribute"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAClassMOPAttributeInstance", + "attribute isn't an instance of Class::MOP::Attribute"); +} + +{ + my $attr = Class::MOP::Attribute->new("Foo", ( is => 'ro')); + my $exception = exception { + Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr); + }; + + like( + $exception, + qr/\QYou must supply the package_name and name parameters/, + "no package_name and name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyPackageNameAndName", + "no package_name and name is given"); +} + +{ + my $attr = Class::MOP::Attribute->new("foo", ( is => 'ro')); + my $accessor = Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr, name => "foo", package_name => "Foo"); + my $exception = exception { + my $subr = $accessor->_generate_accessor_method_inline(); + }; + + like( + $exception, + qr/\QCould not generate inline accessor because : Can't call method "get_meta_instance" on an undefined value/, + "can't call get_meta_instance on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "can't call get_meta_instance on an undefined value"); + + is( + $exception->option, + "accessor", + "can't call get_meta_instance on an undefined value"); +} + +{ + my $attr = Class::MOP::Attribute->new("foo", ( is => 'ro')); + my $accessor = Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr, name => "foo", package_name => "Foo"); + my $exception = exception { + my $subr = $accessor->_generate_reader_method_inline(); + }; + + like( + $exception, + qr/\QCould not generate inline reader because : Can't call method "get_meta_instance" on an undefined value/, + "can't call get_meta_instance on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "can't call get_meta_instance on an undefined value"); + + is( + $exception->option, + "reader", + "can't call get_meta_instance on an undefined value"); +} + +{ + my $attr = Class::MOP::Attribute->new("foo", ( is => 'ro')); + my $accessor = Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr, name => "foo", package_name => "Foo"); + my $exception = exception { + my $subr = $accessor->_generate_writer_method_inline(); + }; + + like( + $exception, + qr/\QCould not generate inline writer because : Can't call method "get_meta_instance" on an undefined value/, + "can't call get_meta_instance on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "can't call get_meta_instance on an undefined value"); + + is( + $exception->option, + "writer", + "can't call get_meta_instance on an undefined value"); +} + +{ + my $attr = Class::MOP::Attribute->new("foo", ( is => 'ro')); + my $accessor = Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr, name => "foo", package_name => "Foo"); + my $exception = exception { + my $subr = $accessor->_generate_predicate_method_inline(); + }; + + like( + $exception, + qr/\QCould not generate inline predicate because : Can't call method "get_meta_instance" on an undefined value/, + "can't call get_meta_instance on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "can't call get_meta_instance on an undefined value"); + + is( + $exception->option, + "predicate", + "can't call get_meta_instance on an undefined value"); +} + +{ + my $attr = Class::MOP::Attribute->new("foo", ( is => 'ro')); + my $accessor = Class::MOP::Method::Accessor->new( accessor_type => "reader", attribute => $attr, name => "foo", package_name => "Foo"); + my $exception = exception { + my $subr = $accessor->_generate_clearer_method_inline(); + }; + + like( + $exception, + qr/\QCould not generate inline clearer because : Can't call method "get_meta_instance" on an undefined value/, + "can't call get_meta_instance on an undefined value"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "can't call get_meta_instance on an undefined value"); + + is( + $exception->option, + "clearer", + "can't call get_meta_instance on an undefined value"); +} + +{ + { + package Foo::ReadOnlyAccessor; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Int', + ); + } + + my $foo = Foo::ReadOnlyAccessor->new; + + my $exception = exception { + $foo->foo(120); + }; + + like( + $exception, + qr/Cannot assign a value to a read-only accessor/, + "foo is read only"); + + isa_ok( + $exception, + "Moose::Exception::CannotAssignValueToReadOnlyAccessor", + "foo is read only"); + + is( + $exception->class_name, + "Foo::ReadOnlyAccessor", + "foo is read only"); + + is( + $exception->attribute_name, + "foo", + "foo is read only"); + + is( + $exception->value, + 120, + "foo is read only"); +} + +{ + { + package Point; + use metaclass; + + Point->meta->add_attribute('x' => ( + reader => 'x', + init_arg => 'x' + )); + + sub new { + my $class = shift; + bless $class->meta->new_object(@_) => $class; + } + } + + my $point = Point->new(); + + my $exception = exception { + $point->x(120); + }; + + like( + $exception, + qr/Cannot assign a value to a read-only accessor/, + "x is read only"); + + isa_ok( + $exception, + "Moose::Exception::CannotAssignValueToReadOnlyAccessor", + "x is read only"); + + is( + $exception->class_name, + "Point", + "x is read only"); + + is( + $exception->attribute_name, + "x", + "x is read only"); + + is( + $exception->value, + 120, + "x is read only"); +} +done_testing; diff --git a/t/exceptions/class-mop-method-constructor.t b/t/exceptions/class-mop-method-constructor.t new file mode 100644 index 0000000..dd87f4a --- /dev/null +++ b/t/exceptions/class-mop-method-constructor.t @@ -0,0 +1,75 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method::Constructor->new( is_inline => 1); + }; + + like( + $exception, + qr/\QYou must pass a metaclass instance if you want to inline/, + "no metaclass is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAMetaclass", + "no metaclass is given"); +} + +{ + my $exception = exception { + Class::MOP::Method::Constructor->new; + }; + + like( + $exception, + qr/\QYou must supply the package_name and name parameters/, + "no package_name and name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyPackageNameAndName", + "no package_name and name is given"); +} + +{ + BEGIN + { + { + package NewMetaClass; + use Moose; + extends 'Moose::Meta::Class'; + + sub _inline_new_object { + return 'print "xyz'; # this is a intentional syntax error, + } + } + }; + + { + package BadConstructorClass; + use Moose -metaclass => 'NewMetaClass'; + } + + my $exception = exception { + BadConstructorClass->meta->make_immutable(); + }; + + like( + $exception, + qr/Could not eval the constructor :/, + "syntax error in _inline_new_object"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotEvalConstructor", + "syntax error in _inline_new_object"); +} + +done_testing; diff --git a/t/exceptions/class-mop-method-generated.t b/t/exceptions/class-mop-method-generated.t new file mode 100644 index 0000000..59a91b6 --- /dev/null +++ b/t/exceptions/class-mop-method-generated.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method::Generated->new; + }; + + like( + $exception, + qr/\QClass::MOP::Method::Generated is an abstract base class, you must provide a constructor./, + "trying to call an abstract base class constructor"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractBaseMethod", + "trying to call an abstract base class constructor"); +} + +{ + my $exception = exception { + Class::MOP::Method::Generated->_initialize_body; + }; + + like( + $exception, + qr/\QNo body to initialize, Class::MOP::Method::Generated is an abstract base class/, + "trying to call a method of an abstract class"); + + isa_ok( + $exception, + "Moose::Exception::NoBodyToInitializeInAnAbstractBaseClass", + "trying to call a method of an abstract class"); +} + +done_testing; diff --git a/t/exceptions/class-mop-method-meta.t b/t/exceptions/class-mop-method-meta.t new file mode 100644 index 0000000..ddd51aa --- /dev/null +++ b/t/exceptions/class-mop-method-meta.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method::Meta->wrap("Foo", ( body => 'foo' )); + }; + + like( + $exception, + qr/\QOverriding the body of meta methods is not allowed/, + "body is given to Class::MOP::Method::Meta->wrap"); + + isa_ok( + $exception, + "Moose::Exception::CannotOverrideBodyOfMetaMethods", + "body is given to Class::MOP::Method::Meta->wrap"); +} + +done_testing; diff --git a/t/exceptions/class-mop-method-wrapped.t b/t/exceptions/class-mop-method-wrapped.t new file mode 100644 index 0000000..bf96dd8 --- /dev/null +++ b/t/exceptions/class-mop-method-wrapped.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method::Wrapped->wrap("Foo"); + }; + + like( + $exception, + qr/\QCan only wrap blessed CODE/, + "no CODE is given to wrap"); + + isa_ok( + $exception, + "Moose::Exception::CanOnlyWrapBlessedCode", + "no CODE is given to wrap"); +} + +done_testing; diff --git a/t/exceptions/class-mop-method.t b/t/exceptions/class-mop-method.t new file mode 100644 index 0000000..c85cc7b --- /dev/null +++ b/t/exceptions/class-mop-method.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Method->wrap( "foo", ( name => "Bar")); + }; + + like( + $exception, + qr/\QYou must supply a CODE reference to bless, not (foo)/, + "first argument to wrap should be a CODE ref"); + + isa_ok( + $exception, + "Moose::Exception::WrapTakesACodeRefToBless", + "first argument to wrap should be a CODE ref"); +} + +{ + my $exception = exception { + Class::MOP::Method->wrap( sub { "foo" }, ()); + }; + + like( + $exception, + qr/You must supply the package_name and name parameters/, + "no package name is given to wrap"); + + isa_ok( + $exception, + "Moose::Exception::PackageNameAndNameParamsNotGivenToWrap", + "no package name is given to wrap"); +} + +done_testing; diff --git a/t/exceptions/class-mop-mixin-hasattributes.t b/t/exceptions/class-mop-mixin-hasattributes.t new file mode 100644 index 0000000..c498c4c --- /dev/null +++ b/t/exceptions/class-mop-mixin-hasattributes.t @@ -0,0 +1,98 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $xyz = bless [], "Bar"; + my $class; + my $exception = exception { + $class = Class::MOP::Class->create("Foo", (attributes => [$xyz])); + }; + + like( + $exception, + qr/\QYour attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)/, + "an Array ref blessed into Bar is given to create"); + + isa_ok( + $exception, + "Moose::Exception::AttributeMustBeAnClassMOPMixinAttributeCoreOrSubclass", + "an Array ref blessed into Bar is given to create"); + + is( + $exception->attribute, + $xyz, + "an Array ref blessed into Bar is given to create"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->has_attribute; + }; + + like( + $exception, + qr/You must define an attribute name/, + "attribute name is not given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAnAttributeName", + "attribute name is not given"); + + is( + $exception->class_name, + 'Foo', + "attribute name is not given"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->get_attribute; + }; + + like( + $exception, + qr/You must define an attribute name/, + "attribute name is not given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAnAttributeName", + "attribute name is not given"); + + is( + $exception->class_name, + "Foo", + "attribute name is not given"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->remove_attribute; + }; + + like( + $exception, + qr/You must define an attribute name/, + "attribute name is not given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAnAttributeName", + "attribute name is not given"); + + is( + $exception->class_name, + "Foo", + "attribute name is not given"); +} + +done_testing; diff --git a/t/exceptions/class-mop-mixin-hasmethods.t b/t/exceptions/class-mop-mixin-hasmethods.t new file mode 100644 index 0000000..d0d39dd --- /dev/null +++ b/t/exceptions/class-mop-mixin-hasmethods.t @@ -0,0 +1,141 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose::Role; + } + + my $exception = exception { + Foo->meta->has_method; + }; + + like( + $exception, + qr/\QYou must define a method name/, + "no method name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAMethodName", + "no method name is given"); + + is( + $exception->instance, + Foo->meta, + "no method name is given"); +} + +{ + { + package Foo; + use Moose::Role; + } + + my $exception = exception { + Foo->meta->add_method; + }; + + like( + $exception, + qr/\QYou must define a method name/, + "no method name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAMethodName", + "no method name is given"); + + is( + $exception->instance, + Foo->meta, + "no method name is given"); +} + +{ + { + package Foo; + use Moose::Role; + } + + my $exception = exception { + Foo->meta->get_method; + }; + + like( + $exception, + qr/\QYou must define a method name/, + "no method name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAMethodName", + "no method name is given"); + + is( + $exception->instance, + Foo->meta, + "no method name is given"); +} + +{ + { + package Foo; + use Moose::Role; + } + + my $exception = exception { + Foo->meta->remove_method; + }; + + like( + $exception, + qr/\QYou must define a method name/, + "no method name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAMethodName", + "no method name is given"); + + is( + $exception->instance, + Foo->meta, + "no method name is given"); +} + +{ + { + package Bar::Role; + use Moose::Role; + } + + my $meta = Bar::Role->meta; + + my $exception = exception { + $meta->wrap_method_body; + }; + + like( + $exception, + qr/Your code block must be a CODE reference/, + "no arguments passed to wrap_method_body"); + + isa_ok( + $exception, + "Moose::Exception::CodeBlockMustBeACodeRef", + "no arguments passed to wrap_method_body"); + + is( + $exception->instance, + $meta, + "no arguments passed to wrap_method_body"); +} + +done_testing; diff --git a/t/exceptions/class-mop-module.t b/t/exceptions/class-mop-module.t new file mode 100644 index 0000000..604fa88 --- /dev/null +++ b/t/exceptions/class-mop-module.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Module->create_anon(cache => 1); + }; + + like( + $exception, + qr/Modules are not cacheable/, + "can't cache anon packages"); + + isa_ok( + $exception, + "Moose::Exception::PackagesAndModulesAreNotCachable", + "can't cache anon packages"); +} + +done_testing; diff --git a/t/exceptions/class-mop-object.t b/t/exceptions/class-mop-object.t new file mode 100644 index 0000000..b41f93a --- /dev/null +++ b/t/exceptions/class-mop-object.t @@ -0,0 +1,109 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + my $exception = exception { + use Moose (); + # XXX call cmop version of throw_error here instead! + Moose->throw_error("Hello, I am an exception object"); + }; + + like( + $exception, + qr/Hello, I am an exception object/, + "throw_error stringifies to the message"); + + isa_ok( + $exception, + 'Moose::Exception::Legacy', + "exception"); +} + +{ + my $exception = exception { + use Moose (); + Moose->throw_error("Hello, ", "I am an ", "exception object"); + }; + + like( + $exception, + qr/Hello, I am an exception object/, + "throw_error stringifies to the full message"); + + isa_ok( + $exception, + 'Moose::Exception::Legacy', + "exception"); +} + +{ + BEGIN + { + { + package FooRole; + use Moose::Role; + + sub xyz { + print "In xyz method"; + } + } + + { + package FooMetaclass; + use Moose; + with 'FooRole'; + extends 'Moose::Meta::Class'; + + sub _inline_check_required_attr { + my $self = shift; + my ($attr) = @_; + + return unless defined $attr->init_arg; + return unless $attr->can('is_required') && $attr->is_required; + return if $attr->has_default || $attr->has_builder; + + return ( + 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {', + $self->_inline_throw_error( + 'Legacy => '. + 'message => "An inline error" ' + ).';', + '}', + ); + } + } + } +}; + +{ + { + package Foo2; + use Moose -metaclass => 'FooMetaclass'; + + has 'baz' => ( + is => 'ro', + isa => 'Int', + required => 1, + ); + __PACKAGE__->meta->make_immutable; + } + + my $exception = exception { + my $test1 = Foo2->new; + }; + + like( + $exception, + qr/An inline error/, + "_inline_throw_error stringifies to the message"); + + isa_ok( + $exception, + 'Moose::Exception::Legacy', + "_inline_throw_error stringifies to the message"); +} + +done_testing(); diff --git a/t/exceptions/class-mop-package.t b/t/exceptions/class-mop-package.t new file mode 100644 index 0000000..4cf78e7 --- /dev/null +++ b/t/exceptions/class-mop-package.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Class::MOP::Package->reinitialize; + }; + + like( + $exception, + qr/\QYou must pass a package name or an existing Class::MOP::Package instance/, + "no package name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustPassAPackageNameOrAnExistingClassMOPPackageInstance", + "no package name is given"); +} + +{ + my $exception = exception { + Class::MOP::Package->create_anon(cache => 1); + }; + + like( + $exception, + qr/Packages are not cacheable/, + "can't cache anon packages"); + + isa_ok( + $exception, + "Moose::Exception::PackagesAndModulesAreNotCachable", + "can't cache anon packages"); +} + +done_testing; diff --git a/t/exceptions/class.t b/t/exceptions/class.t new file mode 100644 index 0000000..6adddc9 --- /dev/null +++ b/t/exceptions/class.t @@ -0,0 +1,304 @@ +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; diff --git a/t/exceptions/cmop.t b/t/exceptions/cmop.t new file mode 100644 index 0000000..9021591 --- /dev/null +++ b/t/exceptions/cmop.t @@ -0,0 +1,20 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Class::MOP; + +{ + my $exception = exception { + Class::MOP::Mixin->_throw_exception(Legacy => message => 'oh hai'); + }; + ok( + $exception->isa('Moose::Exception::Legacy'), + 'threw the right type', + ); + is($exception->message, 'oh hai', 'got the message attribute'); +} + +done_testing; diff --git a/t/exceptions/exception-lazyattributeneedsadefault.t b/t/exceptions/exception-lazyattributeneedsadefault.t new file mode 100644 index 0000000..c0eb4a2 --- /dev/null +++ b/t/exceptions/exception-lazyattributeneedsadefault.t @@ -0,0 +1,66 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util 'throw_exception'; + +{ + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro' + ); + + has 'bar' => ( + is => 'ro' + ); +} + +{ + my $exception = exception { + throw_exception( LazyAttributeNeedsADefault => attribute_name => "foo", + attribute => Foo->meta->get_attribute("bar") + ); + }; + + like( + $exception, + qr/\Qattribute_name (foo) does not match attribute->name (bar)/, + "you have given attribute_name as 'foo' and attribute->name as 'bar'"); + + isa_ok( + $exception, + "Moose::Exception::AttributeNamesDoNotMatch", + "you have given attribute_name as 'foo' and attribute->name as 'bar'"); + + is( + $exception->attribute_name, + "foo", + "you have given attribute_name as 'foo' and attribute->name as 'bar'"); + + is( + $exception->attribute->name, + "bar", + "you have given attribute_name as 'foo' and attribute->name as 'bar'"); +} + +{ + my $exception = exception { + throw_exception("LazyAttributeNeedsADefault"); + }; + + like( + $exception, + qr/\QYou need to give attribute or attribute_name or both/, + "please give either attribute or attribute_name"); + + isa_ok( + $exception, + "Moose::Exception::NeitherAttributeNorAttributeNameIsGiven", + "please give either attribute or attribute_name"); +} + +done_testing; diff --git a/t/exceptions/frame-leak.t b/t/exceptions/frame-leak.t new file mode 100644 index 0000000..e11bd63 --- /dev/null +++ b/t/exceptions/frame-leak.t @@ -0,0 +1,23 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; +use Test::Requires 'Test::Memory::Cycle'; + +BEGIN { + plan skip_all => 'Leak tests fail under Devel::Cover' if $INC{'Devel/Cover.pm'}; +} + +{ + package Foo; + use Moose; + has myattr => ( is => 'ro', required => 1 ); +} + +memory_cycle_ok( + exception { Foo->new() }, + 'exception objects do not leak arguments into Devel::StackTrace objects', +); + +done_testing; diff --git a/t/exceptions/meta-role.t b/t/exceptions/meta-role.t new file mode 100644 index 0000000..2fb1013 --- /dev/null +++ b/t/exceptions/meta-role.t @@ -0,0 +1,242 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + { + package JustATestRole; + use Moose::Role; + } + + { + package JustATestClass; + use Moose; + } + + my $class = JustATestClass->meta; + my $exception = exception { + JustATestRole->meta->add_attribute( $class ); + }; + + like( + $exception, + qr/\QCannot add a Moose::Meta::Class as an attribute to a role/, + "Roles cannot have a class as an attribute"); + + isa_ok( + $exception, + "Moose::Exception::CannotAddAsAnAttributeToARole", + "Roles cannot have a class as an attribute"); + + is( + $exception->role_name, + 'JustATestRole', + "Roles cannot have a class as an attribute"); + + is( + $exception->attribute_class, + "Moose::Meta::Class", + "Roles cannot have a class as an attribute"); +} + +{ + my $exception = exception { + package JustATestRole; + use Moose::Role; + + has '+attr' => ( + is => 'ro', + ); + }; + + like( + $exception, + qr/\Qhas '+attr' is not supported in roles/, + "Attribute Extension is not supported in roles"); + + isa_ok( + $exception, + "Moose::Exception::AttributeExtensionIsNotSupportedInRoles", + "Attribute Extension is not supported in roles"); + + is( + $exception->role_name, + 'JustATestRole', + "Attribute Extension is not supported in roles"); + + is( + $exception->attribute_name, + "+attr", + "Attribute Extension is not supported in roles"); +} + +{ + my $exception = exception { + package JustATestRole; + use Moose::Role; + + sub bar {} + + override bar => sub {}; + }; + + like( + $exception, + qr/\QCannot add an override of method 'bar' because there is a local version of 'bar'/, + "Cannot override bar, because it's a local method"); + + isa_ok( + $exception, + "Moose::Exception::CannotOverrideALocalMethod", + "Cannot override bar, because it's a local method"); + + is( + $exception->role_name, + 'JustATestRole', + "Cannot override bar, because it's a local method"); + + is( + $exception->method_name, + "bar", + "Cannot override bar, because it's a local method"); +} + +{ + { + package JustATestRole; + use Moose::Role; + } + + my $exception = exception { + JustATestRole->meta->add_role("xyz"); + }; + + like( + $exception, + qr/\QRoles must be instances of Moose::Meta::Role/, + "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role"); + + isa_ok( + $exception, + "Moose::Exception::AddRoleToARoleTakesAMooseMetaRole", + "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role"); + + is( + $exception->role_name, + 'JustATestRole', + "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role"); + + is( + $exception->role_to_be_added, + "xyz", + "add_role to Moose::Meta::Role takes instances of Moose::Meta::Role"); +} + +{ + { + package Bar; + use Moose::Role; + } + + my $exception = exception { + Bar->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::RoleNameRequiredForMooseMetaRole', + "Cannot call does_role without a role name"); + + is( + $exception->role_name, + 'Bar', + "Cannot call does_role without a role name"); +} + +{ + { + package Bar; + use Moose::Role; + } + + my $exception = exception { + Bar->meta->apply("xyz"); + }; + + like( + $exception, + qr/You must pass in an blessed instance/, + "apply takes a blessed instance"); + + isa_ok( + $exception, + 'Moose::Exception::ApplyTakesABlessedInstance', + "apply takes a blessed instance"); + + is( + $exception->role_name, + 'Bar', + "apply takes a blessed instance"); + + is( + $exception->param, + 'xyz', + "apply takes a blessed instance"); +} + +{ + my $exception = exception { + Moose::Meta::Role->create("TestRole", ( 'attributes' => 'bar')); + }; + + like( + $exception, + qr/You must pass a HASH ref of attributes/, + "create takes a HashRef of attributes"); + + isa_ok( + $exception, + "Moose::Exception::CreateTakesHashRefOfAttributes", + "create takes a HashRef of attributes"); +} + +{ + my $exception = exception { + Moose::Meta::Role->create("TestRole", ( 'methods' => 'bar')); + }; + + like( + $exception, + qr/You must pass a HASH ref of methods/, + "create takes a HashRef of methods"); + + isa_ok( + $exception, + "Moose::Exception::CreateTakesHashRefOfMethods", + "create takes a HashRef of methods"); +} + +{ + my $exception = exception { + Moose::Meta::Role->create("TestRole", ('roles', 'bar')); + }; + + like( + $exception, + qr/You must pass an ARRAY ref of roles/, + "create takes an ArrayRef of roles"); + + isa_ok( + $exception, + "Moose::Exception::CreateTakesArrayRefOfRoles", + "create takes an ArrayRef of roles"); +} + +done_testing; diff --git a/t/exceptions/metaclass.t b/t/exceptions/metaclass.t new file mode 100644 index 0000000..5492df1 --- /dev/null +++ b/t/exceptions/metaclass.t @@ -0,0 +1,34 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + { + package Foo; + use Moose; + } + + my $exception = exception { + require metaclass; + metaclass->import( ("Foo") ); + }; + + like( + $exception, + qr/\QThe metaclass (Foo) must be derived from Class::MOP::Class/, + "Foo is not derived from Class::MOP::Class"); + + isa_ok( + $exception, + "Moose::Exception::MetaclassMustBeDerivedFromClassMOPClass", + "Foo is not derived from Class::MOP::Class"); + + is( + $exception->class_name, + 'Foo', + "Foo is not derived from Class::MOP::Class"); +} + +done_testing; diff --git a/t/exceptions/moose-exporter.t b/t/exceptions/moose-exporter.t new file mode 100644 index 0000000..7852176 --- /dev/null +++ b/t/exceptions/moose-exporter.t @@ -0,0 +1,119 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + my $exception = exception { + package MooseX::NoAlso; + use Moose (); + + Moose::Exporter->setup_import_methods( + also => ['NoSuchThing'] + ); + }; + + like( + $exception, + qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter (is it loaded?)/, + 'a package which does not use Moose::Exporter in also dies with an error'); + + isa_ok( + $exception, + 'Moose::Exception::PackageDoesNotUseMooseExporter', + 'a package which does not use Moose::Exporter in also dies with an error'); + + is( + $exception->package, + "NoSuchThing", + 'a package which does not use Moose::Exporter in also dies with an error'); +} + +{ + my $exception = exception { + { + package MooseX::CircularAlso; + use Moose; + + Moose::Exporter->setup_import_methods( + also => [ 'Moose', 'MooseX::CircularAlso' ], + ); + } + }; + + like( + $exception, + qr/\QCircular reference in 'also' parameter to Moose::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/, + 'a circular reference in also dies with an error'); + + isa_ok( + $exception, + 'Moose::Exception::CircularReferenceInAlso', + 'a circular reference in also dies with an error'); + + is( + $exception->also_parameter, + "MooseX::CircularAlso", + 'a circular reference in also dies with an error'); +} + +{ + { + package My::SimpleTrait; + use Moose::Role; + + sub simple { return 5 } + } + + use Moose::Util::TypeConstraints; + my $exception = exception { + Moose::Util::TypeConstraints->import( + -traits => 'My::SimpleTrait' ); + }; + + like( + $exception, + qr/\QCannot provide traits when Moose::Util::TypeConstraints does not have an init_meta() method/, + 'cannot provide -traits to an exporting module that does not init_meta'); + + isa_ok( + $exception, + "Moose::Exception::ClassDoesNotHaveInitMeta", + 'cannot provide -traits to an exporting module that does not init_meta'); + + is( + $exception->class_name, + "Moose::Util::TypeConstraints", + 'cannot provide -traits to an exporting module that does not init_meta'); +} + +{ + my $exception = exception { + { + package MooseX::BadTraits; + use Moose (); + + Moose::Exporter->setup_import_methods( + trait_aliases => [{hello => 1}] + ); + } + }; + + like( + $exception, + qr/HASH references are not valid arguments to the 'trait_aliases' option/, + "a HASH ref is given to trait_aliases"); + + isa_ok( + $exception, + "Moose::Exception::InvalidArgumentsToTraitAliases", + "a HASH ref is given to trait_aliases"); + + is( + $exception->package_name, + "MooseX::BadTraits", + "a HASH ref is given to trait_aliases"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-attribute-native-traits.t b/t/exceptions/moose-meta-attribute-native-traits.t new file mode 100644 index 0000000..64ba085 --- /dev/null +++ b/t/exceptions/moose-meta-attribute-native-traits.t @@ -0,0 +1,147 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose; + +{ + my $exception = exception { + { + package TestClass; + use Moose; + + has 'foo' => ( + traits => ['Array'], + is => 'ro', + isa => 'Int' + ); + } + }; + + like( + $exception, + qr/The type constraint for foo must be a subtype of ArrayRef but it's a Int/, + "isa is given as Int, but it should be ArrayRef"); + + isa_ok( + $exception, + 'Moose::Exception::WrongTypeConstraintGiven', + "isa is given as Int, but it should be ArrayRef"); + + is( + $exception->required_type, + "ArrayRef", + "isa is given as Int, but it should be ArrayRef"); + + is( + $exception->given_type, + "Int", + "isa is given as Int, but it should be ArrayRef"); + + is( + $exception->attribute_name, + "foo", + "isa is given as Int, but it should be ArrayRef"); +} + +{ + my $exception = exception { + { + package TestClass2; + use Moose; + + has 'foo' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef', + handles => 'bar' + ); + } + }; + + like( + $exception, + qr/The 'handles' option must be a HASH reference, not bar/, + "'bar' is given as handles"); + + isa_ok( + $exception, + 'Moose::Exception::HandlesMustBeAHashRef', + "'bar' is given as handles"); + + is( + $exception->given_handles, + "bar", + "'bar' is given as handles"); +} + +{ + my $exception = exception { + { + package TraitTest; + use Moose::Role; + with 'Moose::Meta::Attribute::Native::Trait'; + + sub _helper_type { "ArrayRef" } + } + + { + package TestClass3; + use Moose; + + has 'foo' => ( + traits => ['TraitTest'], + is => 'ro', + isa => 'ArrayRef', + handles => { get_count => 'count' } + ); + } + }; + + like( + $exception, + qr/\QCannot calculate native type for Moose::Meta::Class::__ANON__::SERIAL::/, + "cannot calculate native type for the given trait"); + + isa_ok( + $exception, + 'Moose::Exception::CannotCalculateNativeType', + "cannot calculate native type for the given trait"); +} + +{ + my $regex = qr/bar/; + my $exception = exception { + { + package TestClass4; + use Moose; + + has 'foo' => ( + traits => ['Array'], + is => 'ro', + isa => 'ArrayRef', + handles => { get_count => $regex } + ); + } + }; + + like( + $exception, + qr/\QAll values passed to handles must be strings or ARRAY references, not $regex/, + "a Regexp is given to handles"); + #All values passed to handles must be strings or ARRAY references, not (?^:bar) + + isa_ok( + $exception, + 'Moose::Exception::InvalidHandleValue', + "a Regexp is given to handles"); + + is( + $exception->handle_value, + $regex, + "a Regexp is given to handles"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-class-immutable-trait.t b/t/exceptions/moose-meta-class-immutable-trait.t new file mode 100644 index 0000000..c355240 --- /dev/null +++ b/t/exceptions/moose-meta-class-immutable-trait.t @@ -0,0 +1,29 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + package Foo; + use Moose; + + __PACKAGE__->meta->make_immutable; + Foo->meta->does_role; + }; + + like( + $exception, + qr/You must supply a role name to look for/, + "no role_name supplied to does_role"); + + isa_ok( + $exception, + "Moose::Exception::RoleNameRequired", + "no role_name supplied to does_role"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-array.t b/t/exceptions/moose-meta-method-accessor-native-array.t new file mode 100644 index 0000000..d923935 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-array.t @@ -0,0 +1,488 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'ArrayRef', + traits => ['Array'], + handles => { + get => 'get', + first => 'first', + first_index => 'first_index', + grep => 'grep', + join => 'join', + map => 'map', + natatime => 'natatime', + reduce => 'reduce', + sort => 'sort', + sort_in_place => 'sort_in_place', + splice => 'splice' + }, + required => 1 + ); +} + +my $foo_obj; + +{ + + my $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $exception = exception { + $foo_obj->get(1.1); + }; + + like( + $exception, + qr/The index passed to get must be an integer/, + "get takes integer argument"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "get takes integer argument"); + + is( + $exception->argument, + 1.1, + "get takes integer argument"); + + is( + $exception->method_name, + "get", + "get takes integer argument"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->first( $arg ); + }; + + like( + $exception, + qr/The argument passed to first must be a code reference/, + "an ArrayRef passed to first"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to first"); + + is( + $exception->method_name, + "first", + "an ArrayRef passed to first"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to first"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to first"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to first"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->first_index( $arg ); + }; + + like( + $exception, + qr/The argument passed to first_index must be a code reference/, + "an ArrayRef passed to first_index"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to first_index"); + + is( + $exception->method_name, + "first_index", + "an ArrayRef passed to first_index"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to first_index"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to first_index"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to first_index"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->grep( $arg ); + }; + + like( + $exception, + qr/The argument passed to grep must be a code reference/, + "an ArrayRef passed to grep"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to grep"); + + is( + $exception->method_name, + "grep", + "an ArrayRef passed to grep"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to grep"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to grep"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to grep"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->join( $arg ); + }; + + like( + $exception, + qr/The argument passed to join must be a string/, + "an ArrayRef passed to join"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to join"); + + is( + $exception->method_name, + "join", + "an ArrayRef passed to join"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to join"); + + is( + $exception->type_of_argument, + "string", + "an ArrayRef passed to join"); + + is( + $exception->type, + "Str", + "an ArrayRef passed to join"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->map( $arg ); + }; + + like( + $exception, + qr/The argument passed to map must be a code reference/, + "an ArrayRef passed to map"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to map"); + + is( + $exception->method_name, + "map", + "an ArrayRef passed to map"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to map"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to map"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to map"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->natatime( $arg ); + }; + + like( + $exception, + qr/The n value passed to natatime must be an integer/, + "an ArrayRef passed to natatime"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to natatime"); + + is( + $exception->method_name, + "natatime", + "an ArrayRef passed to natatime"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to natatime"); + + is( + $exception->type_of_argument, + "integer", + "an ArrayRef passed to natatime"); + + is( + $exception->type, + "Int", + "an ArrayRef passed to natatime"); + + $exception = exception { + $foo_obj->natatime( 1, $arg ); + }; + + like( + $exception, + qr/The second argument passed to natatime must be a code reference/, + "an ArrayRef passed to natatime"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to natatime"); + + is( + $exception->method_name, + "natatime", + "an ArrayRef passed to natatime"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to natatime"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to natatime"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to natatime"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->reduce( $arg ); + }; + + like( + $exception, + qr/The argument passed to reduce must be a code reference/, + "an ArrayRef passed to reduce"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to reduce"); + + is( + $exception->method_name, + "reduce", + "an ArrayRef passed to reduce"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to reduce"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to reduce"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to reduce"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->sort( $arg ); + }; + + like( + $exception, + qr/The argument passed to sort must be a code reference/, + "an ArrayRef passed to sort"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to sort"); + + is( + $exception->method_name, + "sort", + "an ArrayRef passed to sort"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to sort"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to sort"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to sort"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->sort_in_place( $arg ); + }; + + like( + $exception, + qr/The argument passed to sort_in_place must be a code reference/, + "an ArrayRef passed to sort_in_place"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to sort_in_place"); + + is( + $exception->method_name, + "sort_in_place", + "an ArrayRef passed to sort_in_place"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to sort_in_place"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to sort_in_place"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to sort_in_place"); +} + +{ + $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->splice( 1, $arg ); + }; + + like( + $exception, + qr/The length argument passed to splice must be an integer/, + "an ArrayRef passed to splice"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to splice"); + + is( + $exception->method_name, + "splice", + "an ArrayRef passed to splice"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to splice"); + + is( + $exception->type_of_argument, + "integer", + "an ArrayRef passed to splice"); + + is( + $exception->type, + "Int", + "an ArrayRef passed to splice"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-collection.t b/t/exceptions/moose-meta-method-accessor-native-collection.t new file mode 100644 index 0000000..00efb25 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-collection.t @@ -0,0 +1,53 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + package Bar; + use Moose; + + has 'foo' => ( + is => 'rw', + isa => 'ArrayRef[Int]', + traits => ['Array'], + handles => { push => 'push'} + ); +} + +my $bar_obj = Bar->new; +{ + my $exception = exception { + $bar_obj->push(1.2); + }; + + like( + $exception, + qr/A new member value for foo does not pass its type constraint because: Validation failed for 'Int' with value 1.2/, + "trying to push a Float(1.2) to ArrayRef[Int]"); + + isa_ok( + $exception, + 'Moose::Exception::ValidationFailedForInlineTypeConstraint', + "trying to push a Float(1.2) to ArrayRef[Int]"); + + is( + $exception->attribute_name, + "foo", + "trying to push a Float(1.2) to ArrayRef[Int]"); + + is( + $exception->class_name, + "Bar", + "trying to push a Float(1.2) to ArrayRef[Int]"); + + is( + $exception->value, + 1.2, + "trying to push a Float(1.2) to ArrayRef[Int]"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-grep.t b/t/exceptions/moose-meta-method-accessor-native-grep.t new file mode 100644 index 0000000..6f20cb4 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-grep.t @@ -0,0 +1,63 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'ArrayRef', + traits => ['Array'], + handles => { + grep => 'grep' + }, + required => 1 + ); + } + + my $foo_obj = Foo->new( foo => [1, 2, 3] ); + my $arg = [12]; + + my $exception = exception { + $foo_obj->grep( $arg ); + }; + + like( + $exception, + qr/The argument passed to grep must be a code reference/, + "an ArrayRef passed to grep"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an ArrayRef passed to grep"); + + is( + $exception->method_name, + "grep", + "an ArrayRef passed to grep"); + + is( + $exception->argument, + $arg, + "an ArrayRef passed to grep"); + + is( + $exception->type_of_argument, + "code reference", + "an ArrayRef passed to grep"); + + is( + $exception->type, + "CodeRef", + "an ArrayRef passed to grep"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-hash-set.t b/t/exceptions/moose-meta-method-accessor-native-hash-set.t new file mode 100644 index 0000000..46f82cf --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-hash-set.t @@ -0,0 +1,70 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'HashRef', + traits => ['Hash'], + handles => { + set => 'set', + }, + required => 1 + ); + } +} + +my $foo_obj = Foo->new( foo => { 1 => "one"} ); + +{ + my $exception = exception { + $foo_obj->set(1 => "foo", "bar"); + }; + + like( + $exception, + qr/You must pass an even number of arguments to set/, + "odd number of arguments passed to set"); + + isa_ok( + $exception, + 'Moose::Exception::MustPassEvenNumberOfArguments', + "odd number of arguments passed to set"); + + is( + $exception->method_name, + "set", + "odd number of arguments passed to set"); +} + +{ + my $exception = exception { + $foo_obj->set(undef, "foo"); + }; + + like( + $exception, + qr/Hash keys passed to set must be defined/, + "undef is passed to set"); + + isa_ok( + $exception, + 'Moose::Exception::UndefinedHashKeysPassedToMethod', + "undef is passed to set"); + + is( + $exception->method_name, + "set", + "undef is passed to set"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-hash.t b/t/exceptions/moose-meta-method-accessor-native-hash.t new file mode 100644 index 0000000..26105cb --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-hash.t @@ -0,0 +1,63 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'HashRef', + traits => ['Hash'], + handles => { + exists => 'exists' + }, + required => 1 + ); + } + + my $foo_obj = Foo->new( foo => { 1 => "one"} ); + my $arg = undef; + + my $exception = exception { + $foo_obj->exists( undef ); + }; + + like( + $exception, + qr/The key passed to exists must be a defined value/, + "an undef is passed to exists"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an undef is passed to exists"); + + is( + $exception->method_name, + "exists", + "an undef is passed to exists"); + + is( + $exception->argument, + $arg, + "an undef is passed to exists"); + + is( + $exception->type_of_argument, + "defined value", + "an undef is passed to exists"); + + is( + $exception->type, + "Defined", + "an undef is passed to exists"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-string-match.t b/t/exceptions/moose-meta-method-accessor-native-string-match.t new file mode 100644 index 0000000..9ec9ce8 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-string-match.t @@ -0,0 +1,63 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + traits => ['String'], + handles => { + match => 'match' + }, + required => 1 + ); +} + +my $foo_obj = Foo->new( foo => 'hello' ); + +{ + my $arg = [12]; + my $exception = exception { + $foo_obj->match( $arg ); + }; + + like( + $exception, + qr/The argument passed to match must be a string or regexp reference/, + "an Array Ref passed to match"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an Array Ref passed to match"); + + is( + $exception->argument, + $arg, + "an Array Ref passed to match"); + + is( + $exception->type_of_argument, + "string or regexp reference", + "an Array Ref passed to match"); + + is( + $exception->method_name, + "match", + "an Array Ref passed to match"); + + is( + $exception->type, + "Str|RegexpRef", + "an Array Ref passed to match"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-string-replace.t b/t/exceptions/moose-meta-method-accessor-native-string-replace.t new file mode 100644 index 0000000..2ae1cb1 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-string-replace.t @@ -0,0 +1,110 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + traits => ['String'], + handles => { + replace => 'replace' + }, + required => 1 + ); +} + +my $foo_obj = Foo->new( foo => 'hello' ); + +{ + my $arg = [123]; + my $exception = exception { + $foo_obj->replace($arg); + }; + + like( + $exception, + qr/The first argument passed to replace must be a string or regexp reference/, + "an Array ref passed to replace"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an Array ref passed to replace"); + + is( + $exception->argument, + $arg, + "an Array ref passed to replace"); + + is( + $exception->ordinal, + "first", + "an Array ref passed to replace"); + + is( + $exception->type_of_argument, + "string or regexp reference", + "an Array ref passed to replace"); + + is( + $exception->method_name, + "replace", + "an Array ref passed to replace"); + + is( + $exception->type, + "Str|RegexpRef", + "an Array ref passed to replace"); +} + +{ + my $arg = [123]; + my $exception = exception { + $foo_obj->replace('h', $arg); + }; + + like( + $exception, + qr/The second argument passed to replace must be a string or code reference/, + "an Array ref passed to replace"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "an Array ref passed to replace"); + + is( + $exception->argument, + $arg, + "an Array ref passed to replace"); + + is( + $exception->ordinal, + "second", + "an Array ref passed to replace"); + + is( + $exception->type_of_argument, + "string or code reference", + "an Array ref passed to replace"); + + is( + $exception->method_name, + "replace", + "an Array ref passed to replace"); + + is( + $exception->type, + "Str|CodeRef", + "an Array ref passed to replace"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native-string-substr.t b/t/exceptions/moose-meta-method-accessor-native-string-substr.t new file mode 100644 index 0000000..38c9fdf --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native-string-substr.t @@ -0,0 +1,150 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + traits => ['String'], + handles => { + substr => 'substr' + }, + required => 1 + ); +} + +my $foo_obj = Foo->new( foo => 'hello' ); + +{ + my $exception = exception { + $foo_obj->substr(1.1); + }; + + like( + $exception, + qr/The first argument passed to substr must be an integer/, + "substr takes integer as its first argument"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "substr takes integer as its first argument"); + + is( + $exception->argument, + 1.1, + "substr takes integer as its first argument"); + + is( + $exception->ordinal, + "first", + "substr takes integer as its first argument"); + + is( + $exception->type_of_argument, + "integer", + "substr takes integer as its first argument"); + + is( + $exception->method_name, + "substr", + "substr takes integer as its first argument"); + + is( + $exception->type, + "Int", + "substr takes integer as its first argument"); +} + +{ + my $exception = exception { + $foo_obj->substr(1, 1.2); + }; + + like( + $exception, + qr/The second argument passed to substr must be an integer/, + "substr takes integer as its second argument"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "substr takes integer as its second argument"); + + is( + $exception->argument, + 1.2, + "substr takes integer as its second argument"); + + is( + $exception->ordinal, + "second", + "substr takes integer as its second argument"); + + is( + $exception->type_of_argument, + "integer", + "substr takes integer as its second argument"); + + is( + $exception->method_name, + "substr", + "substr takes integer as its second argument"); + + is( + $exception->type, + "Int", + "substr takes integer as its second argument"); +} + +{ + my $arg = [122]; + my $exception = exception { + $foo_obj->substr(1, 2, $arg); + }; + + like( + $exception, + qr/The third argument passed to substr must be a string/, + "substr takes string as its third argument"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgumentToMethod', + "substr takes string as its third argument"); + + is( + $exception->argument, + $arg, + "substr takes string as its third argument"); + + is( + $exception->ordinal, + "third", + "substr takes string as its third argument"); + + is( + $exception->type_of_argument, + "string", + "substr takes string as its third argument"); + + is( + $exception->method_name, + "substr", + "substr takes string as its third argument"); + + is( + $exception->type, + "Str", + "substr takes string as its third argument"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor-native.t b/t/exceptions/moose-meta-method-accessor-native.t new file mode 100644 index 0000000..4afc1af --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor-native.t @@ -0,0 +1,138 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + traits => ['String'], + handles => { + substr => 'substr', + }, + required => 1 + ); + } + + my $foo_obj = Foo->new( foo => 'hello' ); + + my $exception = exception { + $foo_obj->substr(1,2,3,3); + }; + + like( + $exception, + qr/Cannot call substr with more than 3 arguments/, + "substr doesn't take 4 arguments"); + + isa_ok( + $exception, + 'Moose::Exception::MethodExpectsFewerArgs', + "substr doesn't take 4 arguments"); + + is( + $exception->method_name, + "substr", + "substr doesn't take 4 arguments"); + + is( + $exception->maximum_args, + 3, + "substr doesn't take 4 arguments"); +} + +{ + { + package Bar; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Str', + traits => ['String'], + handles => { + substr => 'substr', + }, + required => 1 + ); + } + + my $foo_obj = Bar->new( foo => 'hello' ); + + my $exception = exception { + $foo_obj->substr; + }; + + like( + $exception, + qr/Cannot call substr without at least 1 argument/, + "substr expects atleast 1 argument"); + + isa_ok( + $exception, + 'Moose::Exception::MethodExpectsMoreArgs', + "substr expects atleast 1 argument"); + + is( + $exception->method_name, + "substr", + "substr expects atleast 1 argument"); + + is( + $exception->minimum_args, + 1, + "substr expects atleast 1 argument"); +} + +{ + { + package Bar2; + use Moose; + with 'Moose::Meta::Method::Accessor::Native::Reader'; + + sub _return_value { + return 1; + } + + sub _get_value { + return 1 + } + + sub _inline_store_value { + return 1; + } + + sub _eval_environment { + return 1; + } + } + + my $exception = exception { + Bar2->new( curried_arguments => 'xyz' ); + }; + + like( + $exception, + qr/You must supply a curried_arguments which is an ARRAY reference/, + "curried arguments is 'xyz'"); + + isa_ok( + $exception, + 'Moose::Exception::MustSupplyArrayRefAsCurriedArguments', + "curried arguments is 'xyz'"); + + is( + $exception->class_name, + "Bar2", + "curried arguments is 'xyz'"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-accessor.t b/t/exceptions/moose-meta-method-accessor.t new file mode 100644 index 0000000..f42f4d2 --- /dev/null +++ b/t/exceptions/moose-meta-method-accessor.t @@ -0,0 +1,55 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo; + use Moose; + extends 'Moose::Meta::Method::Accessor'; + } + + my $attr = Class::MOP::Attribute->new("bar"); + Foo->meta->add_attribute($attr); + + my $foo; + my $exception = exception { + $foo = Foo->new( name => "new", + package_name => "Foo", + is_inline => 1, + attribute => $attr, + accessor_type => "writer" + ); + }; + + like( + $exception, + qr/\QCould not generate inline writer because : Could not create writer for 'bar' because Can't locate object method "_eval_environment" via package "Class::MOP::Attribute"/, + "cannot generate writer"); + + isa_ok( + $exception->error, + "Moose::Exception::CouldNotCreateWriter", + "cannot generate writer"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotGenerateInlineAttributeMethod", + "cannot generate writer"); + + is( + $exception->error->attribute_name, + 'bar', + "cannot generate writer"); + + is( + ref($exception->error->instance), + "Foo", + "cannot generate writer"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-augmented.t b/t/exceptions/moose-meta-method-augmented.t new file mode 100644 index 0000000..c9d9677 --- /dev/null +++ b/t/exceptions/moose-meta-method-augmented.t @@ -0,0 +1,33 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + package Foo; + use Moose; + + augment 'foo' => sub {}; + }; + + like( + $exception, + qr/You cannot augment 'foo' because it has no super method/, + "'Foo' has no super class"); + + isa_ok( + $exception, + "Moose::Exception::CannotAugmentNoSuperMethod", + "'Foo' has no super class"); + + is( + $exception->method_name, + 'foo', + "'Foo' has no super class"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-constructor.t b/t/exceptions/moose-meta-method-constructor.t new file mode 100644 index 0000000..1780fda --- /dev/null +++ b/t/exceptions/moose-meta-method-constructor.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $method = Moose::Meta::Method::Constructor->new( options => (1,2,3)); + }; + + like( + $exception, + qr/You must pass a hash of options/, + "options is not a HASH ref"); + + isa_ok( + $exception, + "Moose::Exception::MustPassAHashOfOptions", + "options is not a HASH ref"); +} + +{ + my $exception = exception { + my $method = Moose::Meta::Method::Constructor->new( options => {}); + }; + + like( + $exception, + qr/You must supply the package_name and name parameters/, + "package_name and name are not given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyPackageNameAndName", + "package_name and name are not given"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-delegation.t b/t/exceptions/moose-meta-method-delegation.t new file mode 100644 index 0000000..5da32e7 --- /dev/null +++ b/t/exceptions/moose-meta-method-delegation.t @@ -0,0 +1,173 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Moose::Meta::Method::Delegation->new; + }; + + like( + $exception, + qr/You must supply an attribute to construct with/, + "no attribute is given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAnAttributeToConstructWith", + "no attribute is given"); +} + +{ + my $exception = exception { + Moose::Meta::Method::Delegation->new( attribute => "foo" ); + }; + + like( + $exception, + qr/\QYou must supply an attribute which is a 'Moose::Meta::Attribute' instance/, + "attribute is not an instance of Moose::Meta::Attribute"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyAMooseMetaAttributeInstance", + "attribute is not an instance of Moose::Meta::Attribute"); +} + +{ + my $attr = Moose::Meta::Attribute->new("foo"); + my $exception = exception { + Moose::Meta::Method::Delegation->new( attribute => $attr ); + }; + + like( + $exception, + qr/You must supply the package_name and name parameters/, + "package_name and name are not given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyPackageNameAndName", + "package_name and name are not given"); +} + +{ + my $attr = Moose::Meta::Attribute->new("foo"); + my $exception = exception { + Moose::Meta::Method::Delegation->new( attribute => $attr, package_name => "Foo", name => "Foo" ); + }; + + like( + $exception, + qr/You must supply a delegate_to_method which is a method name or a CODE reference/, + "delegate_to_method is not given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyADelegateToMethod", + "delegate_to_method is not given"); +} + +{ + my $attr = Moose::Meta::Attribute->new("foo"); + my $exception = exception { + Moose::Meta::Method::Delegation->new( attribute => $attr, + package_name => "Foo", + name => "Foo", + delegate_to_method => sub {}, + curried_arguments => {} ); + }; + + like( + $exception, + qr/You must supply a curried_arguments which is an ARRAY reference/, + "curried_arguments not given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyArrayRefAsCurriedArguments", + "curried_arguments not given"); +} + +{ + { + package BadClass; + use Moose; + + has 'foo' => ( + is => 'ro', + handles => { get_count => 'count' } + ); + } + + my $object = BadClass->new; + + my $exception = exception { + $object->get_count; + }; + + like( + $exception, + qr/Cannot delegate get_count to count because the value of foo is not defined/, + "foo is not set"); + + isa_ok( + $exception, + "Moose::Exception::AttributeValueIsNotDefined", + "foo is not set"); + + is( + $exception->instance, + $object, + "foo is not set"); + + is( + $exception->attribute->name, + "foo", + "foo is not set"); +} + +{ + { + package BadClass2; + use Moose; + + has 'foo' => ( + is => 'ro', + handles => { get_count => 'count' } + ); + } + + my $array = [12]; + my $object = BadClass2->new( foo => $array ); + my $exception = exception { + $object->get_count; + }; + + like( + $exception, + qr/\QCannot delegate get_count to count because the value of foo is not an object (got '$array')/, + "value of foo is an ARRAY ref"); + #Cannot delegate get_count to count because the value of foo is not an object (got 'ARRAY(0x223f578)') + + isa_ok( + $exception, + "Moose::Exception::AttributeValueIsNotAnObject", + "value of foo is an ARRAY ref"); + + is( + $exception->given_value, + $array, + "value of foo is an ARRAY ref"); + + is( + $exception->attribute->name, + "foo", + "value of foo is an ARRAY ref"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-destructor.t b/t/exceptions/moose-meta-method-destructor.t new file mode 100644 index 0000000..6e72061 --- /dev/null +++ b/t/exceptions/moose-meta-method-destructor.t @@ -0,0 +1,94 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $method = Moose::Meta::Method::Destructor->new( options => (1,2,3)); + }; + + like( + $exception, + qr/You must pass a hash of options/, + "options is not a HASH ref"); + + isa_ok( + $exception, + "Moose::Exception::MustPassAHashOfOptions", + "options is not a HASH ref"); +} + +{ + my $exception = exception { + my $method = Moose::Meta::Method::Destructor->new( options => {}); + }; + + like( + $exception, + qr/You must supply the package_name and name parameters/, + "package_name and name are not given"); + + isa_ok( + $exception, + "Moose::Exception::MustSupplyPackageNameAndName", + "package_name and name are not given"); +} + +{ + my $exception = exception { + my $method = Moose::Meta::Method::Destructor->is_needed("foo"); + }; + + like( + $exception, + qr/The is_needed method expected a metaclass object as its arugment/, + "'foo' is not a metaclass"); + + isa_ok( + $exception, + "Moose::Exception::MethodExpectedAMetaclassObject", + "'foo' is not a metaclass"); + + is( + $exception->metaclass, + 'foo', + "'foo' is not a metaclass"); +} + +{ + { + package TestClass; + use Moose; + } + + { + package SubClassDestructor; + use Moose; + extends 'Moose::Meta::Method::Destructor'; + + sub _generate_DEMOLISHALL { + return "print 'xyz"; # this is an intentional syntax error + } + } + + my $methodDestructor; + my $exception = exception { + $methodDestructor = SubClassDestructor->new( name => "xyz", package_name => "Xyz", options => {}, metaclass => TestClass->meta); + }; + + like( + $exception, + qr/Could not eval the destructor/, + "syntax error in the return value of _generate_DEMOLISHALL"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotEvalDestructor", + "syntax error in the return value of _generate_DEMOLISHALL"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-method-overridden.t b/t/exceptions/moose-meta-method-overridden.t new file mode 100644 index 0000000..a0831d6 --- /dev/null +++ b/t/exceptions/moose-meta-method-overridden.t @@ -0,0 +1,36 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + my $exception = exception { + package Foo; + use Moose; + + override foo => sub {} + }; + + like( + $exception, + qr/You cannot override 'foo' because it has no super method/, + "Foo class is not extending any class"); + + isa_ok( + $exception, + "Moose::Exception::CannotOverrideNoSuperMethod", + "Foo class is not extending any class"); + + is( + $exception->class, + "Moose::Meta::Method::Overridden", + "Foo class is not extending any class"); + + is( + $exception->method_name, + "foo", + "Foo class is not extending any class"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-application-rolesummation.t b/t/exceptions/moose-meta-role-application-rolesummation.t new file mode 100644 index 0000000..faa56c5 --- /dev/null +++ b/t/exceptions/moose-meta-role-application-rolesummation.t @@ -0,0 +1,215 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + { + package Foo1; + use Moose::Role; + excludes 'Bar1'; + } + + { + package Bar1; + use Moose::Role; + } + + my $exception = exception { + package CompositeRole; + use Moose::Role; + with 'Foo1', 'Bar1'; + }; + + like( + $exception, + qr/\QConflict detected: Role Foo1 excludes role 'Bar1'/, + "role Foo1 excludes role Bar1"); + + isa_ok( + $exception, + "Moose::Exception::RoleExclusionConflict", + "role Foo1 excludes role Bar1"); + + is( + $exception->role_name, + "Bar1", + "role Foo1 excludes role Bar1"); + + is_deeply( + $exception->roles, + ["Foo1"], + "role Foo1 excludes role Bar1"); + + { + package Baz1; + use Moose::Role; + excludes 'Bar1'; + } + + $exception = exception { + package CompositeRole1; + use Moose::Role; + with 'Foo1', 'Bar1', 'Baz1'; + }; + + like( + $exception, + qr/\QConflict detected: Roles Foo1, Baz1 exclude role 'Bar1'/, + "role Foo1 & Baz1 exclude role Bar1"); + + isa_ok( + $exception, + "Moose::Exception::RoleExclusionConflict", + "role Foo1 & Baz1 exclude role Bar1"); + + is( + $exception->role_name, + "Bar1", + "role Foo1 & Baz1 exclude role Bar1"); + + is_deeply( + $exception->roles, + ["Foo1", 'Baz1'], + "role Foo1 & Baz1 exclude role Bar1"); +} + +{ + { + package Foo2; + use Moose::Role; + + has 'foo' => ( isa => 'Int' ); + } + + { + package Bar2; + use Moose::Role; + + has 'foo' => ( isa => 'Int' ); + } + + my $exception = exception { + package CompositeRole2; + use Moose::Role; + with 'Foo2', 'Bar2'; + }; + + like( + $exception, + qr/\QWe have encountered an attribute conflict with 'foo' during role composition. This attribute is defined in both Foo2 and Bar2. This is a fatal error and cannot be disambiguated./, + "role Foo2 & Bar2, both have an attribute named foo"); + + isa_ok( + $exception, + "Moose::Exception::AttributeConflictInSummation", + "role Foo2 & Bar2, both have an attribute named foo"); + + is( + $exception->role_name, + "Foo2", + "role Foo2 & Bar2, both have an attribute named foo"); + + is( + $exception->second_role_name, + "Bar2", + "role Foo2 & Bar2, both have an attribute named foo"); + + is( + $exception->attribute_name, + "foo", + "role Foo2 & Bar2, both have an attribute named foo"); +} + +{ + { + package Foo3; + use Moose::Role; + + sub foo {} + } + + { + package Bar3; + use Moose::Role; + + override 'foo' => sub {} + } + + my $exception = exception { + package CompositeRole3; + use Moose::Role; + with 'Foo3', 'Bar3'; + }; + + like( + $exception, + qr/\QRole 'Foo3|Bar3' has encountered an 'override' method conflict during composition (A local method of the same name has been found). This is a fatal error./, + "role Foo3 has a local method 'foo' & role Bar3 is overriding that same method"); + + isa_ok( + $exception, + "Moose::Exception::OverrideConflictInSummation", + "role Foo3 has a local method 'foo' & role Bar3 is overriding that same method"); + + my @role_names = $exception->role_names; + my $role_names = join "|", @role_names; + is( + $role_names, + "Foo3|Bar3", + "role Foo3 has a local method 'foo' & role Bar3 is overriding that same method"); + + is( + $exception->method_name, + "foo", + "role Foo3 has a local method 'foo' & role Bar3 is overriding that same method"); +} + +{ + { + package Foo4; + use Moose::Role; + + override 'foo' => sub {}; + } + + { + package Bar4; + use Moose::Role; + + override 'foo' => sub {}; + } + + my $exception = exception { + package CompositeRole4; + use Moose::Role; + with 'Foo4', 'Bar4'; + }; + + like( + $exception, + qr/\QWe have encountered an 'override' method conflict during composition (Two 'override' methods of the same name encountered). This is a fatal error./, + "role Foo4 & Bar4, both are overriding the same method 'foo'"); + + isa_ok( + $exception, + "Moose::Exception::OverrideConflictInSummation", + "role Foo4 & Bar4, both are overriding the same method 'foo'"); + + my @role_names = $exception->role_names; + my $role_names = join "|", @role_names; + is( + $role_names, + "Foo4|Bar4", + "role Foo4 & Bar4, both are overriding the same method 'foo'"); + + is( + $exception->method_name, + "foo", + "role Foo4 & Bar4, both are overriding the same method 'foo'"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-application-toclass.t b/t/exceptions/moose-meta-role-application-toclass.t new file mode 100644 index 0000000..2a32e38 --- /dev/null +++ b/t/exceptions/moose-meta-role-application-toclass.t @@ -0,0 +1,432 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +use Moose::Util 'find_meta'; + +{ + { + package BarRole; + use Moose::Role; + } + + { + package RoleExcludingBarRole; + use Moose::Role; + excludes 'BarRole'; + } + + my $exception = exception { + { + package FooClass; + use Moose; + + with 'RoleExcludingBarRole'; + with 'BarRole'; + } + }; + + like( + $exception, + qr/\QConflict detected: FooClass excludes role 'BarRole'/, + 'class FooClass excludes Role BarRole'); + + isa_ok( + $exception, + "Moose::Exception::ConflictDetectedInCheckRoleExclusionsInToClass", + 'class FooClass excludes Role BarRole'); + + is( + $exception->class_name, + "FooClass", + 'class FooClass excludes Role BarRole'); + + is( + find_meta($exception->class_name), + FooClass->meta, + 'class FooClass excludes Role BarRole'); + + is( + $exception->role_name, + "BarRole", + 'class FooClass excludes Role BarRole'); + + is( + find_meta($exception->role_name), + BarRole->meta, + 'class FooClass excludes Role BarRole'); +} + +{ + { + package BarRole2; + use Moose::Role; + excludes 'ExcludedRole2'; + } + + { + package ExcludedRole2; + use Moose::Role; + } + + my $exception = exception { + { + package FooClass2; + use Moose; + + with 'ExcludedRole2'; + with 'BarRole2'; + } + }; + + like( + $exception, + qr/\QThe class FooClass2 does the excluded role 'ExcludedRole2'/, + 'Class FooClass2 does Role ExcludedRole2'); + + isa_ok( + $exception, + "Moose::Exception::ClassDoesTheExcludedRole", + 'Class FooClass2 does Role ExcludedRole2'); + + is( + $exception->role_name, + "BarRole2", + 'Class FooClass2 does Role ExcludedRole2'); + + is( + find_meta($exception->role_name), + BarRole2->meta, + 'Class FooClass2 does Role ExcludedRole2'); + + is( + $exception->excluded_role_name, + "ExcludedRole2", + 'Class FooClass2 does Role ExcludedRole2'); + + is( + find_meta($exception->excluded_role_name), + ExcludedRole2->meta, + 'Class FooClass2 does Role ExcludedRole2'); + + is( + $exception->class_name, + "FooClass2", + 'Class FooClass2 does Role ExcludedRole2'); + + is( + find_meta($exception->class_name), + FooClass2->meta, + 'Class FooClass2 does Role ExcludedRole2'); +} + +{ + { + package Foo5; + use Moose::Role; + + sub foo5 { "foo" } + } + + my $exception = exception { + { + package Bar5; + use Moose; + with 'Foo5' => { + -alias => { foo5 => 'foo_in_bar' } + }; + + sub foo_in_bar { "test in foo" } + } + }; + + like( + $exception, + qr/\QCannot create a method alias if a local method of the same name exists/, + "Class Bar5 already has a method named foo_in_bar"); + + isa_ok( + $exception, + "Moose::Exception::CannotCreateMethodAliasLocalMethodIsPresentInClass", + "Class Bar5 already has a method named foo_in_bar"); + + is( + $exception->role_name, + "Foo5", + "Class Bar5 already has a method named foo_in_bar"); + + is( + find_meta($exception->role_name), + Foo5->meta, + "Class Bar5 already has a method named foo_in_bar"); + + is( + $exception->class_name, + "Bar5", + "Class Bar5 already has a method named foo_in_bar"); + + is( + find_meta($exception->class_name), + Bar5->meta, + "Class Bar5 already has a method named foo_in_bar"); + + is( + $exception->aliased_method_name, + "foo_in_bar", + "Class Bar5 already has a method named foo_in_bar"); + + is( + $exception->method->name, + "foo5", + "Class Bar5 already has a method named foo_in_bar"); +} + +{ + { + package Foo::Role; + use Moose::Role; + + sub foo { 'Foo::Role::foo' } + } + + { + package Bar::Role; + use Moose::Role; + + sub foo { 'Bar::Role::foo' } + } + + { + package Baz::Role; + use Moose::Role; + + sub foo { 'Baz::Role::foo' } + } + + my $exception = exception { + { + package My::Foo::Class::Broken; + use Moose; + + with 'Foo::Role', + 'Bar::Role', + 'Baz::Role' => { -excludes => 'foo' }; + } + }; + + like( + $exception, + qr/\QDue to a method name conflict in roles 'Bar::Role' and 'Foo::Role', the method 'foo' must be implemented or excluded by 'My::Foo::Class::Broken'/, + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); + + isa_ok( + $exception, + "Moose::Exception::MethodNameConflictInRoles", + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); + + is( + $exception->class_name, + "My::Foo::Class::Broken", + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); + + is( + find_meta($exception->class_name), + My::Foo::Class::Broken->meta, + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); + + is( + $exception->get_method_at(0)->name, + "foo", + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); + + is( + $exception->get_method_at(0)->roles_as_english_list, + "'Bar::Role' and 'Foo::Role'", + 'Foo::Role, Bar::Role & Baz::Role, all three has a method named foo'); +} + +{ + { + package Foo2::Role; + use Moose::Role; + + sub foo { 'Foo2::Role::foo' } + sub bar { 'Foo2::Role::bar' } + } + + { + package Bar2::Role; + use Moose::Role; + + sub foo { 'Bar2::Role::foo' } + sub bar { 'Bar2::Role::bar' } + } + + { + package Baz2::Role; + use Moose::Role; + + sub foo { 'Baz2::Role::foo' } + sub bar { 'Baz2::Role::bar' } + } + + my $exception = exception { + { + package My::Foo::Class::Broken2; + use Moose; + + with 'Foo2::Role', + 'Bar2::Role', + 'Baz2::Role'; + } + }; + + like( + $exception, + qr/\QDue to method name conflicts in roles 'Bar2::Role' and 'Foo2::Role', the methods 'bar' and 'foo' must be implemented or excluded by 'My::Foo::Class::Broken2'/, + 'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar'); + + isa_ok( + $exception, + "Moose::Exception::MethodNameConflictInRoles", + 'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar'); + + is( + $exception->class_name, + "My::Foo::Class::Broken2", + 'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar'); + + is( + find_meta($exception->class_name), + My::Foo::Class::Broken2->meta, + 'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar'); + + is( + $exception->get_method_at(0)->roles_as_english_list, + "'Bar2::Role' and 'Foo2::Role'", + 'Foo2::Role, Bar2::Role & Baz2::Role, all three has a methods named foo & bar'); +} + +{ + { + package Foo3::Role; + use Moose::Role; + requires 'foo'; + } + + { + package Bar3::Role; + use Moose::Role; + } + + { + package Baz3::Role; + use Moose::Role; + } + + my $exception = exception { + { + package My::Foo::Class::Broken3; + use Moose; + with 'Foo3::Role', + 'Bar3::Role', + 'Baz3::Role'; + } + }; + + like( + $exception, + qr/\Q'Foo3::Role|Bar3::Role|Baz3::Role' requires the method 'foo' to be implemented by 'My::Foo::Class::Broken3'/, + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); + + isa_ok( + $exception, + "Moose::Exception::RequiredMethodsNotImplementedByClass", + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); + + is( + $exception->class_name, + "My::Foo::Class::Broken3", + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); + + is( + find_meta($exception->class_name), + My::Foo::Class::Broken3->meta, + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); + + is( + $exception->role_name, + 'Foo3::Role|Bar3::Role|Baz3::Role', + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); + + is( + $exception->get_method_at(0)->name, + "foo", + "foo is required by Foo3::Role, but it's not implemented by My::Foo::Class::Broken3"); +} + +{ + BEGIN { + package ExportsFoo; + use Sub::Exporter -setup => { + exports => ['foo'], + }; + + sub foo { 'FOO' } + + $INC{'ExportsFoo.pm'} = 1; + } + + { + package Foo4::Role; + use Moose::Role; + requires 'foo'; + } + + my $exception = exception { + { + package Class; + use Moose; + use ExportsFoo 'foo'; + with 'Foo4::Role'; + } + }; + + my $methodName = "\\&foo"; + + like( + $exception, + qr/\Q'Foo4::Role' requires the method 'foo' to be implemented by 'Class'. If you imported functions intending to use them as methods, you need to explicitly mark them as such, via Class->meta->add_method(foo => $methodName)/, + "foo is required by Foo4::Role and imported by Class"); + + isa_ok( + $exception, + "Moose::Exception::RequiredMethodsImportedByClass", + "foo is required by Foo4::Role and imported by Class"); + + is( + $exception->class_name, + "Class", + "foo is required by Foo4::Role and imported by Class"); + + is( + find_meta($exception->class_name), + Class->meta, + "foo is required by Foo4::Role and imported by Class"); + + is( + $exception->role_name, + 'Foo4::Role', + "foo is required by Foo4::Role and imported by Class"); + + is( + $exception->get_method_at(0)->name, + "foo", + "foo is required by Foo4::Role and imported by Class"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-application-torole.t b/t/exceptions/moose-meta-role-application-torole.t new file mode 100644 index 0000000..cd827f4 --- /dev/null +++ b/t/exceptions/moose-meta-role-application-torole.t @@ -0,0 +1,350 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util 'find_meta'; + +use Moose(); + +{ + { + package Foo; + use Moose::Role; + excludes 'Bar'; + } + + { + package Bar; + use Moose::Role; + } + + my $exception = exception { + Moose::Meta::Role::Application::ToRole->check_role_exclusions( Bar->meta, Foo->meta ); + }; + + like( + $exception, + qr/\QConflict detected: Foo excludes role 'Bar'/, + 'Role Foo excludes Role Bar'); + + isa_ok( + $exception, + "Moose::Exception::ConflictDetectedInCheckRoleExclusions", + 'Role Foo excludes Role Bar'); + + is( + $exception->role_name, + "Foo", + 'Role Foo excludes Role Bar'); + + is( + find_meta($exception->role_name), + Foo->meta, + 'Role Foo excludes Role Bar'); + + is( + $exception->excluded_role_name, + "Bar", + 'Role Foo excludes Role Bar'); + + is( + find_meta($exception->excluded_role_name), + Bar->meta, + 'Role Foo excludes Role Bar'); +} + +{ + { + package Foo2; + use Moose::Role; + excludes 'Bar3'; + } + + { + package Bar2; + use Moose::Role; + with 'Bar3'; + } + + { + package Bar3; + use Moose::Role; + } + + my $exception = exception { + Moose::Meta::Role::Application::ToRole->check_role_exclusions( Foo2->meta, Bar2->meta ); + }; + + like( + $exception, + qr/\QThe role Bar2 does the excluded role 'Bar3'/, + 'Role Bar2 does Role Bar3'); + + isa_ok( + $exception, + "Moose::Exception::RoleDoesTheExcludedRole", + 'Role Bar2 does Role Bar3'); + + is( + $exception->second_role_name, + "Foo2", + 'Role Bar2 does Role Bar3'); + + is( + find_meta($exception->second_role_name), + Foo2->meta, + 'Role Bar2 does Role Bar3'); + + is( + $exception->excluded_role_name, + "Bar3", + 'Role Bar2 does Role Bar3'); + + is( + find_meta($exception->excluded_role_name), + Bar3->meta, + 'Role Bar2 does Role Bar3'); + + is( + $exception->role_name, + "Bar2", + 'Role Bar2 does Role Bar3'); + + is( + find_meta($exception->role_name), + Bar2->meta, + 'Role Bar2 does Role Bar3'); +} + +{ + { + package Foo4; + use Moose::Role; + + has 'foo' => ( + is => 'ro', + isa => 'Int' + ); + } + + { + package Bar4; + use Moose::Role; + + has 'foo' => ( + is => 'ro', + isa => 'Int' + ); + } + + my $exception = exception { + Moose::Meta::Role::Application::ToRole->apply_attributes( Foo4->meta, Bar4->meta ); + }; + + like( + $exception, + qr/\QRole 'Foo4' has encountered an attribute conflict while being composed into 'Bar4'. This is a fatal error and cannot be disambiguated. The conflicting attribute is named 'foo'./, + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + isa_ok( + $exception, + "Moose::Exception::AttributeConflictInRoles", + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + is( + $exception->role_name, + "Foo4", + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + is( + find_meta($exception->role_name), + Foo4->meta, + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + is( + $exception->second_role_name, + "Bar4", + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + is( + find_meta($exception->second_role_name), + Bar4->meta, + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); + + is( + $exception->attribute_name, + 'foo', + 'Role Foo4 & Role Bar4 has one common attribute named "foo"'); +} + +{ + { + package Foo5; + use Moose::Role; + + sub foo5 { "foo" } + } + + my $exception = exception { + { + package Bar5; + use Moose::Role; + with 'Foo5' => { + -alias => { foo5 => 'foo_in_bar' } + }; + + sub foo_in_bar { "test in foo" } + } + }; + + like( + $exception, + qr/\QCannot create a method alias if a local method of the same name exists/, + "Role Bar5 already has a method named foo_in_bar"); + + isa_ok( + $exception, + "Moose::Exception::CannotCreateMethodAliasLocalMethodIsPresent", + "Role Bar5 already has a method named foo_in_bar"); + + is( + $exception->role_name, + "Bar5", + "Role Bar5 already has a method named foo_in_bar"); + + is( + find_meta($exception->role_name), + Bar5->meta, + "Role Bar5 already has a method named foo_in_bar"); + + is( + $exception->role_being_applied_name, + "Foo5", + "Role Bar5 already has a method named foo_in_bar"); + + is( + find_meta($exception->role_being_applied_name), + Foo5->meta, + "Role Bar5 already has a method named foo_in_bar"); + + is( + $exception->aliased_method_name, + "foo_in_bar", + "Role Bar5 already has a method named foo_in_bar"); + + is( + $exception->method->name, + "foo5", + "Role Bar5 already has a method named foo_in_bar"); +} + +{ + { + package Foo6; + use Moose::Role; + + override foo6 => sub { "override foo6" }; + } + + my $exception = exception { + { + package Bar6; + use Moose::Role; + with 'Foo6'; + + sub foo6 { "test in foo6" } + } + }; + + like( + $exception, + qr/\QRole 'Foo6' has encountered an 'override' method conflict during composition (A local method of the same name as been found). This is a fatal error./, + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + isa_ok( + $exception, + "Moose::Exception::OverrideConflictInComposition", + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + is( + $exception->role_name, + "Bar6", + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + is( + find_meta($exception->role_name), + Bar6->meta, + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + is( + $exception->role_being_applied_name, + "Foo6", + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + is( + find_meta($exception->role_being_applied_name), + Foo6->meta, + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); + + is( + $exception->method_name, + "foo6", + "Role Foo6 is overriding a method named foo6, which is a local method in Bar6"); +} + +{ + { + package Foo7; + use Moose::Role; + + override foo7 => sub { "override foo7" }; + } + + my $exception = exception { + { + package Bar7; + use Moose::Role; + override foo7 => sub { "override foo7 in Bar7" }; + with 'Foo7'; + } + }; + + like( + $exception, + qr/\QRole 'Foo7' has encountered an 'override' method conflict during composition (Two 'override' methods of the same name encountered). This is a fatal error./, + "Roles Foo7 & Bar7, both have override foo7"); + + isa_ok( + $exception, + "Moose::Exception::OverrideConflictInComposition", + "Roles Foo7 & Bar7, both have override foo7"); + + is( + $exception->role_name, + "Bar7", + "Roles Foo7 & Bar7, both have override foo7"); + + is( + find_meta($exception->role_name), + Bar7->meta, + "Roles Foo7 & Bar7, both have override foo7"); + + is( + $exception->role_being_applied_name, + "Foo7", + "Roles Foo7 & Bar7, both have override foo7"); + + is( + find_meta($exception->role_being_applied_name), + Foo7->meta, + "Roles Foo7 & Bar7, both have override foo7"); + + is( + $exception->method_name, + "foo7", + "Roles Foo7 & Bar7, both have override foo7"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-application.t b/t/exceptions/moose-meta-role-application.t new file mode 100644 index 0000000..b1ccf62 --- /dev/null +++ b/t/exceptions/moose-meta-role-application.t @@ -0,0 +1,121 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Meta::Role::Application; + +{ + my $exception = exception { + Moose::Meta::Role::Application->check_role_exclusions; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->check_required_methods; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->check_required_attributes; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->apply_attributes; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->apply_methods; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->apply_override_method_modifiers; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Application->apply_method_modifiers; + }; + + like( + $exception, + qr/Abstract method/, + "cannot call an abstract method"); + + isa_ok( + $exception, + "Moose::Exception::CannotCallAnAbstractMethod", + "cannot call an abstract method"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-attribute.t b/t/exceptions/moose-meta-role-attribute.t new file mode 100644 index 0000000..f7c9008 --- /dev/null +++ b/t/exceptions/moose-meta-role-attribute.t @@ -0,0 +1,41 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + Moose::Meta::Role::Attribute->new; + }; + + like( + $exception, + qr/You must provide a name for the attribute/, + "no name is given"); + + isa_ok( + $exception, + "Moose::Exception::MustProvideANameForTheAttribute", + "no name is given"); +} + +{ + my $exception = exception { + Moose::Meta::Role::Attribute->attach_to_role; + }; + + like( + $exception, + qr/\QYou must pass a Moose::Meta::Role instance (or a subclass)/, + "no role is given to attach_to_role"); + + isa_ok( + $exception, + "Moose::Exception::MustPassAMooseMetaRoleInstanceOrSubclass", + "no role is given to attach_to_role"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-role-composite.t b/t/exceptions/moose-meta-role-composite.t new file mode 100644 index 0000000..05ae6ae --- /dev/null +++ b/t/exceptions/moose-meta-role-composite.t @@ -0,0 +1,84 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $rolesComp = Moose::Meta::Role::Composite->new(roles => ["foo"]); + }; + + like( + $exception, + qr/\QThe list of roles must be instances of Moose::Meta::Role, not foo/, + "'foo' is not an instance of Moose::Meta::Role"); + + isa_ok( + $exception, + "Moose::Exception::RolesListMustBeInstancesOfMooseMetaRole", + "'foo' is not an instance of Moose::Meta::Role"); + + is( + $exception->role, + "foo", + "'foo' is not an instance of Moose::Meta::Role"); +} + +{ + { + package Foo; + use Moose::Role; + } + + my $rolesComp = Moose::Meta::Role::Composite->new(roles => [Foo->meta]); + my $exception = exception { + $rolesComp->add_method; + }; + + like( + $exception, + qr/You must define a method name/, + "no method name given to add_method"); + + isa_ok( + $exception, + "Moose::Exception::MustDefineAMethodName", + "no method name given to add_method"); + + is( + $exception->instance, + $rolesComp, + "no method name given to add_method"); +} + +{ + { + package Foo; + use Moose::Role; + } + + my $rolesComp = Moose::Meta::Role::Composite->new(roles => [Foo->meta]); + my $exception = exception { + $rolesComp->reinitialize; + }; + + like( + $exception, + qr/Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance/, + "no metaclass instance is given"); + + isa_ok( + $exception, + "Moose::Exception::CannotInitializeMooseMetaRoleComposite", + "no metaclass instance is given"); + + is( + $exception->role_composite, + $rolesComp, + "no metaclass instance is given"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typecoercion-union.t b/t/exceptions/moose-meta-typecoercion-union.t new file mode 100644 index 0000000..3712165 --- /dev/null +++ b/t/exceptions/moose-meta-typecoercion-union.t @@ -0,0 +1,56 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose; +use Moose::Util::TypeConstraints; + +{ + my $exception = exception { + Moose::Meta::TypeCoercion::Union->new( type_constraint => find_type_constraint("Str") ); + }; + + like( + $exception, + qr/\QYou can only create a Moose::Meta::TypeCoercion::Union for a Moose::Meta::TypeConstraint::Union, not a Str/, + "'Str' is not a Moose::Meta::TypeConstraint::Union"); + + isa_ok( + $exception, + "Moose::Exception::NeedsTypeConstraintUnionForTypeCoercionUnion", + "'Str' is not a Moose::Meta::TypeConstraint::Union"); + + is( + $exception->type_name, + "Str", + "'Str' is not a Moose::Meta::TypeConstraint::Union"); +} + +{ + union 'StringOrInt', [qw( Str Int )]; + my $type = find_type_constraint("StringOrInt"); + my $tt = Moose::Meta::TypeCoercion::Union->new( type_constraint => $type ); + + my $exception = exception { + $tt->add_type_coercions("ArrayRef"); + }; + + like( + $exception, + qr/Cannot add additional type coercions to Union types/, + "trying to add ArrayRef to a Moose::Meta::TypeCoercion::Union object"); + + isa_ok( + $exception, + "Moose::Exception::CannotAddAdditionalTypeCoercionsToUnion", + "trying to add ArrayRef to a Moose::Meta::TypeCoercion::Union object"); + + is( + $exception->type_coercion_union_object, + $tt, + "trying to add ArrayRef to a Moose::Meta::TypeCoercion::Union object"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typecoercion.t b/t/exceptions/moose-meta-typecoercion.t new file mode 100644 index 0000000..50a73ab --- /dev/null +++ b/t/exceptions/moose-meta-typecoercion.t @@ -0,0 +1,59 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; + +{ + subtype 'typeInt', + as 'Int'; + + my $exception = exception { + coerce 'typeInt', + from 'xyz'; + }; + + like( + $exception, + qr/\QCould not find the type constraint (xyz) to coerce from/, + "xyz is not a valid type constraint"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotFindTypeConstraintToCoerceFrom", + "xyz is not a valid type constraint"); + + is( + $exception->constraint_name, + "xyz", + "xyz is not a valid type constraint"); +} + +{ + subtype 'typeInt', + as 'Int'; + + my $exception = exception { + coerce 'typeInt', from 'Int', via { "123" }; + coerce 'typeInt', from 'Int', via { 12 }; + }; + + like( + $exception, + qr/\QA coercion action already exists for 'Int'/, + "coercion already exists"); + + isa_ok( + $exception, + "Moose::Exception::CoercionAlreadyExists", + "coercion already exists"); + + is( + $exception->constraint_name, + "Int", + "coercion already exists"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typeconstraint-enum.t b/t/exceptions/moose-meta-typeconstraint-enum.t new file mode 100644 index 0000000..4028212 --- /dev/null +++ b/t/exceptions/moose-meta-typeconstraint-enum.t @@ -0,0 +1,64 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $method = Moose::Meta::TypeConstraint::Enum->new( values => []); + }; + + like( + $exception, + qr/You must have at least one value to enumerate through/, + "an Array ref of zero length is given as values"); + + isa_ok( + $exception, + "Moose::Exception::MustHaveAtLeastOneValueToEnumerate", + "an Array ref of zero length is given as values"); +} + +{ + my $exception = exception { + my $method = Moose::Meta::TypeConstraint::Enum->new( values => [undef]); + }; + + like( + $exception, + qr/Enum values must be strings, not undef/, + "undef is given to values"); + + isa_ok( + $exception, + "Moose::Exception::EnumValuesMustBeString", + "undef is given to values"); +} + +{ + my $arrayRef = [1,2,3]; + my $exception = exception { + my $method = Moose::Meta::TypeConstraint::Enum->new( values => [$arrayRef]); + }; + + like( + $exception, + qr/\QEnum values must be strings, not '$arrayRef'/, + "an array ref is given instead of a string"); + #Enum values must be strings, not 'ARRAY(0x191d1b8)' + + isa_ok( + $exception, + "Moose::Exception::EnumValuesMustBeString", + "an array ref is given instead of a string"); + + is( + $exception->value, + $arrayRef, + "an array ref is given instead of a string"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typeconstraint-parameterizable.t b/t/exceptions/moose-meta-typeconstraint-parameterizable.t new file mode 100644 index 0000000..5ae75fc --- /dev/null +++ b/t/exceptions/moose-meta-typeconstraint-parameterizable.t @@ -0,0 +1,67 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; + +{ + my $t = find_type_constraint('ArrayRef'); + my $intType = find_type_constraint("Int"); + my $type = Moose::Meta::TypeConstraint::Parameterizable->new( name => 'xyz', parent => $t); + + my $exception = exception { + $type->generate_inline_for( $intType, '$_[0]'); + }; + + like( + $exception, + qr/Can't generate an inline constraint for Int, since none was defined/, + "no inline constraint was defined for xyz"); + + isa_ok( + $exception, + "Moose::Exception::CannotGenerateInlineConstraint", + "no inline constraint was defined for xyz"); + + is( + $exception->type_name, + "Int", + "no inline constraint was defined for xyz"); + + is( + $exception->parameterizable_type_object_name, + $type->name, + "no inline constraint was defined for xyz"); +} + +{ + my $parameterizable = subtype 'parameterizable_arrayref', as 'ArrayRef[Float]'; + my $int = find_type_constraint('Int'); + my $exception = exception { + my $from_parameterizable = $parameterizable->parameterize("Int"); + }; + + like( + $exception, + qr/Int is not a subtype of Float/, + "Int is not a subtype of Float"); + + isa_ok( + $exception, + "Moose::Exception::ParameterIsNotSubtypeOfParent", + "Int is not a subtype of Float"); + + is( + $exception->type_name, + $parameterizable, + "Int is not a subtype of Float"); + + is( + $exception->type_parameter, + $int, + "Int is not a subtype of Float"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typeconstraint-parameterized.t b/t/exceptions/moose-meta-typeconstraint-parameterized.t new file mode 100644 index 0000000..ae685a8 --- /dev/null +++ b/t/exceptions/moose-meta-typeconstraint-parameterized.t @@ -0,0 +1,83 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + my $exception = exception { + Moose::Meta::TypeConstraint::Parameterized->new( name => "TestType" ); + }; + + like( + $exception, + qr/You cannot create a Higher Order type without a type parameter/, + "type_parameter not given"); + + isa_ok( + $exception, + 'Moose::Exception::CannotCreateHigherOrderTypeWithoutATypeParameter', + "type_parameter not given"); + + is( + $exception->type_name, + "TestType", + "type_parameter not given"); +} + +{ + my $exception = exception { + Moose::Meta::TypeConstraint::Parameterized->new( name => "TestType2", + type_parameter => 'Int' + ); + }; + + like( + $exception, + qr/The type parameter must be a Moose meta type/, + "'Int' is not a Moose::Meta::TypeConstraint"); + + isa_ok( + $exception, + 'Moose::Exception::TypeParameterMustBeMooseMetaType', + "'Int' is not a Moose::Meta::TypeConstraint"); + + is( + $exception->type_name, + "TestType2", + "'Int' is not a Moose::Meta::TypeConstraint"); +} + +{ + my $exception = exception { + package Foo; + use Moose; + + has 'foo' => ( + is => 'ro', + isa => 'Int[Xyz]', + ); + }; + + like( + $exception, + qr/\QThe Int[Xyz] constraint cannot be used, because Int doesn't subtype or coerce from a parameterizable type./, + "invalid isa given to foo"); + + isa_ok( + $exception, + 'Moose::Exception::TypeConstraintCannotBeUsedForAParameterizableType', + "invalid isa given to foo"); + + is( + $exception->type_name, + "Int[Xyz]", + "invalid isa given to foo"); + + is( + $exception->parent_type_name, + 'Int', + "invalid isa given to foo"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typeconstraint-registry.t b/t/exceptions/moose-meta-typeconstraint-registry.t new file mode 100644 index 0000000..fa20375 --- /dev/null +++ b/t/exceptions/moose-meta-typeconstraint-registry.t @@ -0,0 +1,27 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose; + +{ + my $tr = Moose::Meta::TypeConstraint::Registry->new(); + + my $exception = exception { + $tr->add_type_constraint('xyz'); + }; + + like( + $exception, + qr!No type supplied / type is not a valid type constraint!, + "'xyz' is not a Moose::Meta::TypeConstraint"); + + isa_ok( + $exception, + 'Moose::Exception::InvalidTypeConstraint', + "'xyz' is not a Moose::Meta::TypeConstraint"); +} + +done_testing; diff --git a/t/exceptions/moose-meta-typeconstraint.t b/t/exceptions/moose-meta-typeconstraint.t new file mode 100644 index 0000000..71e87d1 --- /dev/null +++ b/t/exceptions/moose-meta-typeconstraint.t @@ -0,0 +1,139 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; +use Moose(); + +# tests for type coercions +{ + subtype 'HexNum' => as 'Int', where { /[a-f0-9]/i }; + my $type_object = find_type_constraint 'HexNum'; + + my $exception = exception { + $type_object->coerce; + }; + + like( + $exception, + qr/Cannot coerce without a type coercion/, + "You cannot coerce a type unless coercion is supported by that type"); + + is( + $exception->type_name, + 'HexNum', + "You cannot coerce a type unless coercion is supported by that type"); + + isa_ok( + $exception, + "Moose::Exception::CoercingWithoutCoercions", + "You cannot coerce a type unless coercion is supported by that type"); +} + +{ + my $exception = exception { + Moose::Meta::TypeConstraint->new( message => "foo"); + }; + + like( + $exception, + qr/The 'message' parameter must be a coderef/, + "'foo' is not a CODE ref"); + + isa_ok( + $exception, + "Moose::Exception::MessageParameterMustBeCodeRef", + "'foo' is not a CODE ref"); +} + +{ + subtype 'NotInlinable', + as 'Str', + where { $_ !~ /Q/ }; + my $not_inlinable = find_type_constraint('NotInlinable'); + + my $exception = exception { + $not_inlinable->_inline_check('$foo'); + }; + + like( + $exception, + qr/Cannot inline a type constraint check for NotInlinable/, + "cannot inline NotInlinable"); + + isa_ok( + $exception, + "Moose::Exception::CannotInlineTypeConstraintCheck", + "cannot inline NotInlinable"); + + is( + $exception->type_name, + "NotInlinable", + "cannot inline NotInlinable"); + + is( + find_type_constraint( $exception->type_name ), + $not_inlinable, + "cannot inline NotInlinable"); +} + +{ + my $exception = exception { + Moose::Meta::TypeConstraint->new(name => "FooTypeConstraint", constraint => undef) + }; + + like( + $exception, + qr/Could not compile type constraint 'FooTypeConstraint' because no constraint check/, + "constraint is set to undef"); + + isa_ok( + $exception, + "Moose::Exception::NoConstraintCheckForTypeConstraint", + "constraint is set to undef"); + + is( + $exception->type_name, + "FooTypeConstraint", + "constraint is set to undef"); +} + +{ + subtype 'OnlyPositiveInts', + as 'Int', + where { $_ > 1 }; + my $onlyposint = find_type_constraint('OnlyPositiveInts'); + + my $exception = exception { + $onlyposint->assert_valid( -123 ); + }; + + like( + $exception, + qr/Validation failed for 'OnlyPositiveInts' with value -123/, + "-123 is not valid for OnlyPositiveInts"); + + isa_ok( + $exception, + "Moose::Exception::ValidationFailedForTypeConstraint", + "-123 is not valid for OnlyPositiveInts"); + + is( + $exception->type->name, + "OnlyPositiveInts", + "-123 is not valid for OnlyPositiveInts"); + + is( + $exception->type, + $onlyposint, + "-123 is not valid for OnlyPositiveInts"); + + is( + $exception->value, + -123, + "-123 is not valid for OnlyPositiveInts"); +} + +done_testing; diff --git a/t/exceptions/moose-role.t b/t/exceptions/moose-role.t new file mode 100644 index 0000000..a2200fb --- /dev/null +++ b/t/exceptions/moose-role.t @@ -0,0 +1,321 @@ +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; diff --git a/t/exceptions/moose-util-metarole.t b/t/exceptions/moose-util-metarole.t new file mode 100644 index 0000000..11e30af --- /dev/null +++ b/t/exceptions/moose-util-metarole.t @@ -0,0 +1,129 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + { + package Foo; + use Moose; + } + + my $foo = Foo->new; + my $blessed_foo = blessed $foo; + my %args = ( "for" => $foo ); + + my $exception = exception { + Moose::Util::MetaRole::apply_metaroles( %args ); + }; + + my $message = "When using Moose::Util::MetaRole, " + ."you must pass a Moose class name, role name, metaclass object, or metarole object." + ." You passed $foo, and we resolved this to a $blessed_foo object."; + + like( + $exception, + qr/\Q$message/, + "$foo is an object, not a class"); + #When using Moose::Util::MetaRole, you must pass a Moose class name, role name, metaclass object, or metarole object. You passed Foo=HASH(0x16adb58), and we resolved this to a Foo object. + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgPassedToMooseUtilMetaRole', + "$foo is an object, not a class"); + + is( + $exception->argument, + $foo, + "$foo is an object, not a class"); +} + +{ + my $array_ref = [1, 2, 3]; + my %args = ( "for" => $array_ref ); + + my $exception = exception { + Moose::Util::MetaRole::apply_metaroles( %args ); + }; + + my $message = "When using Moose::Util::MetaRole, " + ."you must pass a Moose class name, role name, metaclass object, or metarole object." + ." You passed $array_ref, and this did not resolve to a metaclass or metarole." + ." Maybe you need to call Moose->init_meta to initialize the metaclass first?"; + + like( + $exception, + qr/\Q$message/, + "an Array ref is passed to apply_metaroles"); + #When using Moose::Util::MetaRole, you must pass a Moose class name, role name, metaclass object, or metarole object. You passed ARRAY(0x21eb868), and this did not resolve to a metaclass or metarole. Maybe you need to call Moose->init_meta to initialize the metaclass first? + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgPassedToMooseUtilMetaRole', + "an Array ref is passed to apply_metaroles"); + + is( + $exception->argument, + $array_ref, + "an Array ref is passed to apply_metaroles"); +} + +{ + my %args = ( "for" => undef ); + + my $exception = exception { + Moose::Util::MetaRole::apply_metaroles( %args ); + }; + + my $message = "When using Moose::Util::MetaRole, " + ."you must pass a Moose class name, role name, metaclass object, or metarole object." + ." You passed undef, and this did not resolve to a metaclass or metarole." + ." Maybe you need to call Moose->init_meta to initialize the metaclass first?"; + + like( + $exception, + qr/\Q$message/, + "undef passed to apply_metaroles"); + #When using Moose::Util::MetaRole, you must pass a Moose class name, role name, metaclass object, or metarole object. You passed undef, and this did not resolve to a metaclass or metarole. Maybe you need to call Moose->init_meta to initialize the metaclass first? + + isa_ok( + $exception, + 'Moose::Exception::InvalidArgPassedToMooseUtilMetaRole', + "undef passed to apply_metaroles"); + + is( + $exception->argument, + undef, + "undef passed to apply_metaroles"); +} + +{ + { + package Foo::Role; + use Moose::Role; + } + + my %args = ('for' => "Foo::Role" ); + + my $exception = exception { + Moose::Util::MetaRole::apply_base_class_roles( %args ); + }; + + like( + $exception, + qr/\QYou can only apply base class roles to a Moose class, not a role./, + "Moose::Util::MetaRole::apply_base_class_roles expects a class for 'for'"); + + isa_ok( + $exception, + 'Moose::Exception::CannotApplyBaseClassRolesToRole', + "Moose::Util::MetaRole::apply_base_class_roles expects a class for 'for'"); + + is( + $exception->role_name, + 'Foo::Role', + "Moose::Util::MetaRole::apply_base_class_roles expects a class for 'for'"); +} + +done_testing; diff --git a/t/exceptions/moose-util-typeconstraints.t b/t/exceptions/moose-util-typeconstraints.t new file mode 100644 index 0000000..22ad7f2 --- /dev/null +++ b/t/exceptions/moose-util-typeconstraints.t @@ -0,0 +1,171 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; + +my $x = "123"; + +{ + my $default = [1, 2, 3]; + my $exception = exception { + match_on_type $x => ( 'Int' => + sub { "Action for Int"; } => + $default + ); + }; + + like( + $exception, + qr/\QDefault case must be a CODE ref, not $default/, + "an ArrayRef is passed as a default"); + #Default case must be a CODE ref, not ARRAY(0x14f6fc8) + + isa_ok( + $exception, + 'Moose::Exception::DefaultToMatchOnTypeMustBeCodeRef', + "an ArrayRef is passed as a default"); + + is( + $exception->default_action, + $default, + "an ArrayRef is passed as a default"); + + is( + $exception->to_match, + $x, + "an ArrayRef is passed as a default"); +} + +{ + my $exception = exception { + match_on_type $x => ( 'doesNotExist' => sub { "Action for Int"; } ); + }; + + like( + $exception, + qr/\QCannot find or parse the type 'doesNotExist'/, + "doesNotExist is not a valid type"); + + isa_ok( + $exception, + 'Moose::Exception::CannotFindTypeGivenToMatchOnType', + "doesNotExist is not a valid type"); + + is( + $exception->type, + "doesNotExist", + "doesNotExist is not a valid type"); + + is( + $exception->to_match, + $x, + "doesNotExist is not a valid type"); +} + +{ + my $action = [1, 2, 3]; + my $exception = exception { + match_on_type $x => ( Int => $action ); + }; + + like( + $exception, + qr/\QMatch action must be a CODE ref, not $action/, + "an ArrayRef is given as action"); + #Match action must be a CODE ref, not ARRAY(0x27a0748) + + isa_ok( + $exception, + 'Moose::Exception::MatchActionMustBeACodeRef', + "an ArrayRef is given as action"); + + is( + $exception->type_name, + "Int", + "an ArrayRef is given as action"); + + is( + $exception->to_match, + $x, + "an ArrayRef is given as action"); + + is( + $exception->action, + $action, + "an ArrayRef is given as action"); +} + +{ + my $exception = exception { + match_on_type $x => ( 'ArrayRef' => sub { "Action for Int"; } ); + }; + + like( + $exception, + qr/\QNo cases matched for $x/, + "$x is not an ArrayRef"); + #No cases matched for 123 + + isa_ok( + $exception, + 'Moose::Exception::NoCasesMatched', + "$x is not an ArrayRef"); + + is( + $exception->to_match, + $x, + "$x is not an ArrayRef"); +} + +{ + { + package TestType; + use Moose; + extends 'Moose::Meta::TypeConstraint'; + + sub name { + undef; + } + } + + my $tt = TestType->new; + my $exception = exception { + register_type_constraint( $tt ); + }; + + like( + $exception, + qr/can't register an unnamed type constraint/, + "name has been set to undef for TestType"); + + isa_ok( + $exception, + 'Moose::Exception::CannotRegisterUnnamedTypeConstraint', + "name has been set to undef for TestType"); +} + +{ + my $exception = exception { + union 'StrUndef', 'Str | Undef |'; + }; + + like( + $exception, + qr/\Q'Str | Undef |' didn't parse (parse-pos=11 and str-length=13)/, + "cannot parse 'Str| Undef |'"); + + isa_ok( + $exception, + 'Moose::Exception::CouldNotParseType', + "cannot parse 'Str| Undef |'"); + + is( + $exception->type, + 'Str | Undef |', + "cannot parse 'Str| Undef |'"); +} + +done_testing; diff --git a/t/exceptions/moose.t b/t/exceptions/moose.t new file mode 100644 index 0000000..fc5f0e5 --- /dev/null +++ b/t/exceptions/moose.t @@ -0,0 +1,173 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util 'find_meta'; + +# tests for extends without arguments +{ + my $exception = exception { + package SubClassNoSuperClass; + use Moose; + extends; + }; + + like( + $exception, + qr/Must derive at least one class/, + "extends requires at least one argument"); + + isa_ok( + $exception, + 'Moose::Exception::ExtendsMissingArgs', + "extends requires at least one argument"); +} + +{ + my $exception = exception { + use Moose; + Moose->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; + Moose->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::Role; + } + + my $exception = exception { + use Moose; + Moose->init_meta( (for_class => 'Foo3', metaclass => 'Foo3' )); + }; + + like( + $exception, + qr/\QThe Metaclass Foo3 must be a subclass of Moose::Meta::Class./, + "Foo3 is a Moose::Role"); + + isa_ok( + $exception, + "Moose::Exception::MetaclassMustBeASubclassOfMooseMetaClass", + "Foo3 is a Moose::Role"); + + is( + $exception->class_name, + "Foo3", + "Foo3 is a Moose::Role"); +} + +{ + { + package Foo3; + use Moose::Role; + } + + my $exception = exception { + use Moose; + Moose->init_meta( (for_class => 'Foo3' )); + }; + + my $foo3 = Foo3->meta; + + like( + $exception, + qr/\QFoo3 already has a metaclass, but it does not inherit Moose::Meta::Class ($foo3). You cannot make the same thing a role and a class. Remove either Moose or Moose::Role./, + "Foo3 is a Moose::Role"); + #Foo3 already has a metaclass, but it does not inherit Moose::Meta::Class (Moose::Meta::Role=HASH(0x29d3c78)). You cannot make the same thing a role and a class. Remove either Moose or Moose::Role. + + isa_ok( + $exception, + "Moose::Exception::MetaclassIsARoleNotASubclassOfGivenMetaclass", + "Foo3 is a Moose::Role"); + + is( + $exception->role_name, + "Foo3", + "Foo3 is a Moose::Role"); + + is( + find_meta($exception->role_name), + Foo3->meta, + "Foo3 is a Moose::Role"); + + is( + $exception->metaclass, + "Moose::Meta::Class", + "Foo3 is a Moose::Role"); +} + +{ + my $foo; + { + use Moose; + $foo = Class::MOP::Class->create("Foo4"); + } + + my $exception = exception { + use Moose; + Moose->init_meta( (for_class => 'Foo4' )); + }; + + like( + $exception, + qr/\QFoo4 already has a metaclass, but it does not inherit Moose::Meta::Class ($foo)./, + "Foo4 is a Class::MOP::Class, not a Moose::Meta::Class"); + #Foo4 already has a metaclass, but it does not inherit Moose::Meta::Class (Class::MOP::Class=HASH(0x278a4a0)). + + isa_ok( + $exception, + "Moose::Exception::MetaclassIsNotASubclassOfGivenMetaclass", + "Foo4 is a Class::MOP::Class, not a Moose::Meta::Class"); + + is( + $exception->class_name, + "Foo4", + "Foo4 is a Class::MOP::Class, not a Moose::Meta::Class"); + + is( + find_meta($exception->class_name), + $foo, + "Foo4 is a Class::MOP::Class, not a Moose::Meta::Class"); + + is( + $exception->metaclass, + "Moose::Meta::Class", + "Foo4 is a Class::MOP::Class, not a Moose::Meta::Class"); +} + +done_testing; diff --git a/t/exceptions/object.t b/t/exceptions/object.t new file mode 100644 index 0000000..71b78d4 --- /dev/null +++ b/t/exceptions/object.t @@ -0,0 +1,77 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +# tests for SingleParamsToNewMustBeHashRef +{ + { + package Foo; + use Moose; + } + + my $exception = exception { + Foo->new("hello") + }; + + 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 DoesRequiresRoleName +{ + { + package Foo; + use Moose; + } + + my $foo = Foo->new; + + my $exception = exception { + $foo->does; + }; + + like( + $exception, + qr/^\QYou must supply a role name to does()/, + "Cannot call does() without a role name"); + + isa_ok( + $exception, + "Moose::Exception::DoesRequiresRoleName", + "Cannot call does() without a role name"); + + is( + $exception->class_name, + "Foo", + "Cannot call does() without a role name"); + + $exception = exception { + Foo->does; + }; + + like( + $exception, + qr/^\QYou must supply a role name to does()/, + "Cannot call does() without a role name"); + + isa_ok( + $exception, + "Moose::Exception::DoesRequiresRoleName", + "Cannot call does() without a role name"); + + is( + $exception->class_name, + "Foo", + "Cannot call does() without a role name"); +} + +done_testing; diff --git a/t/exceptions/overload.t b/t/exceptions/overload.t new file mode 100644 index 0000000..8d01e35 --- /dev/null +++ b/t/exceptions/overload.t @@ -0,0 +1,15 @@ +use strict; +use warnings; + +use Test::More; +use Moose::Exception; + +my $exception = Moose::Exception->new(message => 'barf!'); + +like($exception, qr/barf/, 'stringification for regex works'); + +ok($exception ne 'oh hai', 'direct string comparison works'); + +ok($exception, 'exception can be treated as a boolean'); + +done_testing; diff --git a/t/exceptions/rt-92818.t b/t/exceptions/rt-92818.t new file mode 100644 index 0000000..b504841 --- /dev/null +++ b/t/exceptions/rt-92818.t @@ -0,0 +1,45 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +# https://rt.cpan.org/Ticket/Display.html?id=92818 + +{ + package Parent; + use Moose; + has x => ( + is => 'rw', + required => 1, + ); +} + +{ + my $e = exception { my $obj = Parent->new }; + ok( + $e->isa('Moose::Exception::AttributeIsRequired'), + 'got the right exception', + ) + or note 'got exception ', ref($e), ': ', $e->message; +} + +{ + package Child; + use Moose; + extends 'Parent'; +} + +# the exception produced should be AttributeIsRequired, however +# AttributeIsRequired was throwing the exception ClassNamesDoNotMatch. + +{ + my $e = exception { my $obj = Child->new }; + ok( + $e->isa('Moose::Exception::AttributeIsRequired'), + 'got the right exception', + ) + or note 'got exception ', ref($e), ': ', $e->message; +} + +done_testing; diff --git a/t/exceptions/rt-94795.t b/t/exceptions/rt-94795.t new file mode 100644 index 0000000..2742407 --- /dev/null +++ b/t/exceptions/rt-94795.t @@ -0,0 +1,34 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +# https://rt.cpan.org/Ticket/Display.html?id=94795 + +# the exception produced should be AttributeIsRequired, however +# AttributeIsRequired was throwing the exception ClassNamesDoNotMatch. + +{ + package AAA; + use Moose; + has my_attr => ( + is => 'ro', + required => 1, + ); +} + +{ + package BBB; + use Moose; + extends qw/AAA/; +} + +my $e = exception { BBB->new }; +ok( + $e->isa('Moose::Exception::AttributeIsRequired'), + 'got the right exception', +) +or note 'got exception ', ref($e), ': ', $e->message; + +done_testing; diff --git a/t/exceptions/stringify.t b/t/exceptions/stringify.t new file mode 100644 index 0000000..7a7f0c4 --- /dev/null +++ b/t/exceptions/stringify.t @@ -0,0 +1,111 @@ +use strict; +use warnings; + +use Test::More; +use Try::Tiny; + +{ + my $e; + { + package Foo; + use Moose; + use Try::Tiny; + + try { + has '+foo' => ( is => 'ro' ); + } + catch { + $e = $_; + }; + } + + ok( $e, q{got an exception from a bad has '+foo' declaration} ); + like( + $e->as_string, + qr/\QCould not find an attribute by the name of 'foo' to inherit from in Foo/, + 'stringification includes the error message' + ); + like( + $e->as_string, + qr/\s+Moose::has/, + 'stringification includes the call to Moose::has' + ); + unlike( + $e->as_string, + qr/Moose::Meta/, + 'stringification does not include internal calls to Moose meta classes' + ); + + try { + Foo->meta->clone_object( [] ); + } + catch { + $e = $_; + }; + + like( + $e->as_string, + qr/Class::MOP::Class::clone_object/, + 'exception include first Class::MOP::Class frame' + ); + unlike( + $e->as_string, + qr/Class::MOP::Mixin::_throw_exception/, + 'exception does not include internal calls toClass::MOP::Class meta classes' + ); +} + +local $ENV{MOOSE_FULL_EXCEPTION} = 1; +{ + my $e; + { + package Bar; + use Moose; + use Try::Tiny; + + try { + has '+foo' => ( is => 'ro' ); + } + catch { + $e = $_; + }; + } + + ok( $e, q{got an exception from a bad has '+foo' declaration} ); + like( + $e->as_string, + qr/\QCould not find an attribute by the name of 'foo' to inherit from in Bar/, + 'stringification includes the error message' + ); + like( + $e->as_string, + qr/\s+Moose::has/, + 'stringification includes the call to Moose::has' + ); + like( + $e->as_string, + qr/Moose::Meta/, + 'stringification includes internal calls to Moose meta classes when MOOSE_FULL_EXCEPTION env var is true' + ); + + + try { + Foo->meta->clone_object( [] ); + } + catch { + $e = $_; + }; + + like( + $e->as_string, + qr/Class::MOP::Class::clone_object/, + 'exception include first Class::MOP::Class frame' + ); + like( + $e->as_string, + qr/Class::MOP::Mixin::_throw_exception/, + 'exception includes internal calls toClass::MOP::Class meta classes when MOOSE_FULL_EXCEPTION env var is true' + ); +} + +done_testing; diff --git a/t/exceptions/traits.t b/t/exceptions/traits.t new file mode 100644 index 0000000..2d2fad0 --- /dev/null +++ b/t/exceptions/traits.t @@ -0,0 +1,34 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +# this test taken from MooseX::ABC t/immutable.t, where it broke with Moose 2.1207 + +{ + package ABC; + use Moose::Role; + around new => sub { + my $orig = shift; + my $class = shift; + my $meta = Class::MOP::class_of($class); + $meta->throw_error("$class is abstract, it cannot be instantiated"); + $class->$orig(@_); + }; +} +{ + package MyApp::Base; + use Moose; + with 'ABC'; + __PACKAGE__->meta->make_immutable(inline_constructor => 0); +} + + +like( + exception { MyApp::Base->new }, + qr/MyApp::Base is abstract, it cannot be instantiated/, + 'instantiating abstract classes fails', +); + +done_testing; diff --git a/t/exceptions/typeconstraints.t b/t/exceptions/typeconstraints.t new file mode 100644 index 0000000..6c1e4e6 --- /dev/null +++ b/t/exceptions/typeconstraints.t @@ -0,0 +1,293 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; + +# tests for type/subtype name contain invalid characters +{ + my $exception = exception { + subtype 'Foo-Baz' => as 'Item' + }; + + like( + $exception, + qr/contains invalid characters/, + "Type names cannot contain a dash (via subtype sugar)"); + + isa_ok( + $exception, + "Moose::Exception::InvalidNameForType", + "Type names cannot contain a dash (via subtype sugar)"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::create_type_constraint_union(); + }; + + like( + $exception, + qr/You must pass in at least 2 type names to make a union/, + "Moose::Util::TypeConstraints::create_type_constraint_union takes atleast two arguments"); + + isa_ok( + $exception, + "Moose::Exception::UnionTakesAtleastTwoTypeNames", + "Moose::Util::TypeConstraints::create_type_constraint_union takes atleast two arguments"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::create_type_constraint_union('foo','bar'); + }; + + like( + $exception, + qr/\QCould not locate type constraint (foo) for the union/, + "invalid typeconstraint given to Moose::Util::TypeConstraints::create_type_constraint_union"); + + isa_ok( + $exception, + "Moose::Exception::CouldNotLocateTypeConstraintForUnion", + "invalid typeconstraint given to Moose::Util::TypeConstraints::create_type_constraint_union"); + + is( + $exception->type_name, + 'foo', + "invalid typeconstraint given to Moose::Util::TypeConstraints::create_type_constraint_union"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::create_parameterized_type_constraint("Foo"); + }; + + like( + $exception, + qr/\QCould not parse type name (Foo) correctly/, + "'Foo' is not a valid type constraint name"); + + isa_ok( + $exception, + "Moose::Exception::InvalidTypeGivenToCreateParameterizedTypeConstraint", + "'Foo' is not a valid type constraint name"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::create_parameterized_type_constraint("Foo[Int]"); + }; + + like( + $exception, + qr/\QCould not locate the base type (Foo)/, + "'Foo' is not a valid base type constraint name"); + + isa_ok( + $exception, + "Moose::Exception::InvalidBaseTypeGivenToCreateParameterizedTypeConstraint", + "'Foo' is not a valid base type constraint name"); +} + +{ + { + package Foo1; + use Moose::Role; + } + + my $exception = exception { + Moose::Util::TypeConstraints::class_type("Foo1"); + }; + + like( + $exception, + qr/\QThe type constraint 'Foo1' has already been created in Moose::Role and cannot be created again in main/, + "there is an already defined role of name 'Foo1'"); + + isa_ok( + $exception, + "Moose::Exception::TypeConstraintIsAlreadyCreated", + "there is an already defined role of name 'Foo1'"); + + is( + $exception->type_name, + 'Foo1', + "there is an already defined role of name 'Foo1'"); + + is( + (find_type_constraint($exception->type_name))->_package_defined_in, + 'Moose::Role', + "there is an already defined role of name 'Foo1'"); + + is( + $exception->package_defined_in, + 'main', + "there is an already defined role of name 'Foo1'"); +} + +{ + { + package Foo2; + use Moose; + } + + my $exception = exception { + Moose::Util::TypeConstraints::role_type("Foo2"); + }; + + like( + $exception, + qr/\QThe type constraint 'Foo2' has already been created in Moose and cannot be created again in main/, + "there is an already defined class of name 'Foo2'"); + + isa_ok( + $exception, + "Moose::Exception::TypeConstraintIsAlreadyCreated", + "there is an already defined class of name 'Foo2'"); + + is( + $exception->type_name, + 'Foo2', + "there is an already defined class of name 'Foo2'"); + + is( + (find_type_constraint($exception->type_name))->_package_defined_in, + 'Moose', + "there is an already defined class of name 'Foo2'"); + + is( + $exception->package_defined_in, + 'main', + "there is an already defined class of name 'Foo2'"); +} + +{ + my $exception = exception { + subtype 'Foo'; + }; + + like( + $exception, + qr/A subtype cannot consist solely of a name, it must have a parent/, + "no parent given to subtype"); + + isa_ok( + $exception, + "Moose::Exception::NoParentGivenToSubtype", + "no parent given to subtype"); + + is( + $exception->name, + 'Foo', + "no parent given to subtype"); +} + +{ + my $exception = exception { + enum [1,2,3], "foo"; + }; + + like( + $exception, + qr/\Qenum called with an array reference and additional arguments. Did you mean to parenthesize the enum call's parameters?/, + "enum expects either a name & an array or only an array"); + + isa_ok( + $exception, + "Moose::Exception::EnumCalledWithAnArrayRefAndAdditionalArgs", + "enum expects either a name & an array or only an array"); +} + +{ + my $exception = exception { + union [1,2,3], "foo"; + }; + + like( + $exception, + qr/union called with an array reference and additional arguments/, + "union expects either a name & an array or only an array"); + + isa_ok( + $exception, + "Moose::Exception::UnionCalledWithAnArrayRefAndAdditionalArgs", + "union expects either a name & an array or only an array"); +} + +{ + { + package Foo3; + use Moose; + } + + my $exception = exception { + Moose::Util::TypeConstraints::type("Foo3"); + }; + + like( + $exception, + qr/\QThe type constraint 'Foo3' has already been created in Moose and cannot be created again in main/, + "there is an already defined class of name 'Foo3'"); + + isa_ok( + $exception, + "Moose::Exception::TypeConstraintIsAlreadyCreated", + "there is an already defined class of name 'Foo3'"); + + is( + $exception->type_name, + 'Foo3', + "there is an already defined class of name 'Foo3'"); + + is( + find_type_constraint($exception->type_name)->_package_defined_in, + 'Moose', + "there is an already defined class of name 'Foo3'"); + + is( + $exception->package_defined_in, + 'main', + "there is an already defined class of name 'Foo3'"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::coerce "Foo"; + }; + + like( + $exception, + qr/Cannot find type 'Foo', perhaps you forgot to load it/, + "'Foo' is not a valid type"); + + isa_ok( + $exception, + "Moose::Exception::CannotFindType", + "'Foo' is not a valid type"); +} + +{ + my $exception = exception { + Moose::Util::TypeConstraints::add_parameterizable_type "Foo"; + }; + + like( + $exception, + qr/Type must be a Moose::Meta::TypeConstraint::Parameterizable not Foo/, + "'Foo' is not a parameterizable type"); + + isa_ok( + $exception, + "Moose::Exception::AddParameterizableTypeTakesParameterizableType", + "'Foo' is not a parameterizable type"); + + is( + $exception->type_name, + "Foo", + "'Foo' is not a parameterizable type"); +} + +done_testing; diff --git a/t/exceptions/util.t b/t/exceptions/util.t new file mode 100644 index 0000000..551e773 --- /dev/null +++ b/t/exceptions/util.t @@ -0,0 +1,188 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util qw/apply_all_roles add_method_modifier/; + +{ + { + package TestClass; + use Moose; + } + + my $test_object = TestClass->new; + + my $exception = exception { + apply_all_roles( $test_object ); + }; + + like( + $exception, + qr/\QMust specify at least one role to apply to $test_object/, + "apply_all_roles takes an object and a role to apply"); + #Must specify at least one role to apply to TestClass=HASH(0x2bee290) + + isa_ok( + $exception, + "Moose::Exception::MustSpecifyAtleastOneRoleToApplicant", + "apply_all_roles takes an object and a role to apply"); + + my $test_class = TestClass->meta; + + $exception = exception { + apply_all_roles( $test_class ); + }; + + like( + $exception, + qr/\QMust specify at least one role to apply to $test_class/, + "apply_all_roles takes a class and a role to apply"); + #Must specify at least one role to apply to Moose::Meta::Class=HASH(0x1a1f818) + + isa_ok( + $exception, + "Moose::Exception::MustSpecifyAtleastOneRoleToApplicant", + "apply_all_roles takes a class and a role to apply"); + + { + package TestRole; + use Moose::Role; + } + + my $test_role = TestRole->meta; + + $exception = exception { + apply_all_roles( $test_role ); + }; + + like( + $exception, + qr/\QMust specify at least one role to apply to $test_role/, + "apply_all_roles takes a role and a role to apply"); + #Must specify at least one role to apply to Moose::Meta::Role=HASH(0x1f22d40) + + isa_ok( + $exception, + "Moose::Exception::MustSpecifyAtleastOneRoleToApplicant", + "apply_all_roles takes a role and a role to apply"); +} + +# tests for class consuming a class, instead of role +{ + my $exception = exception { + package ClassConsumingClass; + use Moose; + use Module::Runtime; + with 'Module::Runtime'; + }; + + like( + $exception, + qr/You can only consume roles, Module::Runtime is not a Moose role/, + "You can't consume a class"); + + isa_ok( + $exception, + 'Moose::Exception::CanOnlyConsumeRole', + "You can't consume a class"); + + $exception = exception { + package foo; + use Moose; + use Module::Runtime; + with 'Not::A::Real::Package'; + }; + + like( + $exception, + qr!Can't locate Not/A/Real/Package\.pm in \@INC!, + "You can't consume a class which doesn't exist"); + + $exception = exception { + package foo; + use Moose; + use Module::Runtime; + with sub {}; + }; + + like( + $exception, + qr/argument is not a module name/, + "You can only consume a module"); +} + +{ + { + package Foo; + use Moose; + } + + my $exception = exception { + add_method_modifier(Foo->meta, "before", [{}, sub {"before";}]); + }; + + like( + $exception, + qr/\QMethods passed to before must be provided as a list, arrayref or regex, not HASH/, + "we gave a HashRef to before"); + + isa_ok( + $exception, + "Moose::Exception::IllegalMethodTypeToAddMethodModifier", + "we gave a HashRef to before"); + + is( + ref( $exception->params->[0] ), + "HASH", + "we gave a HashRef to before"); + + is( + $exception->modifier_name, + 'before', + "we gave a HashRef to before"); + + is( + $exception->class_or_object->name, + "Foo", + "we gave a HashRef to before"); +} + +{ + my $exception = exception { + package My::Class; + use Moose; + has 'attr' => ( + is => 'ro', + traits => [qw( Xyz )], + ); + }; + + like( + $exception, + qr/^Can't locate Moose::Meta::Attribute::Custom::Trait::Xyz or Xyz in \@INC \(\@INC contains:/, + "Cannot locate 'Xyz'"); + + isa_ok( + $exception, + "Moose::Exception::CannotLocatePackageInINC", + "Cannot locate 'Xyz'"); + + is( + $exception->type, + "Attribute", + "Cannot locate 'Xyz'"); + + is( + $exception->possible_packages, + 'Moose::Meta::Attribute::Custom::Trait::Xyz or Xyz', + "Cannot locate 'Xyz'"); + + is( + $exception->metaclass_name, + "Xyz", + "Cannot locate 'Xyz'"); +} + +done_testing; |