t/03-coercions.t

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