[gitmo/MooseX-Types-Structured.git] / t / 09-optional.t

use strict;
use warnings;

use Test::More tests=>46;
use Test::Exception;
use Moose::Util::TypeConstraints;
use MooseX::Types::Structured qw(Optional);

APITEST: {

	ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
	 => 'Got Optional';
	
	isa_ok $Optional
	 => 'Moose::Meta::TypeConstraint::Parameterizable';
	
	ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
	 => 'Got Int';
	
	ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
	 => 'Got ArrayRef[Int]';
	
	BASIC: {
		ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
		ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
		
		ok $Optional_Int->check() => 'Optional is allowed to not exist';
		
		ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
		ok $Optional_Int->check(199) => 'Correctly validates 199';
		ok !$Optional_Int->check("a") => 'Correctly fails "a"';
		
		ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
		ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
		ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
		ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
		ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';	
	}
	
	SUBREF: {
		ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
		ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
		
		ok $Optional_Int->check() => 'Optional is allowed to not exist';
		
		ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
		ok $Optional_Int->check(199) => 'Correctly validates 199';
		ok !$Optional_Int->check("a") => 'Correctly fails "a"';
		
		ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
		ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
		ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
		ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
		ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';		
	}
}

OBJECTTEST: {
    package Test::MooseX::Meta::TypeConstraint::Structured::Optional;

    use Moose;
    use MooseX::Types::Structured qw(Dict Tuple Optional);
	use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
	use MooseX::Types -declare => [qw(
        MoreThanFive TupleOptional1 TupleOptional2 Gender DictOptional1 Insane
    )];
	
    subtype MoreThanFive,
     as Int,
     where { $_ > 5};
	 
	enum Gender,
	 qw/male female transgendered/;
	 
    subtype TupleOptional1() =>
		as Tuple[Int, MoreThanFive, Optional[Str|Object]];

    subtype TupleOptional2,
		as Tuple[Int, MoreThanFive, Optional[HashRef[Int|Object]]];
		
	subtype DictOptional1,
		as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
		
	subtype Insane,
		as Tuple[
			Int,
			Optional[Str|Object],
			DictOptional1,
			Optional[ArrayRef[Int]]
		];
    
    has 'TupleOptional1Attr' => (is=>'rw', isa=>TupleOptional1);
    has 'TupleOptional2Attr' => (is=>'rw', isa=>TupleOptional2);
    has 'DictOptional1Attr' => (is=>'rw', isa=>DictOptional1);	
	has 'InsaneAttr' => (is=>'rw', isa=>Insane);	
}

ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Optional->new
 => 'Instantiated new test class.';
 
isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
 => 'Created correct object type.';
 
# Test Insane

lives_ok sub {
    $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]);
} => 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]';

lives_ok sub {
    $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[1,2,3]]);
} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]';

lives_ok sub {
    $obj->InsaneAttr([1,$obj,{name=>"John",age=>39}]);
} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]';

throws_ok sub {
    $obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);   
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
 => q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]};

throws_ok sub {
    $obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);   
}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
 => q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]};
 
# Test TupleOptional1Attr

lives_ok sub {
    $obj->TupleOptional1Attr([1,10,"hello"]);
} => 'Set TupleOptional1Attr attribute without error [1,10,"hello"]';

lives_ok sub {
    $obj->TupleOptional1Attr([1,10,$obj]);
} => 'Set TupleOptional1Attr attribute without error [1,10,$obj]';

lives_ok sub {
    $obj->TupleOptional1Attr([1,10]);
} => 'Set TupleOptional1Attr attribute without error [1,10]';

throws_ok sub {
    $obj->TupleOptional1Attr([1,10,[1,2,3]]);    
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
 => q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]};

throws_ok sub {
    $obj->TupleOptional1Attr([1,10,undef]);    
}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
 => q{TupleOptional1Attr correctly fails [1,10,undef]};
 
# Test TupleOptional2Attr

lives_ok sub {
    $obj->TupleOptional2Attr([1,10,{key1=>1,key2=>$obj}]);
} => 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]';

lives_ok sub {
    $obj->TupleOptional2Attr([1,10]);
} => 'Set TupleOptional2Attr attribute without error [1,10]'; 

throws_ok sub {
    $obj->TupleOptional2Attr([1,10,[1,2,3]]);    
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
 => q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]};

throws_ok sub {
    $obj->TupleOptional2Attr([1,10,undef]);    
}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
 => q{TupleOptional2Attr correctly fails [1,10,undef]};
 
# Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
 
lives_ok sub {
    $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
} => 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}';

