diff options
Diffstat (limited to 't/type_constraints/maybe_type_constraint.t')
-rw-r--r-- | t/type_constraints/maybe_type_constraint.t | 129 |
1 files changed, 129 insertions, 0 deletions
diff --git a/t/type_constraints/maybe_type_constraint.t b/t/type_constraints/maybe_type_constraint.t new file mode 100644 index 0000000..3bbdba2 --- /dev/null +++ b/t/type_constraints/maybe_type_constraint.t @@ -0,0 +1,129 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose::Util::TypeConstraints; + +my $type = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); +isa_ok($type, 'Moose::Meta::TypeConstraint'); +isa_ok($type, 'Moose::Meta::TypeConstraint::Parameterized'); + +ok( $type->equals($type), "equals self" ); +ok( !$type->equals($type->parent), "not equal to parent" ); +ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" ); +ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" ); +ok( $type->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); +ok( !$type->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" ); +ok( !$type->equals( Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" ); + +ok($type->check(10), '... checked type correctly (pass)'); +ok($type->check(undef), '... checked type correctly (pass)'); +ok(!$type->check('Hello World'), '... checked type correctly (fail)'); +ok(!$type->check([]), '... checked type correctly (fail)'); + +{ + package Bar; + use Moose; + + package Foo; + use Moose; + use Moose::Util::TypeConstraints; + + has 'arr' => (is => 'rw', isa => 'Maybe[ArrayRef]', required => 1); + has 'bar' => (is => 'rw', isa => class_type('Bar')); + has 'maybe_bar' => (is => 'rw', isa => maybe_type(class_type('Bar'))); +} + +is( exception { + Foo->new(arr => [], bar => Bar->new); +}, undef, '... Bar->new isa Bar' ); + +isnt( exception { + Foo->new(arr => [], bar => undef); +}, undef, '... undef isnta Bar' ); + +is( exception { + Foo->new(arr => [], maybe_bar => Bar->new); +}, undef, '... Bar->new isa maybe(Bar)' ); + +is( exception { + Foo->new(arr => [], maybe_bar => undef); +}, undef, '... undef isa maybe(Bar)' ); + +isnt( exception { + Foo->new(arr => [], maybe_bar => 1); +}, undef, '... 1 isnta maybe(Bar)' ); + +is( exception { + Foo->new(arr => []); +}, undef, '... it worked!' ); + +is( exception { + Foo->new(arr => undef); +}, undef, '... it worked!' ); + +isnt( exception { + Foo->new(arr => 100); +}, undef, '... failed the type check' ); + +isnt( exception { + Foo->new(arr => 'hello world'); +}, undef, '... failed the type check' ); + + +{ + package Test::MooseX::Types::Maybe; + use Moose; + + has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]'); + has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]'); + has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]'); + has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]'); + has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]'); +} + +ok my $obj = Test::MooseX::Types::Maybe->new + => 'Create good test object'; + +## Maybe[Int] + +ok my $Maybe_Int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]') + => 'made TC Maybe[Int]'; + +ok $Maybe_Int->check(1) + => 'passed (1)'; + +ok $obj->Maybe_Int(1) + => 'assigned (1)'; + +ok $Maybe_Int->check() + => 'passed ()'; + +ok $obj->Maybe_Int() + => 'assigned ()'; + +ok $Maybe_Int->check(0) + => 'passed (0)'; + +ok defined $obj->Maybe_Int(0) + => 'assigned (0)'; + +ok $Maybe_Int->check(undef) + => 'passed (undef)'; + +ok sub {$obj->Maybe_Int(undef); 1}->() + => 'assigned (undef)'; + +ok !$Maybe_Int->check("") + => 'failed ("")'; + +like( exception { $obj->Maybe_Int("") }, qr/Attribute \(Maybe_Int\) does not pass the type constraint/, 'failed assigned ("")' ); + +ok !$Maybe_Int->check("a") + => 'failed ("a")'; + +like( exception { $obj->Maybe_Int("a") }, qr/Attribute \(Maybe_Int\) does not pass the type constraint/, 'failed assigned ("a")' ); + +done_testing; |