[gitmo/MooseX-Types-Structured.git] / t / constraints.t

BEGIN {
	use strict;
	use warnings;
	use Test::More tests=>42;
	use Test::Exception;
}

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

    use Moose;
    use Moose::Util::TypeConstraints;
    use MooseX::Meta::TypeConstraint::Structured::Named;
    use MooseX::Meta::TypeConstraint::Structured::Positional;

    subtype 'MyString',
     as 'Str',
     where { $_=~m/abc/};

    sub Tuple {
        my ($args, $optional) = @_;
        my @args = @$args;
        my @optional = ref $optional eq 'ARRAY' ? @$optional : ();

        return MooseX::Meta::TypeConstraint::Structured::Positional->new(
            name => 'Tuple',
            parent => find_type_constraint('ArrayRef'),
            package_defined_in => __PACKAGE__,
            signature => [map {
				_normalize_type_constraint($_);
			} @args],
            optional_signature => [map {
				_normalize_type_constraint($_);
			} @optional],
        );
    }

    sub Dict {
        my ($args, $optional) = @_;
        my %args = @$args;
        my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
        
        return MooseX::Meta::TypeConstraint::Structured::Named->new(
            name => 'Dict',
            parent => find_type_constraint('HashRef'),
            package_defined_in => __PACKAGE__,
            signature => {map {
				$_ => _normalize_type_constraint($args{$_});
			} keys %args},
            optional_signature => {map {
				$_ => _normalize_type_constraint($optional{$_});
			} keys %optional},
        );
    }

	sub _normalize_type_constraint {
		my $tc = shift @_;
		if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
			return $tc;
		} elsif($tc) {
			return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
		}
	}

    has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
    has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
    has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);	
	has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
	has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
	has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
    has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
    has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
    
    has 'crazy' => (
        is=>'rw',
        isa=>Tuple(
            ## First ArrayRef Arg is the required type constraints for the top
            ## level Tuple.
            [
                'Int',
                'MyString',
                ## The third required element is a Dict type constraint, which
                ## itself has two required keys and a third optional key.
                Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
            ],
            ## Second ArrayRef Arg defines the optional constraints for the top
            ## level Tuple.
            [
                'Int',
                ## This Tuple has one required type constraint and two optional.
                Tuple(
                      ['Int'],
                      ['Int','HashRef'],
                ),
            ],        
        )
    );
}

## Instantiate a new test object

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

lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
} => 'Set crazy attribute with no optionals used';

is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
 => 'correct values for crazy attributes no optionals';
 
lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
} => 'Set crazy attribute with all optionals used';

is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
 => 'correct values for crazy attributes all optionals';

lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
} => 'Set crazy attribute with some optionals used';

throws_ok sub {
    $record->crazy([1,'hello', 'test.xxx.test']);    
}, qr/Validation failed for 'MyString'/
 => 'Properly failed for bad value in crazy attribute 01';

throws_ok sub {
    $record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);    
}, qr/Validation failed for 'Str'/
 => 'Properly failed for bad value in crazy attribute 02';
 
## Test Tuple type constraint

lives_ok sub {
    $record->tuple([1,'hello', 'test.abc.test']);
} => 'Set tuple attribute without error';

is $record->tuple->[0], 1
 => 'correct set the tuple attribute index 0';

is $record->tuple->[1], 'hello'
 => 'correct set the tuple attribute index 1';

is $record->tuple->[2], 'test.abc.test'
 => 'correct set the tuple attribute index 2';

throws_ok sub {
    $record->tuple([1,'hello', 'test.xxx.test']);    
}, qr/Validation failed for 'MyString'/
 => 'Properly failed for bad value in custom type constraint';
 
throws_ok sub {
    $record->tuple(['asdasd',2, 'test.abc.test']);      
}, qr/Validation failed for 'Int'/
 => 'Got Expected Error for violating constraints';

## Test the Dictionary type constraint
 
lives_ok sub {
    $record->dict({name=>'frith', age=>23});
} => 'Set dict attribute without error';

is $record->dict->{name}, 'frith'
 => 'correct set the dict attribute name';

is $record->dict->{age}, 23
 => 'correct set the dict attribute age';
 
