t/001_basic.t

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