lives_ok sub {
    $obj->DictOptional1Attr({name=>"Vanessa",age=>34});
} => 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}';

throws_ok sub {
    $obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});    
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
 => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}};

throws_ok sub {
    $obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});    
}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
 => q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}};
Commit	Line	Data
fbb43338	1	use strict;
	2	use warnings;
	3
190a34eb	4	use Test::More tests=>46;
190a34eb	5	use Test::Exception;
fbb43338	6	use Moose::Util::TypeConstraints;
e327145a	7	use MooseX::Types::Structured qw(Optional);
e327145a	8
190a34eb	9	APITEST: {
e327145a	10
190a34eb	11	ok my $Optional = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MooseX::Types::Structured::Optional')
190a34eb	12	=> 'Got Optional';
e327145a	13
190a34eb	14	isa_ok $Optional
190a34eb	15	=> 'Moose::Meta::TypeConstraint::Parameterizable';
e327145a	16
190a34eb	17	ok my $int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Int')
190a34eb	18	=> 'Got Int';
e327145a	19
190a34eb	20	ok my $arrayref = Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]')
190a34eb	21	=> 'Got ArrayRef[Int]';
e327145a	22
190a34eb	23	BASIC: {
	24	ok my $Optional_Int = $Optional->parameterize($int), 'Parameterized Int';
	25	ok my $Optional_ArrayRef = $Optional->parameterize($arrayref), 'Parameterized ArrayRef';
	26
	27	ok $Optional_Int->check() => 'Optional is allowed to not exist';
	28
	29	ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
	30	ok $Optional_Int->check(199) => 'Correctly validates 199';
	31	ok !$Optional_Int->check("a") => 'Correctly fails "a"';
	32
	33	ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
	34	ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
	35	ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
	36	ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
	37	ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
	38	}
