Commit | Line | Data |
acb8a5db |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
acb8a5db |
8 | |
28fdde7f |
9 | use Moose::Util::TypeConstraints; |
10 | use Moose::Meta::TypeConstraint::Parameterized; |
acb8a5db |
11 | |
12 | BEGIN { |
13 | package MyList; |
14 | sub new { |
15 | my $class = shift; |
16 | bless { items => \@_ }, $class; |
17 | } |
18 | |
19 | sub items { |
20 | my $self = shift; |
21 | return @{ $self->{items} }; |
22 | } |
23 | } |
24 | |
25 | subtype 'MyList' => as 'Object' => where { $_->isa('MyList') }; |
26 | |
b10dde3a |
27 | is( exception { |
acb8a5db |
28 | coerce 'ArrayRef' |
29 | => from 'MyList' |
30 | => via { [ $_->items ] } |
b10dde3a |
31 | }, undef, '... created the coercion okay' ); |
acb8a5db |
32 | |
620db045 |
33 | my $mylist = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MyList[Int]'); |
acb8a5db |
34 | |
7e4e1ad4 |
35 | ok($mylist->check(MyList->new(10, 20, 30)), '... validated it correctly (pass)'); |
36 | ok(!$mylist->check(MyList->new(10, "two")), '... validated it correctly (fail)'); |
37 | ok(!$mylist->check([10]), '... validated it correctly (fail)'); |
acb8a5db |
38 | |
39 | subtype 'EvenList' => as 'MyList' => where { $_->items % 2 == 0 }; |
40 | |
41 | # XXX: get this to work *without* the declaration. I suspect it'll be a new |
42 | # method in Moose::Meta::TypeCoercion that will look at the parents of the |
43 | # coerced type as well. but will that be too "action at a distance"-ey? |
b10dde3a |
44 | is( exception { |
acb8a5db |
45 | coerce 'ArrayRef' |
46 | => from 'EvenList' |
47 | => via { [ $_->items ] } |
b10dde3a |
48 | }, undef, '... created the coercion okay' ); |
acb8a5db |
49 | |
620db045 |
50 | my $evenlist = Moose::Util::TypeConstraints::find_or_parse_type_constraint('EvenList[Int]'); |
acb8a5db |
51 | |
7e4e1ad4 |
52 | ok(!$evenlist->check(MyList->new(10, 20, 30)), '... validated it correctly (fail)'); |
53 | ok($evenlist->check(MyList->new(10, 20, 30, 40)), '... validated it correctly (pass)'); |
54 | ok(!$evenlist->check(MyList->new(10, "two")), '... validated it correctly (fail)'); |
55 | ok(!$evenlist->check([10, 20]), '... validated it correctly (fail)'); |
acb8a5db |
56 | |
a28e50e4 |
57 | done_testing; |