updated makefile requirements and got the basics of coercions in place
[gitmo/MooseX-Dependent.git] / t / 03-coercions.t
CommitLineData
54f0d8d6 1
9c319add 2use Test::More tests=>14; {
54f0d8d6 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
9c319add 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
54f0d8d6 49 coerce OlderThanAge,
9c319add 50 from HashRef,
51 via {
52 my ($hashref, $constraining_value) = @_;
53 return keys %$hashref;
54 };
55
56 coerce OlderThanAge([older_than=>5]),
54f0d8d6 57 from ArrayRef,
58 via {
59 my ($arrayref, $constraining_value) = @_;
60 my $age;
61 $age += $_ for @$arrayref;
62 return $age;
63 };
9c319add 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
54f0d8d6 75}