Add MX_PARAMS_VALIDATE_ALLOW_EXTRA
[gitmo/MooseX-Params-Validate.git] / t / 005_coercion.t
CommitLineData
d9d1529d 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 15;
7use Test::Exception;
8
9# Note that setting coerce => 1 for the Num type tests that we don't try to do
10# coercions for a type which doesn't have any coercions.
11{
12 package Foo;
13 use Moose;
14 use Moose::Util::TypeConstraints;
15 use MooseX::Params::Validate;
16
17 subtype 'Size' => as 'Int' => where { $_ >= 0 };
18
19 coerce 'Size' => from 'ArrayRef' => via { scalar @{$_} };
20
21 sub bar {
22 my $self = shift;
23 my %params = validated_hash(
24 \@_,
25 size1 => { isa => 'Size', coerce => 1 },
26 size2 => { isa => 'Size', coerce => 0 },
27 number => { isa => 'Num', coerce => 1 },
28 );
29 [ $params{size1}, $params{size2}, $params{number} ];
30 }
31
32 # added to test 'optional' on validated_hash
33 sub baropt {
34 my $self = shift;
35 my %params = validated_hash(
36 \@_,
37 size1 => { isa => 'Size', coerce => 1, optional => 1 },
38 size2 => { isa => 'Size', coerce => 0, optional => 1 },
39 number => { isa => 'Num', coerce => 1, optional => 1 },
40 );
41 [ $params{size1}, $params{size2}, $params{number} ];
42 }
43
44
45 sub baz {
46 my $self = shift;
47 my ( $size1, $size2, $number ) = validated_list(
48 \@_,
49 size1 => { isa => 'Size', coerce => 1 },
50 size2 => { isa => 'Size', coerce => 0 },
51 number => { isa => 'Num', coerce => 1 },
52 );
53 [ $size1, $size2, $number ];
54 }
55
56
57 sub quux {
58 my $self = shift;
59 my ( $size1, $size2, $number ) = validated_list(
60 \@_,
61 size1 => { isa => 'Size', coerce => 1, optional => 1 },
62 size2 => { isa => 'Size', coerce => 0, optional => 1 },
63 number => { isa => 'Num', coerce => 1, optional => 1 },
64 );
65 [ $size1, $size2, $number ];
66 }
67
68 sub ran_out {
69 my $self = shift;
70 my ( $size1, $size2, $number ) = pos_validated_list(
71 \@_,
72 { isa => 'Size', coerce => 1, optional => 1 },
73 { isa => 'Size', coerce => 0, optional => 1 },
74 { isa => 'Num', coerce => 1, optional => 1 },
75 );
76 [ $size1, $size2, $number ];
77 }
78}
79
80my $foo = Foo->new;
81isa_ok( $foo, 'Foo' );
82
83is_deeply(
84 $foo->bar( size1 => 10, size2 => 20, number => 30 ),
85 [ 10, 20, 30 ],
86 'got the return value right without coercions'
87);
88
89is_deeply(
90 $foo->bar( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
91 [ 3, 20, 30 ],
92 'got the return value right with coercions for size1'
93);
94
95throws_ok { $foo->bar( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
96qr/\QThe 'size2' parameter/,
97 '... the size2 param cannot be coerced';
98
99throws_ok { $foo->bar( size1 => 30, size2 => 10, number => 'something' ) }
100qr/\QThe 'number' parameter/,
101 '... the number param cannot be coerced because there is no coercion defined for Num';
102
103is_deeply(
104 $foo->baz( size1 => 10, size2 => 20, number => 30 ),
105 [ 10, 20, 30 ],
106 'got the return value right without coercions'
107);
108
109is_deeply(
110 $foo->baz( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
111 [ 3, 20, 30 ],
112 'got the return value right with coercions for size1'
113);
114
115throws_ok { $foo->baz( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
116qr/\QThe 'size2' parameter/,
117 '... the size2 param cannot be coerced';
118
119throws_ok { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
120qr/\QThe 'number' parameter/,
121 '... the number param cannot be coerced';
122
123is_deeply(
124 $foo->baropt( size2 => 4 ),
125 [ undef, 4, undef ],
126 '... validated_hash does not try to coerce keys which are not provided'
127);
128
129is_deeply(
130 $foo->quux( size2 => 4 ),
131 [ undef, 4, undef ],
132 '... validated_list does not try to coerce keys which are not provided'
133);
134
135is_deeply(
136 $foo->ran_out( 1, 2, 3 ),
137 [ 1, 2, 3 ],
138 'got the return value right without coercions'
139);
140
141is_deeply(
142 $foo->ran_out( [1], 2, 3 ),
143 [ 1, 2, 3 ],
144 'got the return value right with coercion for the first param'
145);
146
147throws_ok { $foo->ran_out( [ 1, 2 ], [ 1, 2 ] ) }
148qr/\QParameter #2/,
149 '... did not attempt to coerce the second parameter';
150
151
152is_deeply(
153 $foo->ran_out(),
154 [ undef, undef, undef ],
155 'did not try to coerce non-existent parameters'
156);