t/005_coercion.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 # Note that setting coerce => 1 for the Num type tests that we don't try to do
  10 # coercions for a type which doesn't have any coercions.
  11 {
  12     package Foo;
  13     use Moose;
  14     use Moose::Util::TypeConstraints;
  15     use MooseX::Params::Validate;
  16
  17     subtype 'Size' => as 'Int' => where { $_ >= 0 };
  18
  19     coerce 'Size' => from 'ArrayRef' => via { scalar @{$_} };
  20
  21     sub bar {
  22         my $self   = shift;
  23         my %params = validated_hash(
  24             \@_,
  25             size1  => { isa => 'Size', coerce => 1 },
  26             size2  => { isa => 'Size', coerce => 0 },
  27             number => { isa => 'Num',  coerce => 1 },
  28         );
  29         [ $params{size1}, $params{size2}, $params{number} ];
  30     }
  31
  32     # added to test 'optional' on validated_hash
  33     sub baropt {
  34         my $self   = shift;
  35         my %params = validated_hash(
  36             \@_,
  37             size1  => { isa => 'Size', coerce => 1, optional => 1 },
  38             size2  => { isa => 'Size', coerce => 0, optional => 1 },
  39             number => { isa => 'Num',  coerce => 1, optional => 1 },
  40         );
  41         [ $params{size1}, $params{size2}, $params{number} ];
  42     }
  43
  44     sub baz {
  45         my $self = shift;
  46         my ( $size1, $size2, $number ) = validated_list(
  47             \@_,
  48             size1  => { isa => 'Size', coerce => 1 },
  49             size2  => { isa => 'Size', coerce => 0 },
  50             number => { isa => 'Num',  coerce => 1 },
  51         );
  52         [ $size1, $size2, $number ];
  53     }
  54
  55     sub quux {
  56         my $self = shift;
  57         my ( $size1, $size2, $number ) = validated_list(
  58             \@_,
  59             size1  => { isa => 'Size', coerce => 1, optional => 1 },
  60             size2  => { isa => 'Size', coerce => 0, optional => 1 },
  61             number => { isa => 'Num',  coerce => 1, optional => 1 },
  62         );
  63         [ $size1, $size2, $number ];
  64     }
  65
  66     sub ran_out {
  67         my $self = shift;
  68         my ( $size1, $size2, $number ) = pos_validated_list(
  69             \@_,
  70             { isa => 'Size', coerce => 1, optional => 1 },
  71             { isa => 'Size', coerce => 0, optional => 1 },
  72             { isa => 'Num',  coerce => 1, optional => 1 },
  73         );
  74         [ $size1, $size2, $number ];
  75     }
  76 }
  77
  78 my $foo = Foo->new;
  79 isa_ok( $foo, 'Foo' );
  80
  81 is_deeply(
  82     $foo->bar( size1 => 10, size2 => 20, number => 30 ),
  83     [ 10, 20, 30 ],
  84     'got the return value right without coercions'
  85 );
  86
  87 is_deeply(
  88     $foo->bar( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
  89     [ 3, 20, 30 ],
  90     'got the return value right with coercions for size1'
  91 );
  92
  93 like(
  94     exception { $foo->bar( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
  95     , qr/\QThe 'size2' parameter/, '... the size2 param cannot be coerced' );
  96
  97 like(
  98     exception { $foo->bar( size1 => 30, size2 => 10, number => 'something' ) }
  99     , qr/\QThe 'number' parameter/,
 100     '... the number param cannot be coerced because there is no coercion defined for Num'
 101 );
 102
 103 is_deeply(
 104     $foo->baz( size1 => 10, size2 => 20, number => 30 ),
 105     [ 10, 20, 30 ],
 106     'got the return value right without coercions'
 107 );
 108
 109 is_deeply(
 110     $foo->baz( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
 111     [ 3, 20, 30 ],
 112     'got the return value right with coercions for size1'
 113 );
 114
 115 like(
 116     exception { $foo->baz( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
 117     , qr/\QThe 'size2' parameter/, '... the size2 param cannot be coerced' );
 118
 119 like(
 120     exception { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
 121     , qr/\QThe 'number' parameter/,
 122     '... the number param cannot be coerced'
 123 );
 124
 125 is_deeply(
 126     $foo->baropt( size2 => 4 ),
 127     [ undef, 4, undef ],
 128     '... validated_hash does not try to coerce keys which are not provided'
 129 );
 130
 131 is_deeply(
 132     $foo->quux( size2 => 4 ),
 133     [ undef, 4, undef ],
 134     '... validated_list does not try to coerce keys which are not provided'
 135 );
 136
 137 is_deeply(
 138     $foo->ran_out( 1, 2, 3 ),
 139     [ 1, 2, 3 ],
 140     'got the return value right without coercions'
 141 );
 142
 143 is_deeply(
 144     $foo->ran_out( [1], 2, 3 ),
 145     [ 1, 2, 3 ],
 146     'got the return value right with coercion for the first param'
 147 );
 148
 149 like(
 150     exception { $foo->ran_out( [ 1, 2 ], [ 1, 2 ] ) }, qr/\QParameter #2/,
 151     '... did not attempt to coerce the second parameter'
 152 );
 153
 154 is_deeply(
 155     $foo->ran_out(),
 156     [ undef, undef, undef ],
 157     'did not try to coerce non-existent parameters'
 158 );
 159
 160 done_testing();