throws_ok sub {
    $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for bad value in dict';

## Test tuple_with_maybe

lives_ok sub {
    $record->tuple_with_maybe([1,'hello', 1]);
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->tuple_with_maybe([1,'hello', 'a']);
}, qr/Validation failed for 'Maybe\[Int\]'/
 => 'Properly failed for bad value parameterized constraint';

lives_ok sub {
    $record->tuple_with_maybe([1,'hello']);
} => 'Set tuple attribute without error skipping optional parameter';

## Test Tuple with parameterized type

lives_ok sub {
    $record->tuple_with_param([1,'hello', [1,2,3]]);
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->tuple_with_param([1,'hello', [qw/a b c/]]);
}, qr/Validation failed for 'ArrayRef\[Int\]'/
 => 'Properly failed for bad value parameterized constraint';

## Test dict_with_maybe

lives_ok sub {
    $record->dict_with_maybe({name=>'frith', age=>23});
} => 'Set dict attribute without error';

is $record->dict_with_maybe->{name}, 'frith'
 => 'correct set the dict attribute name';

is $record->dict_with_maybe->{age}, 23
 => 'correct set the dict attribute age';
 
throws_ok sub {
    $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for bad value in dict';

throws_ok sub {
    $record->dict_with_maybe({age=>30});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for missing named parameter';

lives_ok sub {
    $record->dict_with_maybe({name=>'usal'});
} => 'Set dict attribute without error, skipping optional';

## Test dict_with_tuple

lives_ok sub {
    $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
}, qr/Validation failed for 'Int'/
 => 'Threw error on bad constraint';

## Test optional_tuple

lives_ok sub {
    $record->optional_tuple([1,2,3]);
} => 'Set tuple attribute with optional bits';

is_deeply $record->optional_tuple, [1,2,3]
 => 'correct values set';
 
lives_ok sub {
    $record->optional_tuple([4,5]);
} => 'Set tuple attribute withOUT optional bits';

is_deeply $record->optional_tuple, [4,5]
 => 'correct values set again';
 
throws_ok sub {
    $record->optional_tuple([1,2,'bad']);   
}, qr/Validation failed for 'Int'/
 => 'Properly failed for bad value in optional bit';

# Test optional_dict

lives_ok sub {
    $record->optional_dict({key1=>1,key2=>2});
} => 'Set tuple attribute with optional bits';

is_deeply $record->optional_dict, {key1=>1,key2=>2}
 => 'correct values set';
 
lives_ok sub {
    $record->optional_dict({key1=>3});
} => 'Set tuple attribute withOUT optional bits';

is_deeply $record->optional_dict, {key1=>3}
 => 'correct values set again';
 
throws_ok sub {
    $record->optional_dict({key1=>1,key2=>'bad'});   
}, qr/Validation failed for 'Int'/
 => 'Properly failed for bad value in optional bit';
Commit	Line	Data
65748864	1	BEGIN {
	2	use strict;
	3	use warnings;
0f766471	4	use Test::More tests=>42;
65748864	5	use Test::Exception;
	6	}
	7
	8	{
bc64165b	9	package Test::MooseX::Meta::TypeConstraint::Structured;
65748864	10
	11	use Moose;
	12	use Moose::Util::TypeConstraints;
9a491c80	13	use MooseX::Meta::TypeConstraint::Structured::Named;
9a491c80	14	use MooseX::Meta::TypeConstraint::Structured::Positional;
9a920d27	15
c3abf064	16	subtype 'MyString',
	17	as 'Str',
	18	where { $_=~m/abc/};
9a920d27	19
65748864	20	sub Tuple {
9a491c80	21	my ($args, $optional) = @_;
	22	my @args = @$args;
	23	my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
	24
	25	return MooseX::Meta::TypeConstraint::Structured::Positional->new(
65748864	26	name => 'Tuple',
	27	parent => find_type_constraint('ArrayRef'),
	28	package_defined_in => __PACKAGE__,
8b276dd4	29	signature => [map {
9a920d27	30	_normalize_type_constraint($_);
8b276dd4	31	} @args],
b5f77bd3	32	optional_signature => [map {
	33	_normalize_type_constraint($_);
	34	} @optional],
bc64165b	35	);
bc64165b	36	}
9a920d27	37
bc64165b	38	sub Dict {
9a491c80	39	my ($args, $optional) = @_;
9a491c80	40	my %args = @$args;
6479ca33	41	my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
9a491c80	42
9a491c80	43	return MooseX::Meta::TypeConstraint::Structured::Named->new(
8b276dd4	44	name => 'Dict',
bc64165b	45	parent => find_type_constraint('HashRef'),
bc64165b	46	package_defined_in => __PACKAGE__,
8b276dd4	47	signature => {map {
9a920d27	48	$_ => _normalize_type_constraint($args{$_});
8b276dd4	49	} keys %args},
b5f77bd3	50	optional_signature => {map {
	51	$_ => _normalize_type_constraint($optional{$_});
	52	} keys %optional},
65748864	53	);
65748864	54	}
c3abf064	55
9a920d27	56	sub _normalize_type_constraint {
9a920d27	57	my $tc = shift @_;
0f766471	58	if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
9a920d27	59	return $tc;
	60	} elsif($tc) {
	61	return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
	62	}
	63	}
	64
c3abf064	65	has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
bc64165b	66	has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
8b276dd4	67	has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
	68	has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
	69	has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
9a920d27	70	has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
b5f77bd3	71	has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
0f766471	72	has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
	73
	74	has 'crazy' => (
	75	is=>'rw',
	76	isa=>Tuple(
	77	## First ArrayRef Arg is the required type constraints for the top
	78	## level Tuple.
	79	[
	80	'Int',
	81	'MyString',
	82	## The third required element is a Dict type constraint, which
	83	## itself has two required keys and a third optional key.
	84	Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
	85	],
	86	## Second ArrayRef Arg defines the optional constraints for the top
	87	## level Tuple.
	88	[
	89	'Int',
	90	## This Tuple has one required type constraint and two optional.
	91	Tuple(
	92	['Int'],
	93	['Int','HashRef'],
	94	),
	95	],
	96	)
	97	);
65748864	98	}
	99
	100	## Instantiate a new test object
	101
bc64165b	102	ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
65748864	103	=> 'Instantiated new Record test class.';
65748864	104
bc64165b	105	isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
65748864	106	=> 'Created correct object type.';
0f766471	107
	108	## Test crazy
	109
	110	lives_ok sub {
	111	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
	112	} => 'Set crazy attribute with no optionals used';
	113
	114	is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
	115	=> 'correct values for crazy attributes no optionals';
	116
	117	lives_ok sub {
	118	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
	119	} => 'Set crazy attribute with all optionals used';
	120
	121	is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
	122	=> 'correct values for crazy attributes all optionals';
b5f77bd3	123
0f766471	124	lives_ok sub {
	125	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
	126	} => 'Set crazy attribute with some optionals used';
	127
	128	throws_ok sub {
	129	$record->crazy([1,'hello', 'test.xxx.test']);
	130	}, qr/Validation failed for 'MyString'/
	131	=> 'Properly failed for bad value in crazy attribute 01';
	132
	133	throws_ok sub {
	134	$record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);
	135	}, qr/Validation failed for 'Str'/
	136	=> 'Properly failed for bad value in crazy attribute 02';
	137
bc64165b	138	## Test Tuple type constraint
bc64165b	139
65748864	140	lives_ok sub {
c3abf064	141	$record->tuple([1,'hello', 'test.abc.test']);
65748864	142	} => 'Set tuple attribute without error';
	143
	144	is $record->tuple->[0], 1
	145	=> 'correct set the tuple attribute index 0';
	146
	147	is $record->tuple->[1], 'hello'
	148	=> 'correct set the tuple attribute index 1';
	149
c3abf064	150	is $record->tuple->[2], 'test.abc.test'
	151	=> 'correct set the tuple attribute index 2';
	152
	153	throws_ok sub {
	154	$record->tuple([1,'hello', 'test.xxx.test']);
	155	}, qr/Validation failed for 'MyString'/
	156	=> 'Properly failed for bad value in custom type constraint';
	157
65748864	158	throws_ok sub {
c3abf064	159	$record->tuple(['asdasd',2, 'test.abc.test']);
65748864	160	}, qr/Validation failed for 'Int'/
	161	=> 'Got Expected Error for violating constraints';
	162
bc64165b	163	## Test the Dictionary type constraint
	164
	165	lives_ok sub {
	166	$record->dict({name=>'frith', age=>23});
	167	} => 'Set dict attribute without error';
	168
	169	is $record->dict->{name}, 'frith'
	170	=> 'correct set the dict attribute name';
	171
	172	is $record->dict->{age}, 23
	173	=> 'correct set the dict attribute age';
	174
	175	throws_ok sub {
	176	$record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
	177	}, qr/Validation failed for 'Str'/
	178	=> 'Got Expected Error for bad value in dict';
8b276dd4	179
	180	## Test tuple_with_maybe
	181
	182	lives_ok sub {
	183	$record->tuple_with_maybe([1,'hello', 1]);
	184	} => 'Set tuple attribute without error';
	185
	186	throws_ok sub {
	187	$record->tuple_with_maybe([1,'hello', 'a']);
	188	}, qr/Validation failed for 'Maybe\[Int\]'/
	189	=> 'Properly failed for bad value parameterized constraint';
	190
	191	lives_ok sub {
	192	$record->tuple_with_maybe([1,'hello']);
	193	} => 'Set tuple attribute without error skipping optional parameter';
	194
	195	## Test Tuple with parameterized type
	196
	197	lives_ok sub {
	198	$record->tuple_with_param([1,'hello', [1,2,3]]);
	199	} => 'Set tuple attribute without error';
	200
	201	throws_ok sub {
	202	$record->tuple_with_param([1,'hello', [qw/a b c/]]);
	203	}, qr/Validation failed for 'ArrayRef\[Int\]'/
	204	=> 'Properly failed for bad value parameterized constraint';
	205
	206	## Test dict_with_maybe
	207
	208	lives_ok sub {
	209	$record->dict_with_maybe({name=>'frith', age=>23});
	210	} => 'Set dict attribute without error';
	211
	212	is $record->dict_with_maybe->{name}, 'frith'
	213	=> 'correct set the dict attribute name';
	214
	215	is $record->dict_with_maybe->{age}, 23
	216	=> 'correct set the dict attribute age';
	217
	218	throws_ok sub {
	219	$record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
	220	}, qr/Validation failed for 'Str'/
	221	=> 'Got Expected Error for bad value in dict';
	222
	223	throws_ok sub {
	224	$record->dict_with_maybe({age=>30});
	225	}, qr/Validation failed for 'Str'/
	226	=> 'Got Expected Error for missing named parameter';
	227
	228	lives_ok sub {
	229	$record->dict_with_maybe({name=>'usal'});
	230	} => 'Set dict attribute without error, skipping optional';
9a920d27	231
	232	## Test dict_with_tuple
	233
	234	lives_ok sub {
	235	$record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
	236	} => 'Set tuple attribute without error';
	237
	238	throws_ok sub {
	239	$record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
	240	}, qr/Validation failed for 'Int'/
	241	=> 'Threw error on bad constraint';
	242
b5f77bd3	243	## Test optional_tuple
9a920d27	244
b5f77bd3	245	lives_ok sub {
	246	$record->optional_tuple([1,2,3]);
	247	} => 'Set tuple attribute with optional bits';
	248
	249	is_deeply $record->optional_tuple, [1,2,3]
	250	=> 'correct values set';
	251
	252	lives_ok sub {
	253	$record->optional_tuple([4,5]);
	254	} => 'Set tuple attribute withOUT optional bits';
	255
	256	is_deeply $record->optional_tuple, [4,5]
	257	=> 'correct values set again';
	258
	259	throws_ok sub {
	260	$record->optional_tuple([1,2,'bad']);
	261	}, qr/Validation failed for 'Int'/
	262	=> 'Properly failed for bad value in optional bit';
9a920d27	263
6479ca33	264	# Test optional_dict
	265
	266	lives_ok sub {
	267	$record->optional_dict({key1=>1,key2=>2});
	268	} => 'Set tuple attribute with optional bits';
	269
	270	is_deeply $record->optional_dict, {key1=>1,key2=>2}
	271	=> 'correct values set';
	272
	273	lives_ok sub {
	274	$record->optional_dict({key1=>3});
	275	} => 'Set tuple attribute withOUT optional bits';
	276
	277	is_deeply $record->optional_dict, {key1=>3}
	278	=> 'correct values set again';
	279
	280	throws_ok sub {
	281	$record->optional_dict({key1=>1,key2=>'bad'});
	282	}, qr/Validation failed for 'Int'/
	283	=> 'Properly failed for bad value in optional bit';
6479ca33	284