copied from svn
[gitmo/MooseX-Params-Validate.git] / t / 002_basic_list.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 27;
7 use Test::Exception;
8
9 {
10     package Roles::Blah;
11     use Moose::Role;
12
13     requires 'foo';
14     requires 'bar';
15     requires 'baz';
16
17     package Foo;
18     use Moose;
19     use Moose::Util::TypeConstraints;
20     use MooseX::Params::Validate;
21
22     with 'Roles::Blah';
23
24     sub foo {
25         my ( $self, $bar ) = validated_list(
26             \@_,
27             bar => { isa => 'Str', default => 'Moose' },
28         );
29         return "Horray for $bar!";
30     }
31
32     sub bar {
33         my $self = shift;
34         my ( $foo, $baz ) = validated_list(
35             \@_,
36             foo => { isa => 'Foo' },
37             baz => { isa => 'ArrayRef | HashRef', optional => 1 },
38         );
39         [ $foo, $baz ];
40     }
41
42     sub baz {
43         my $self = shift;
44         my ( $foo, $bar, $boo ) = validated_list(
45             \@_,
46             foo => {
47                 isa => subtype( 'Object' => where { $_->isa('Foo') } ),
48                 optional => 1
49             },
50             bar => { does => 'Roles::Blah', optional => 1 },
51             boo => {
52                 does     => role_type('Roles::Blah'),
53                 optional => 1
54             },
55         );
56         return $foo || $bar || $boo;
57     }
58 }
59
60 my $foo = Foo->new;
61 isa_ok( $foo, 'Foo' );
62
63 is( $foo->foo, 'Horray for Moose!', '... got the right return value' );
64 is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
65     '... got the right return value' );
66
67 is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
68
69 throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
70     '... the foo param in &baz must be a Foo instance';
71 throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
72     '... the foo param in &baz must be a Foo instance';
73 throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/,
74     '... the foo param in &baz must be a Foo instance';
75
76 is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
77
78 throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/,
79 '... the bar param in &baz must be do Roles::Blah';
80 throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/,
81 '... the bar param in &baz must be do Roles::Blah';
82 throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/,
83 '... the bar param in &baz must be do Roles::Blah';
84
85 is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
86
87 throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/,
88 '... the boo param in &baz must be do Roles::Blah';
89 throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/,
90 '... the boo param in &baz must be do Roles::Blah';
91 throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/,
92 '... the boo param in &baz must be do Roles::Blah';
93
94 throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/,
95     '... bar has a required param';
96 throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
97     '... the foo param in &bar must be a Foo instance';
98 throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
99     '... the foo param in &bar must be a Foo instance';
100 throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/,
101     '... the foo param in &bar must be a Foo instance';
102 throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,,
103     '... bar has a required foo param';
104
105 is_deeply(
106     $foo->bar( foo => $foo ),
107     [ $foo, undef ],
108     '... the foo param in &bar got a Foo instance'
109 );
110
111 is_deeply(
112     $foo->bar( foo => $foo, baz => [] ),
113     [ $foo, [] ],
114     '... the foo param and baz param in &bar got a correct args'
115 );
116
117 is_deeply(
118     $foo->bar( foo => $foo, baz => {} ),
119     [ $foo, {} ],
120     '... the foo param and baz param in &bar got a correct args'
121 );
122
123 throws_ok { $foo->bar( foo => $foo, baz => undef ) }
124 qr/\QThe 'baz' parameter (undef)/,
125     '... baz requires a ArrayRef | HashRef';
126 throws_ok { $foo->bar( foo => $foo, baz => 10 ) }
127 qr/\QThe 'baz' parameter ("10")/,
128     '... baz requires a ArrayRef | HashRef';
129 throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) }
130 qr/\QThe 'baz' parameter ("Foo")/,
131     '... baz requires a ArrayRef | HashRef';
132 throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) }
133 qr/\QThe 'baz' parameter/,
134     '... baz requires a ArrayRef | HashRef';