t/03-coercions.t

   1
   2 use Test::More tests=>15; {
   3
   4     use strict;
   5     use warnings;
   6
   7     use MooseX::Types::Parameterizable qw(Parameterizable);
   8     use MooseX::Types::Moose qw(Int Str HashRef ArrayRef);
   9
  10     use MooseX::Types -declare=>[qw(
  11         InfoHash OlderThanAge DefinedOlderThanAge
  12     )];
  13
  14     ok subtype( InfoHash,
  15         as HashRef[Int],
  16         where {
  17             defined $_->{older_than};
  18         }), 'Created InfoHash Set (reduce need to depend on Dict type';
  19
  20     ok InfoHash->check({older_than=>25}), 'Good InfoHash';
  21     ok !InfoHash->check({older_than=>'aaa'}), 'Bad InfoHash';
  22     ok !InfoHash->check({at_least=>25}), 'Bad InfoHash';
  23
  24     ok subtype( OlderThanAge,
  25         as Parameterizable[Int, InfoHash],
  26         where {
  27             my ($value, $dict) = @_;
  28             return $value > $dict->{older_than} ? 1:0;
  29         }), 'Created the OlderThanAge subtype';
  30
  31     ok OlderThanAge([{older_than=>25}])->check(39), '39 is older than 25';
  32     ok OlderThanAge([older_than=>1])->check(9), '9 is older than 1';
  33     ok !OlderThanAge([older_than=>1])->check('aaa'), '"aaa" not an int';
  34     ok !OlderThanAge([older_than=>10])->check(9), '9 is not older than 10';
  35
  36     coerce OlderThanAge,
  37         from HashRef,
  38         via {
  39             my ($hashref, $constraining_value) = @_;
  40             return scalar(keys(%$hashref));
  41         },
  42         from ArrayRef,
  43         via {
  44             my ($arrayref, $constraining_value) = @_;
  45             #use Data::Dump qw/dump/; warn dump $constraining_value;
  46             my $age;
  47             $age += $_ for @$arrayref;
  48             return $age;
  49         };
  50
  51     is OlderThanAge->name, 'main::OlderThanAge',
  52       'Got corect name for OlderThanAge';
  53     is OlderThanAge([older_than=>5])->coerce([1..10]), 55,
  54       'Coerce works';
  55     is OlderThanAge([older_than=>5])->coerce({a=>1,b=>2,c=>3,d=>4}), 4,
  56       'Coerce works';
  57     like OlderThanAge([older_than=>2])->name, qr/main::OlderThanAge\[/,
  58       'Got correct name for OlderThanAge([older_than=>2])';
  59     is OlderThanAge([older_than=>2])->coerce({a=>5,b=>6,c=>7,d=>8}), 4,
  60       'Coerce works';
  61
  62     SKIP: {
  63         skip 'Type Coercions on defined types not supported yet', 1;
  64
  65         subtype DefinedOlderThanAge, as OlderThanAge([older_than=>1]);
  66
  67         coerce DefinedOlderThanAge,
  68             from ArrayRef,
  69             via {
  70                 my ($arrayref, $constraining_value) = @_;
  71                 my $age;
  72                 $age += $_ for @$arrayref;
  73                 return $age;
  74             };
  75
  76         is DefinedOlderThanAge->coerce([1,2,3]), 6, 'Got expected Value';
  77     }
  78 }