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