+++ /dev/null
-BEGIN {
- use strict;
- use warnings;
- use Test::More tests=>16;
- use Test::Exception;
- use Data::Dump qw/dump/;
-
- use_ok 'Moose::Util::TypeConstraints';
-}
-
-Moose::Util::TypeConstraints::register_type_constraint(
- Moose::Meta::TypeConstraint::Parameterizable->new(
- name => 'Optional',
- package_defined_in => __PACKAGE__,
- parent => find_type_constraint('Item'),
- constraint => sub { 1 },
- constraint_generator => sub {
- my $type_parameter = shift;
- my $check = $type_parameter->_compiled_type_constraint;
- return sub {
- use Data::Dump qw/dump/;
- warn dump @_;
- return 1 if not(defined($_)) || $check->($_);
- return;
- }
- }
- )
-);
-
-ok Moose::Util::TypeConstraints::find_type_constraint('Optional')
- => 'Found the Optional Type';
-
-{
- package Test::MooseX::Types::Optional;
- 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::Optional->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 ("")';
-
- throws_ok sub { $obj->Maybe_Int("") },
- qr/Attribute \(Maybe_Int\) does not pass the type constraint/
- => 'failed assigned ("")';
-
-ok !$Maybe_Int->check("a")
- => 'failed ("a")';
-
- throws_ok sub { $obj->Maybe_Int("a") },
- qr/Attribute \(Maybe_Int\) does not pass the type constraint/
- => 'failed assigned ("a")';
-
-__END__
-
-
-ok $obj->Maybe_Int(undef)
- => 'passed 1';
-
-ok $obj->Maybe_Int();
-
-ok $obj->Maybe_Int('')
- => 'passed 1';
-
-ok $obj->Maybe_Int('a')
- => 'passed 1';
-
-
-
-
-ok $obj->tuple([1,'hello',3])
- => "[1,'hello',3] properly suceeds";
-
-throws_ok sub {
- $obj->tuple([1,2,'world']);
-}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
-
-throws_ok sub {
- $obj->tuple(['hello1',2,3]);
-}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
-
-throws_ok sub {
- $obj->tuple(['hello2',2,'world']);
-}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
-
-
-## Test tuple_with_parameterized (Tuple[Int,Str,Int,ArrayRef[Int]])
-
-ok $obj->tuple_with_parameterized([1,'hello',3,[1,2,3]])
- => "[1,'hello',3,[1,2,3]] properly suceeds";
-
-throws_ok sub {
- $obj->tuple_with_parameterized([1,2,'world']);
-}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_parameterized(['hello1',2,3]);
-}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_parameterized(['hello2',2,'world']);
-}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_parameterized([1,'hello',3,[1,2,'world']]);
-}, qr/Validation failed for 'ArrayRef\[Int\]'/ => "[1,'hello',3,[1,2,'world']] properly fails";
-
-
-## Test tuple_with_optional (Tuple[Int,Str,Int,Optional[Int,Int]])
-
-ok $obj->tuple_with_optional([1,'hello',3])
- => "[1,'hello',3] properly suceeds";
-
-ok $obj->tuple_with_optional([1,'hello',3,1])
- => "[1,'hello',3,1] properly suceeds";
-
-ok $obj->tuple_with_optional([1,'hello',3,4])
- => "[1,'hello',3,4] properly suceeds";
-
-ok $obj->tuple_with_optional([1,'hello',3,4,5])
- => "[1,'hello',3,4,5] properly suceeds";
-
-throws_ok sub {
- $obj->tuple_with_optional([1,'hello',3,4,5,6]);
-}, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_optional([1,2,'world']);
-}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_optional(['hello1',2,3]);
-}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
-
-throws_ok sub {
- $obj->tuple_with_optional(['hello2',2,'world']);
-}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
-
-## tuple_with_union Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]]
-
-SKIP: {
-
- skip "Unions not supported for string parsed type constraints" => 8;
-
- ok $obj->tuple_with_union([1,'hello',3])
- => "[1,'hello',3] properly suceeds";
-
- ok $obj->tuple_with_union([1,'hello',3,1])
- => "[1,'hello',3,1] properly suceeds";
-
- ok $obj->tuple_with_union([1,'hello',3,4])
- => "[1,'hello',3,4] properly suceeds";
-
- ok $obj->tuple_with_union([1,'hello',3,4,5])
- => "[1,'hello',3,4,5] properly suceeds";
-
- throws_ok sub {
- $obj->tuple_with_union([1,'hello',3,4,5,6]);
- }, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails";
-
- throws_ok sub {
- $obj->tuple_with_union([1,2,'world']);
- }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
-
- throws_ok sub {
- $obj->tuple_with_union(['hello1',2,3]);
- }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
-
- throws_ok sub {
- $obj->tuple_with_union(['hello2',2,'world']);
- }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
-}
-
projects / gitmo/MooseX-Types-Structured.git / blobdiff