t/03-coercions.t

   1
   2 use Test::More tests=>14; {
   3
   4         use strict;
   5         use warnings;
   6
   7         use MooseX::Dependent::Types qw(Dependent);
   8         use MooseX::Types::Moose qw(Int Str HashRef ArrayRef);
   9
  10         use MooseX::Types -declare=>[qw(
  11                 InfoHash OlderThanAge
  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 Dependent[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         my $a = OlderThanAge([older_than=>1]);
  37
  38         coerce $a,
  39                 from ArrayRef,
  40                 via {
  41                         my ($arrayref, $constraining_value) = @_;
  42                         my $age;
  43                         $age += $_ for @$arrayref;
  44                         return $age;
  45                 };
  46
  47         is $a->coerce([1,2,3]), 6, 'Got expected Value';
  48
  49         coerce OlderThanAge,
  50                 from HashRef,
  51                 via {
  52                         my ($hashref, $constraining_value) = @_;
  53                         return keys %$hashref;
  54                 };
  55
  56         coerce OlderThanAge([older_than=>5]),
  57                 from ArrayRef,
  58                 via {
  59                         my ($arrayref, $constraining_value) = @_;
  60                         my $age;
  61                         $age += $_ for @$arrayref;
  62                         return $age;
  63                 };
  64
  65         is OlderThanAge->name, 'main::OlderThanAge',
  66           'Got corect name for OlderThanAge';
  67         is OlderThanAge([older_than=>5])->coerce([1..10]), 55,
  68           'Coerce works';
  69         like OlderThanAge([older_than=>2])->name, qr/main::OlderThanAge\[/,
  70           'Got correct name for OlderThanAge([older_than=>2])';
  71         is OlderThanAge([older_than=>2])->coerce({a=>1,b=>2,c=>3,d=>4}), 4,
  72           'inherited Coerce works';
  73
  74
  75 }