Commit | Line | Data |
d9d1529d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
d7a80104 |
6 | use Test::More; |
37088308 |
7 | use Test::Fatal; |
d9d1529d |
8 | |
9 | { |
10 | package Roles::Blah; |
11 | use Moose::Role; |
12 | use MooseX::Params::Validate; |
13 | |
14 | requires 'bar'; |
15 | requires 'baz'; |
16 | |
17 | sub foo { |
18 | my ( $self, %params ) = validated_hash( |
19 | \@_, |
20 | bar => { isa => 'Str', default => 'Moose' }, |
21 | ); |
22 | return "Horray for $params{bar}!"; |
23 | } |
24 | |
25 | package Foo; |
26 | use Moose; |
27 | use Moose::Util::TypeConstraints; |
28 | use MooseX::Params::Validate; |
29 | |
30 | with 'Roles::Blah'; |
31 | |
32 | sub bar { |
33 | my $self = shift; |
34 | return [ |
35 | pos_validated_list( |
36 | \@_, |
37 | { isa => 'Foo' }, |
38 | { isa => 'ArrayRef | HashRef', optional => 1 }, |
39 | { isa => 'ArrayRef[Int]', optional => 1 }, |
40 | ) |
41 | ]; |
42 | } |
43 | |
44 | sub baz { |
45 | my $self = shift; |
46 | return [ |
47 | pos_validated_list( |
37088308 |
48 | \@_, { |
d9d1529d |
49 | isa => subtype( 'Object' => where { $_->isa('Foo') } ), |
50 | optional => 1 |
51 | }, |
52 | { does => 'Roles::Blah', optional => 1 }, |
53 | { |
54 | does => role_type('Roles::Blah'), |
55 | optional => 1 |
56 | }, |
57 | ) |
58 | ]; |
59 | } |
60 | } |
61 | |
62 | my $foo = Foo->new; |
63 | isa_ok( $foo, 'Foo' ); |
64 | |
65 | is( $foo->baz($foo)->[0], $foo, '... first param must be a Foo instance' ); |
66 | |
37088308 |
67 | like( |
68 | exception { $foo->baz(10) }, qr/\QParameter #1 ("10")/, |
69 | '... the first param in &baz must be a Foo instance' |
70 | ); |
71 | like( |
72 | exception { $foo->baz('foo') }, qr/\QParameter #1 ("foo")/, |
73 | '... the first param in &baz must be a Foo instance' |
74 | ); |
75 | like( |
76 | exception { $foo->baz( [] ) }, qr/\QParameter #1/, |
77 | '... the first param in &baz must be a Foo instance' |
78 | ); |
79 | |
80 | is( |
81 | $foo->baz( $foo, $foo )->[1], $foo, |
82 | '... second param must do Roles::Blah' |
83 | ); |
84 | |
85 | like( |
86 | exception { $foo->baz( $foo, 10 ) }, qr/\QParameter #2 ("10")/, |
87 | '... the second param in &baz must be do Roles::Blah' |
88 | ); |
89 | like( |
90 | exception { $foo->baz( $foo, 'foo' ) }, qr/\QParameter #2 ("foo")/, |
91 | '... the second param in &baz must be do Roles::Blah' |
92 | ); |
93 | like( |
94 | exception { $foo->baz( $foo, [] ) }, qr/\QParameter #2/, |
95 | '... the second param in &baz must be do Roles::Blah' |
96 | ); |
97 | |
98 | is( |
99 | $foo->baz( $foo, $foo, $foo )->[2], $foo, |
100 | '... third param must do Roles::Blah' |
101 | ); |
102 | |
103 | like( |
104 | exception { $foo->baz( $foo, $foo, 10 ) }, qr/\QParameter #3 ("10")/, |
105 | '... the third param in &baz must be do Roles::Blah' |
106 | ); |
107 | like( |
108 | exception { $foo->baz( $foo, $foo, "foo" ) }, |
109 | qr/\QParameter #3 ("foo")/, |
110 | '... the third param in &baz must be do Roles::Blah' |
111 | ); |
112 | like( |
113 | exception { $foo->baz( $foo, $foo, [] ) }, qr/\QParameter #3/, |
114 | '... the third param in &baz must be do Roles::Blah' |
115 | ); |
116 | |
117 | like( |
118 | exception { $foo->bar }, qr/\Q0 parameters were passed/, |
119 | '... bar has a required params' |
120 | ); |
121 | like( |
122 | exception { $foo->bar(10) }, qr/\QParameter #1 ("10")/, |
123 | '... the first param in &bar must be a Foo instance' |
124 | ); |
125 | like( |
126 | exception { $foo->bar('foo') }, qr/\QParameter #1 ("foo")/, |
127 | '... the first param in &bar must be a Foo instance' |
128 | ); |
129 | like( |
130 | exception { $foo->bar( [] ) }, qr/\QParameter #1/, |
131 | '... the first param in &bar must be a Foo instance' |
132 | ); |
133 | like( |
134 | exception { $foo->bar() }, qr/\Q0 parameters were passed/, |
135 | '... bar has a required first param' |
136 | ); |
d9d1529d |
137 | |
138 | is_deeply( |
139 | $foo->bar($foo), |
140 | [$foo], |
141 | '... the first param in &bar got a Foo instance' |
142 | ); |
143 | |
144 | is_deeply( |
145 | $foo->bar( $foo, [] ), |
146 | [ $foo, [] ], |
147 | '... the first and second param in &bar got correct args' |
148 | ); |
149 | |
150 | is_deeply( |
151 | $foo->bar( $foo, {} ), |
152 | [ $foo, {} ], |
153 | '... the first param and baz param in &bar got correct args' |
154 | ); |
155 | |
37088308 |
156 | like( |
157 | exception { $foo->bar( $foo, undef ) }, qr/\QParameter #2 (undef)/, |
158 | '... second param requires a ArrayRef | HashRef' |
159 | ); |
160 | like( |
161 | exception { $foo->bar( $foo, 10 ) }, qr/\QParameter #2 ("10")/, |
162 | '... second param requires a ArrayRef | HashRef' |
163 | ); |
164 | like( |
165 | exception { $foo->bar( $foo, 'Foo' ) }, qr/\QParameter #2 ("Foo")/, |
166 | '... second param requires a ArrayRef | HashRef' |
167 | ); |
168 | like( |
169 | exception { $foo->bar( $foo, \( my $var ) ) }, qr/\QParameter #2/, |
170 | '... second param requires a ArrayRef | HashRef' |
171 | ); |
d9d1529d |
172 | |
173 | is_deeply( |
174 | $foo->bar( $foo, {}, [ 1, 2, 3 ] ), |
175 | [ $foo, {}, [ 1, 2, 3 ] ], |
176 | '... the first param in &bar got a Foo instance' |
177 | ); |
178 | |
37088308 |
179 | like( |
180 | exception { $foo->bar( $foo, {}, undef ) }, qr/\QParameter #3 (undef)/, |
181 | '... third param a ArrayRef[Int]' |
182 | ); |
183 | like( |
184 | exception { $foo->bar( $foo, {}, 10 ) }, qr/\QParameter #3 ("10")/, |
185 | '... third param a ArrayRef[Int]' |
186 | ); |
187 | like( |
188 | exception { $foo->bar( $foo, {}, 'Foo' ) }, qr/\QParameter #3 ("Foo")/, |
189 | '... third param a ArrayRef[Int]' |
190 | ); |
191 | like( |
192 | exception { $foo->bar( $foo, {}, \( my $var ) ) }, qr/\QParameter #3/, |
193 | '... third param a ArrayRef[Int]' |
194 | ); |
195 | like( |
196 | exception { $foo->bar( $foo, {}, [qw/one two three/] ) }, |
197 | qr/\QParameter #3/, '... third param a ArrayRef[Int]' |
198 | ); |
d9d1529d |
199 | |
d7a80104 |
200 | done_testing(); |