t/001_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   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 { !ref($_[0]) || @{ $_[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(
  81     $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
  82     '... got the right return value'
  83 );
  84
  85 is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
  86
  87 like(
  88     exception { $foo->baz( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
  89     '... the foo param in &baz must be a Foo instance'
  90 );
  91 like(
  92     exception { $foo->baz( foo => "foo" ) },
  93     qr/\QThe 'foo' parameter ("foo")/,
  94     '... the foo param in &baz must be a Foo instance'
  95 );
  96 like(
  97     exception { $foo->baz( foo => [] ) }, qr/\QThe 'foo' parameter/,
  98     '... the foo param in &baz must be a Foo instance'
  99 );
 100
 101 is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
 102
 103 like(
 104     exception { $foo->baz( bar => 10 ) }, qr/\QThe 'bar' parameter ("10")/,
 105     '... the bar param in &baz must be do Roles::Blah'
 106 );
 107 like(
 108     exception { $foo->baz( bar => "foo" ) },
 109     qr/\QThe 'bar' parameter ("foo")/,
 110     '... the bar param in &baz must be do Roles::Blah'
 111 );
 112 like(
 113     exception { $foo->baz( bar => [] ) }, qr/\QThe 'bar' parameter/,
 114     '... the bar param in &baz must be do Roles::Blah'
 115 );
 116
 117 is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
 118
 119 like(
 120     exception { $foo->baz( boo => 10 ) }, qr/\QThe 'boo' parameter ("10")/,
 121     '... the boo param in &baz must be do Roles::Blah'
 122 );
 123 like(
 124     exception { $foo->baz( boo => "foo" ) },
 125     qr/\QThe 'boo' parameter ("foo")/,
 126     '... the boo param in &baz must be do Roles::Blah'
 127 );
 128 like(
 129     exception { $foo->baz( boo => [] ) }, qr/\QThe 'boo' parameter/,
 130     '... the boo param in &baz must be do Roles::Blah'
 131 );
 132
 133 like(
 134     exception { $foo->bar }, qr/\QMandatory parameter 'foo'/,
 135     '... bar has a required param'
 136 );
 137 like(
 138     exception { $foo->bar( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
 139     '... the foo param in &bar must be a Foo instance'
 140 );
 141 like(
 142     exception { $foo->bar( foo => "foo" ) },
 143     qr/\QThe 'foo' parameter ("foo")/,
 144     '... the foo param in &bar must be a Foo instance'
 145 );
 146 like(
 147     exception { $foo->bar( foo => [] ) }, qr/\QThe 'foo' parameter/,
 148     '... the foo param in &bar must be a Foo instance'
 149 );
 150 like( exception { $foo->bar( baz => [] ) }, qr/\QMandatory parameter 'foo'/ );
 151
 152 is_deeply(
 153     $foo->bar( foo => $foo ),
 154     [ $foo, undef, undef ],
 155     '... the foo param in &bar got a Foo instance'
 156 );
 157
 158 is_deeply(
 159     $foo->bar( foo => $foo, baz => [] ),
 160     [ $foo, [], undef ],
 161     '... the foo param and baz param in &bar got a correct args'
 162 );
 163
 164 is_deeply(
 165     $foo->bar( foo => $foo, baz => {} ),
 166     [ $foo, {}, undef ],
 167     '... the foo param and baz param in &bar got a correct args'
 168 );
 169
 170 like(
 171     exception { $foo->bar( foo => $foo, baz => undef ) },
 172     qr/\QThe 'baz' parameter (undef)/,
 173     '... baz requires a ArrayRef | HashRef'
 174 );
 175 like(
 176     exception { $foo->bar( foo => $foo, baz => 10 ) },
 177     qr/\QThe 'baz' parameter ("10")/,
 178     '... baz requires a ArrayRef | HashRef'
 179 );
 180 like(
 181     exception { $foo->bar( foo => $foo, baz => 'Foo' ) },
 182     qr/\QThe 'baz' parameter ("Foo")/,
 183     '... baz requires a ArrayRef | HashRef'
 184 );
 185 like(
 186     exception { $foo->bar( foo => $foo, baz => \( my $var ) ) },
 187     qr/\QThe 'baz' parameter/, '... baz requires a ArrayRef | HashRef'
 188 );
 189
 190 is_deeply(
 191     $foo->bar( foo => $foo, gorch => [ 1, 2, 3 ] ),
 192     [ $foo, undef, [ 1, 2, 3 ] ],
 193     '... the foo param in &bar got a Foo instance'
 194 );
 195
 196 like(
 197     exception { $foo->bar( foo => $foo, gorch => undef ) },
 198     qr/\QThe 'gorch' parameter (undef)/,
 199     '... gorch requires a ArrayRef[Int]'
 200 );
 201 like(
 202     exception { $foo->bar( foo => $foo, gorch => 10 ) },
 203     qr/\QThe 'gorch' parameter ("10")/,
 204     '... gorch requires a ArrayRef[Int]'
 205 );
 206 like(
 207     exception { $foo->bar( foo => $foo, gorch => 'Foo' ) },
 208     qr/\QThe 'gorch' parameter ("Foo")/,
 209     '... gorch requires a ArrayRef[Int]'
 210 );
 211 like(
 212     exception { $foo->bar( foo => $foo, gorch => \( my $var ) ) },
 213     qr/\QThe 'gorch' parameter/, '... gorch requires a ArrayRef[Int]'
 214 );
 215 like(
 216     exception { $foo->bar( foo => $foo, gorch => [qw/one two three/] ) },
 217     qr/\QThe 'gorch' parameter/, '... gorch requires a ArrayRef[Int]'
 218 );
 219
 220 like(
 221     exception { $foo->quux( foo => '123456790' ) },
 222     qr/\QThe 'foo' parameter\E.+\Qchecking type constraint/,
 223     '... foo parameter must be an ArrayRef'
 224 );
 225
 226 like(
 227     exception { $foo->quux( foo => [ 1, 2, 3, 4 ] ) },
 228     qr/\QThe 'foo' parameter\E.+\Qsome random callback/,
 229     '... foo parameter additional callback requires that arrayref be 0-2 elements'
 230 );
 231
 232 done_testing();