e327145a	39
190a34eb	40	SUBREF: {
	41	ok my $Optional_Int = Optional->parameterize($int),'Parameterized Int';
	42	ok my $Optional_ArrayRef = Optional->parameterize($arrayref), 'Parameterized ArrayRef';
	43
	44	ok $Optional_Int->check() => 'Optional is allowed to not exist';
	45
	46	ok !$Optional_Int->check(undef) => 'Optional is NOT allowed to be undef';
	47	ok $Optional_Int->check(199) => 'Correctly validates 199';
	48	ok !$Optional_Int->check("a") => 'Correctly fails "a"';
	49
	50	ok $Optional_ArrayRef->check() => 'Optional is allowed to not exist';
	51	ok !$Optional_ArrayRef->check(undef) => 'Optional is NOT allowed to be undef';
	52	ok $Optional_ArrayRef->check([1,2,3]) => 'Correctly validates [1,2,3]';
	53	ok !$Optional_ArrayRef->check("a") => 'Correctly fails "a"';
	54	ok !$Optional_ArrayRef->check(["a","b"]) => 'Correctly fails ["a","b"]';
	55	}
	56	}
	57
	58	OBJECTTEST: {
	59	package Test::MooseX::Meta::TypeConstraint::Structured::Optional;
	60
	61	use Moose;
	62	use MooseX::Types::Structured qw(Dict Tuple Optional);
	63	use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
	64	use MooseX::Types -declare => [qw(
	65	MoreThanFive TupleOptional1 TupleOptional2 Gender DictOptional1 Insane
	66	)];
e327145a	67
190a34eb	68	subtype MoreThanFive,
	69	as Int,
	70	where { $_ > 5};
	71
	72	enum Gender,
	73	qw/male female transgendered/;
	74
3108fd7b	75	subtype TupleOptional1() =>
190a34eb	76	as Tuple[Int, MoreThanFive, Optional[Str\|Object]];
	77
	78	subtype TupleOptional2,
	79	as Tuple[Int, MoreThanFive, Optional[HashRef[Int\|Object]]];
	80
	81	subtype DictOptional1,
	82	as Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
	83
	84	subtype Insane,
	85	as Tuple[
	86	Int,
	87	Optional[Str\|Object],
	88	DictOptional1,
	89	Optional[ArrayRef[Int]]
	90	];
	91
	92	has 'TupleOptional1Attr' => (is=>'rw', isa=>TupleOptional1);
	93	has 'TupleOptional2Attr' => (is=>'rw', isa=>TupleOptional2);
	94	has 'DictOptional1Attr' => (is=>'rw', isa=>DictOptional1);
	95	has 'InsaneAttr' => (is=>'rw', isa=>Insane);
e327145a	96	}
e327145a	97
190a34eb	98	ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Optional->new
	99	=> 'Instantiated new test class.';
	100
	101	isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Optional'
	102	=> 'Created correct object type.';
	103
	104	# Test Insane
	105
	106	lives_ok sub {
	107	$obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]);
	108	} => 'Set InsaneAttr attribute without error [1,"hello",{name=>"John",age=>39,gender=>"male"},[1,2,3]]';
	109
	110	lives_ok sub {
	111	$obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[1,2,3]]);
	112	} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39},[1,2,3]]';
	113
	114	lives_ok sub {
	115	$obj->InsaneAttr([1,$obj,{name=>"John",age=>39}]);
	116	} => 'Set InsaneAttr attribute without error [1,$obj,{name=>"John",age=>39}]';
	117
	118	throws_ok sub {
	119	$obj->InsaneAttr([1,$obj,{name=>"John",age=>39},[qw/a b c/]]);
	120	}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
	121	=> q{InsaneAttr correctly fails [1,$obj,{name=>"John",age=>39},[qw/a b c/]]};
	122
	123	throws_ok sub {
	124	$obj->InsaneAttr([1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]);
	125	}, qr/Attribute \(InsaneAttr\) does not pass the type constraint/
	126	=> q{InsaneAttr correctly fails [1,"hello",{name=>"John",age=>39,gender=>undef},[1,2,3]]};
	127
	128	# Test TupleOptional1Attr
	129
	130	lives_ok sub {
	131	$obj->TupleOptional1Attr([1,10,"hello"]);
	132	} => 'Set TupleOptional1Attr attribute without error [1,10,"hello"]';
	133
	134	lives_ok sub {
	135	$obj->TupleOptional1Attr([1,10,$obj]);
	136	} => 'Set TupleOptional1Attr attribute without error [1,10,$obj]';
	137
	138	lives_ok sub {
	139	$obj->TupleOptional1Attr([1,10]);
	140	} => 'Set TupleOptional1Attr attribute without error [1,10]';
	141
	142	throws_ok sub {
	143	$obj->TupleOptional1Attr([1,10,[1,2,3]]);
	144	}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
	145	=> q{TupleOptional1Attr correctly fails [1,10,[1,2,3]]};
	146
	147	throws_ok sub {
	148	$obj->TupleOptional1Attr([1,10,undef]);
	149	}, qr/Attribute \(TupleOptional1Attr\) does not pass the type constraint/
	150	=> q{TupleOptional1Attr correctly fails [1,10,undef]};
	151
	152	# Test TupleOptional2Attr
	153
	154	lives_ok sub {
	155	$obj->TupleOptional2Attr([1,10,{key1=>1,key2=>$obj}]);
	156	} => 'Set TupleOptional2Attr attribute without error [1,10,{key1=>1,key2=>$obj}]';
	157
	158	lives_ok sub {
	159	$obj->TupleOptional2Attr([1,10]);
	160	} => 'Set TupleOptional2Attr attribute without error [1,10]';
	161
162	throws_ok sub {
163	$obj->TupleOptional2Attr([1,10,[1,2,3]]);
164	}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
165	=> q{TupleOptional2Attr correctly fails [1,10,[1,2,3]]};
166
167	throws_ok sub {
168	$obj->TupleOptional2Attr([1,10,undef]);
169	}, qr/Attribute \(TupleOptional2Attr\) does not pass the type constraint/
170	=> q{TupleOptional2Attr correctly fails [1,10,undef]};
171
172	# Test DictOptional1Attr: Dict[name=>Str, age=>Int, gender=>Optional[Gender]];
173
174	lives_ok sub {
175	$obj->DictOptional1Attr({name=>"John",age=>39,gender=>"male"});
176	} => 'Set DictOptional1Attr attribute without error {name=>"John",age=>39,gender=>"male"}';
177
178	lives_ok sub {
179	$obj->DictOptional1Attr({name=>"Vanessa",age=>34});
180	} => 'Set DictOptional1Attr attribute without error {name=>"Vanessa",age=>34}';
181
182	throws_ok sub {
183	$obj->DictOptional1Attr({name=>"John",age=>39,gender=>undef});
184	}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
185	=> q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>undef}};
fbb43338	186
190a34eb	187	throws_ok sub {
	188	$obj->DictOptional1Attr({name=>"John",age=>39,gender=>"aaa"});
	189	}, qr/Attribute \(DictOptional1Attr\) does not pass the type constraint/
	190	=> q{TupleOptional2Attr correctly fails {name=>"John",age=>39,gender=>"aaa"}};