4 use Test::More tests=>17;
9 package Test::MooseX::Meta::TypeConstraint::Structured::Concept;
12 use Moose::Util::TypeConstraints;
15 if(defined $_[0] && ref $_[0] eq 'ARRAY') {
18 confess 'Arguments not normal';
23 my ($canonical_key, $value) = _normalize_args(shift);
27 my ($key, $extra) = keys %$_;
28 ($key eq $canonical_key) && !$extra;
33 my @args = _normalize_args(shift);
38 foreach my $idx (0..$#args) {
39 find_type_constraint($args[$idx])->check($incoming[$idx]) ||
40 confess 'Trouble validating Tuple';
46 my %keys_typeconstraints = _normalize_args(shift);
51 foreach my $key (keys %keys_typeconstraints) {
52 my $type_constraint = $keys_typeconstraints{$key};
53 my $incoming = $incoming{$key} || confess "Missing $key";
54 find_type_constraint($type_constraint)->check($incoming)
55 || confess "Trouble validating Dictionary";
60 has 'pair' => (is=>'rw', isa=>Pair[key=>'Str']);
61 has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str']);
62 has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
65 ## Instantiate a new test object
67 ok my $record = Test::MooseX::Meta::TypeConstraint::Structured::Concept->new
68 => 'Instantiated new Record test class.';
70 isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured::Concept'
71 => 'Created correct object type.';
73 ## Test the Pair type constraint
76 $record->pair({key=>'value'});
77 } => 'Set pair attribute without error';
79 is $record->pair->{key}, 'value'
80 => 'correctly set the pair attribute';
83 $record->pair({not_the_key=>'value'}) ;
84 }, qr/Validation failed/
85 => 'Got Expected Error for bad key';
88 $record->pair({key=>[1,2,3]}) ;
89 }, qr/Validation failed/
90 => 'Got Expected Error for bad value';
92 ## Test the Tuple type constraint
95 $record->tuple([1,'hello']);
96 } => 'Set tuple attribute without error';
98 is $record->tuple->[0], 1
99 => 'correct set the tuple attribute index 0';
101 is $record->tuple->[1], 'hello'
102 => 'correct set the tuple attribute index 1';
105 $record->tuple('hello') ;
106 }, qr/Validation failed/
107 => 'Got Expected Error when setting as a scalar';
110 $record->tuple({key=>[1,2,3]}) ;
111 }, qr/Validation failed/
112 => 'Got Expected Error for trying a hashref ';
115 $record->tuple(['asdasd',2]) ;
116 }, qr/Trouble validating Tuple/
117 => 'Got Expected Error for violating constraints';
119 ## Test the Dictionary type constraint
122 $record->dict({name=>'frith', age=>23});
123 } => 'Set dict attribute without error';
125 is $record->dict->{name}, 'frith'
126 => 'correct set the dict attribute name';
128 is $record->dict->{age}, 23
129 => 'correct set the dict attribute age';
132 $record->dict('hello') ;
133 }, qr/Validation failed/
134 => 'Got Expected Error for bad key in dict';
137 $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
138 }, qr/Trouble validating Dictionary/
139 => 'Got Expected Error for bad value in dict';