{
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"
);
}
{
{
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"
);
}
{
my
$exception
= exception {
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"
);
}
{
{
}
my
$exception
= exception {
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"
);
}
{
{
}
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 {
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 {
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 {
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"
);
}
{
{
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"
);
}
{
my
$exception
= exception {
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 {
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 {
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 {
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 {
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 {
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 {
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 {
has
d2
=> (
isa
=>
'X'
,
handles
=> [
'stub'
],
);
};
is(
$exception
,
undef
,
'no error when trying to declare a delegation method that overwrites a stub method'
);
}
{
{
has
'foo'
=> (
is
=>
'rw'
,
clearer
=>
'clear_foo'
,
predicate
=>
'foo'
,
accessor
=>
'bar'
,
);
}
my
$exception
= exception {
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 {
has
'+foo'
=> (
clearer
=>
'clear_foo1'
,
predicate
=>
'xyz'
,
accessor
=>
'bar2'
,
);
};
like(
$exception
,
qr/\QIllegal inherited options => (accessor, clearer, predicate)/
,
"Illegal inherited option is given"
);
}
{
my
$exception
= exception {
{
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 {
{
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"
);
isa_ok(
$exception
,
"Moose::Exception::UnableToCanonicalizeHandles"
,
"handles doesn't take file handle"
);
}
{
my
$exception
= exception {
{
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 {
{
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 {
{
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 {
{
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 {
{
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 {
{
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"
);
}
{
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"
);
}
{
{
has
foo
=> (
is
=>
'rw'
,
isa
=>
'Num'
,
default
=> 5.5,
);
}
{
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"
);
}
{
{
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'
);
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'
);
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'
);
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'
);
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
);
{
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"
);
}
{
{
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"
);
}
{
{
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"
);
}
{
my
$exception
= exception {
{
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 {
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 {
{
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 {
{
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"
);
isa_ok(
$exception
,
"Moose::Exception::ValidationFailedForTypeConstraint"
,
"bar is an 'Int' and 'Str' is given"
);
}
done_testing;