Commit | Line | Data |
d9d1529d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 35; |
7 | use Test::Exception; |
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 | my %params = validated_hash( |
35 | \@_, |
36 | foo => { isa => 'Foo' }, |
37 | baz => { isa => 'ArrayRef | HashRef', optional => 1 }, |
38 | gorch => { isa => 'ArrayRef[Int]', optional => 1 }, |
39 | ); |
40 | [ $params{foo}, $params{baz}, $params{gorch} ]; |
41 | } |
42 | |
43 | sub baz { |
44 | my $self = shift; |
45 | my %params = validated_hash( |
46 | \@_, |
47 | foo => { |
48 | isa => subtype( 'Object' => where { $_->isa('Foo') } ), |
49 | optional => 1 |
50 | }, |
51 | bar => { does => 'Roles::Blah', optional => 1 }, |
52 | boo => { |
53 | does => role_type('Roles::Blah'), |
54 | optional => 1 |
55 | }, |
56 | ); |
57 | return $params{foo} || $params{bar} || $params{boo}; |
58 | } |
59 | |
60 | sub quux { |
61 | my $self = shift; |
62 | my %params = validated_hash( |
63 | \@_, |
64 | foo => { |
65 | isa => 'ArrayRef', |
66 | callbacks => { |
67 | 'some random callback' => sub { @{ $_[0] } <= 2 }, |
68 | }, |
69 | }, |
70 | ); |
71 | |
72 | return $params{foo}; |
73 | } |
74 | } |
75 | |
76 | my $foo = Foo->new; |
77 | isa_ok( $foo, 'Foo' ); |
78 | |
79 | is( $foo->foo, 'Horray for Moose!', '... got the right return value' ); |
80 | is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!', |
81 | '... got the right return value' ); |
82 | |
83 | is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' ); |
84 | |
85 | throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/, |
86 | '... the foo param in &baz must be a Foo instance'; |
87 | throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/, |
88 | '... the foo param in &baz must be a Foo instance'; |
89 | throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/, |
90 | '... the foo param in &baz must be a Foo instance'; |
91 | |
92 | is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' ); |
93 | |
94 | throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/, |
95 | '... the bar param in &baz must be do Roles::Blah'; |
96 | throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/, |
97 | '... the bar param in &baz must be do Roles::Blah'; |
98 | throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/, |
99 | '... the bar param in &baz must be do Roles::Blah'; |
100 | |
101 | is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' ); |
102 | |
103 | throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/, |
104 | '... the boo param in &baz must be do Roles::Blah'; |
105 | throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/, |
106 | '... the boo param in &baz must be do Roles::Blah'; |
107 | throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/, |
108 | '... the boo param in &baz must be do Roles::Blah'; |
109 | |
110 | throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/, |
111 | '... bar has a required param'; |
112 | throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/, |
113 | '... the foo param in &bar must be a Foo instance'; |
114 | throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/, |
115 | '... the foo param in &bar must be a Foo instance'; |
116 | throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/, |
117 | '... the foo param in &bar must be a Foo instance'; |
118 | throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,, |
119 | '... bar has a required foo param'; |
120 | |
121 | is_deeply( |
122 | $foo->bar( foo => $foo ), |
123 | [ $foo, undef, undef ], |
124 | '... the foo param in &bar got a Foo instance' |
125 | ); |
126 | |
127 | is_deeply( |
128 | $foo->bar( foo => $foo, baz => [] ), |
129 | [ $foo, [], undef ], |
130 | '... the foo param and baz param in &bar got a correct args' |
131 | ); |
132 | |
133 | is_deeply( |
134 | $foo->bar( foo => $foo, baz => {} ), |
135 | [ $foo, {}, undef ], |
136 | '... the foo param and baz param in &bar got a correct args' |
137 | ); |
138 | |
139 | throws_ok { $foo->bar( foo => $foo, baz => undef ) } |
140 | qr/\QThe 'baz' parameter (undef)/, |
141 | '... baz requires a ArrayRef | HashRef'; |
142 | throws_ok { $foo->bar( foo => $foo, baz => 10 ) } |
143 | qr/\QThe 'baz' parameter ("10")/, |
144 | '... baz requires a ArrayRef | HashRef'; |
145 | throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) } |
146 | qr/\QThe 'baz' parameter ("Foo")/, |
147 | '... baz requires a ArrayRef | HashRef'; |
148 | throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) } |
149 | qr/\QThe 'baz' parameter/, |
150 | '... baz requires a ArrayRef | HashRef'; |
151 | |
152 | is_deeply( |
153 | $foo->bar( foo => $foo, gorch => [ 1, 2, 3 ] ), |
154 | [ $foo, undef, [ 1, 2, 3 ] ], |
155 | '... the foo param in &bar got a Foo instance' |
156 | ); |
157 | |
158 | throws_ok { $foo->bar( foo => $foo, gorch => undef ) } |
159 | qr/\QThe 'gorch' parameter (undef)/, |
160 | '... gorch requires a ArrayRef[Int]'; |
161 | throws_ok { $foo->bar( foo => $foo, gorch => 10 ) } |
162 | qr/\QThe 'gorch' parameter ("10")/, |
163 | '... gorch requires a ArrayRef[Int]'; |
164 | throws_ok { $foo->bar( foo => $foo, gorch => 'Foo' ) } |
165 | qr/\QThe 'gorch' parameter ("Foo")/, |
166 | '... gorch requires a ArrayRef[Int]'; |
167 | throws_ok { $foo->bar( foo => $foo, gorch => \( my $var ) ) } |
168 | qr/\QThe 'gorch' parameter/, |
169 | '... gorch requires a ArrayRef[Int]'; |
170 | throws_ok { $foo->bar( foo => $foo, gorch => [qw/one two three/] ) } |
171 | qr/\QThe 'gorch' parameter/, |
172 | '... gorch requires a ArrayRef[Int]'; |
173 | |
174 | throws_ok { $foo->quux( foo => '123456790' ) } |
175 | qr/\QThe 'foo' parameter\E.+\Qchecking type constraint/, |
176 | '... foo parameter must be an ArrayRef'; |
177 | |
178 | throws_ok { $foo->quux( foo => [ 1, 2, 3, 4 ] ) } |
179 | qr/\QThe 'foo' parameter\E.+\Qsome random callback/, |
180 | '... foo parameter additional callback requires that arrayref be 0-2 elements'; |