Commit | Line | Data |
182134e8 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 6; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose::Util::TypeConstraints'); |
11 | } |
12 | |
13 | { |
14 | package HTTPHeader; |
15 | use strict; |
16 | use warnings; |
17 | use Moose; |
18 | |
19 | has 'array' => (is => 'ro'); |
20 | has 'hash' => (is => 'ro'); |
21 | } |
22 | |
23 | subtype Header => |
24 | => as Object |
25 | => where { $_->isa('HTTPHeader') }; |
26 | |
27 | coerce Header |
28 | => as ArrayRef |
29 | => to { HTTPHeader->new(array => $_[0]) } |
30 | => as HashRef |
31 | => to { HTTPHeader->new(hash => $_[0]) }; |
32 | |
33 | Moose::Util::TypeConstraints::export_type_contstraints_as_functions(); |
34 | |
35 | my $header = HTTPHeader->new(); |
36 | isa_ok($header, 'HTTPHeader'); |
37 | |
38 | ok(Header($header), '... this passed the type test'); |
39 | ok(!Header([]), '... this did not pass the type test'); |
40 | ok(!Header({}), '... this did not pass the type test'); |
41 | |
42 | my $coercion = Moose::Util::TypeConstraints::find_type_coercion('Header'); |
43 | is(ref($coercion), 'CODE', '... got the right type of coercion'); |
44 | |
45 | #{ |
46 | # my $coerced = $coercion->([ 1, 2, 3 ]); |
47 | # isa_ok($coerced, 'HTTPHeader'); |
48 | # |
49 | # is_deeply( |
50 | # $coerced->array(), |
51 | # [ 1, 2, 3 ], |
52 | # '... got the right array'); |
53 | # is($coerced->hash(), undef, '... nothing assigned to the hash'); |
54 | #} |
55 | # |
56 | #{ |
57 | # my $coerced = $coercion->({ one => 1, two => 2, three => 3 }); |
58 | # isa_ok($coerced, 'HTTPHeader'); |
59 | # |
60 | # is_deeply( |
61 | # $coerced->hash(), |
62 | # { one => 1, two => 2, three => 3 }, |
63 | # '... got the right hash'); |
64 | # is($coerced->array(), undef, '... nothing assigned to the array'); |
65 | #} |