Commit | Line | Data |
b2b106d7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
4c0e2aa7 |
6 | use Test::More tests => 8; # tests => 26; |
b2b106d7 |
7 | use Test::Exception; |
8 | |
b910be93 |
9 | use lib 't/lib'; |
73e9153a |
10 | use MooseCompat; |
b910be93 |
11 | |
b2b106d7 |
12 | BEGIN { |
13 | use_ok('Mouse::Util::TypeConstraints'); |
14 | } |
15 | |
16 | { |
17 | package HTTPHeader; |
18 | use Mouse; |
19 | |
20 | has 'array' => (is => 'ro'); |
21 | has 'hash' => (is => 'ro'); |
22 | } |
23 | |
24 | subtype Header => |
25 | => as Object |
26 | => where { $_->isa('HTTPHeader') }; |
27 | |
28 | coerce Header |
29 | => from ArrayRef |
30 | => via { HTTPHeader->new(array => $_[0]) } |
31 | => from HashRef |
32 | => via { HTTPHeader->new(hash => $_[0]) }; |
33 | |
34 | |
35 | Mouse::Util::TypeConstraints->export_type_constraints_as_functions(); |
36 | |
37 | my $header = HTTPHeader->new(); |
38 | isa_ok($header, 'HTTPHeader'); |
39 | |
40 | ok(Header($header), '... this passed the type test'); |
41 | ok(!Header([]), '... this did not pass the type test'); |
42 | ok(!Header({}), '... this did not pass the type test'); |
43 | |
44 | my $anon_type = subtype Object => where { $_->isa('HTTPHeader') }; |
45 | |
46 | lives_ok { |
47 | coerce $anon_type |
48 | => from ArrayRef |
49 | => via { HTTPHeader->new(array => $_[0]) } |
50 | => from HashRef |
51 | => via { HTTPHeader->new(hash => $_[0]) }; |
52 | } 'coercion of anonymous subtype succeeds'; |
53 | |
b910be93 |
54 | =pod |
55 | |
b2b106d7 |
56 | foreach my $coercion ( |
57 | find_type_constraint('Header')->coercion, |
58 | $anon_type->coercion |
59 | ) { |
b2b106d7 |
60 | isa_ok($coercion, 'Mouse::Meta::TypeCoercion'); |
61 | |
62 | { |
63 | my $coerced = $coercion->coerce([ 1, 2, 3 ]); |
64 | isa_ok($coerced, 'HTTPHeader'); |
65 | |
66 | is_deeply( |
67 | $coerced->array(), |
68 | [ 1, 2, 3 ], |
69 | '... got the right array'); |
70 | is($coerced->hash(), undef, '... nothing assigned to the hash'); |
71 | } |
72 | |
73 | { |
74 | my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 }); |
75 | isa_ok($coerced, 'HTTPHeader'); |
76 | |
77 | is_deeply( |
78 | $coerced->hash(), |
79 | { one => 1, two => 2, three => 3 }, |
80 | '... got the right hash'); |
81 | is($coerced->array(), undef, '... nothing assigned to the array'); |
82 | } |
83 | |
84 | { |
85 | my $scalar_ref = \(my $var); |
86 | my $coerced = $coercion->coerce($scalar_ref); |
87 | is($coerced, $scalar_ref, '... got back what we put in'); |
88 | } |
89 | |
90 | { |
91 | my $coerced = $coercion->coerce("Foo"); |
92 | is($coerced, "Foo", '... got back what we put in'); |
93 | } |
94 | } |
95 | |
b910be93 |
96 | =cut |
97 | |
b2b106d7 |
98 | subtype 'StrWithTrailingX' |
99 | => as 'Str' |
100 | => where { /X$/ }; |
101 | |
102 | coerce 'StrWithTrailingX' |
103 | => from 'Str' |
104 | => via { $_ . 'X' }; |
105 | |
106 | my $tc = find_type_constraint('StrWithTrailingX'); |
107 | is($tc->coerce("foo"), "fooX", "coerce when needed"); |
108 | is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded"); |