Commit | Line | Data |
5fa003bf |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
310ad28b |
4 | use Test::More tests => 9; |
5fa003bf |
5 | use Test::Exception; |
6 | |
315b97c2 |
7 | { |
8 | { |
5fa003bf |
9 | package Foo; |
10 | use Mouse; |
11 | |
12 | has foo => ( |
13 | is => 'ro', |
14 | isa => 'HashRef[Int]', |
15 | ); |
315b97c2 |
16 | |
17 | has bar => ( |
18 | is => 'ro', |
19 | isa => 'ArrayRef[Int]', |
20 | ); |
21 | |
22 | has 'complex' => ( |
23 | is => 'rw', |
24 | isa => 'ArrayRef[HashRef[Int]]' |
25 | ); |
5fa003bf |
26 | }; |
27 | |
28 | ok(Foo->meta->has_attribute('foo')); |
315b97c2 |
29 | |
30 | lives_and { |
31 | my $hash = { a => 1, b => 2, c => 3 }; |
32 | my $array = [ 1, 2, 3 ]; |
33 | my $complex = [ { a => 1, b => 1 }, { c => 2, d => 2} ]; |
34 | my $foo = Foo->new(foo => $hash, bar => $array, complex => $complex); |
35 | |
36 | is_deeply($foo->foo(), $hash, "foo is a proper hash"); |
37 | is_deeply($foo->bar(), $array, "bar is a proper array"); |
38 | is_deeply($foo->complex(), $complex, "complex is a proper ... structure"); |
39 | } "Parameterized constraints work"; |
40 | |
41 | # check bad args |
42 | throws_ok { |
43 | Foo->new( foo => { a => 'b' }); |
44 | } qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'HashRef\[Int\]' failed with value/, "Bad args for hash throws an exception"; |
45 | |
46 | throws_ok { |
47 | Foo->new( bar => [ a => 'b' ]); |
48 | } qr/Attribute \(bar\) does not pass the type constraint because: Validation failed for 'ArrayRef\[Int\]' failed with value/, "Bad args for array throws an exception"; |
49 | |
50 | throws_ok { |
51 | Foo->new( complex => [ { a => 1, b => 1 }, { c => "d", e => "f" } ] ) |
52 | } qr/Attribute \(complex\) does not pass the type constraint because: Validation failed for 'ArrayRef\[HashRef\[Int\]\]' failed with value/, "Bad args for complex types throws an exception"; |
53 | } |
54 | |
310ad28b |
55 | { |
56 | { |
57 | package Bar; |
58 | use Mouse; |
59 | use Mouse::Util::TypeConstraints; |
60 | |
61 | subtype 'Bar::List' |
62 | => as 'ArrayRef[HashRef]' |
63 | ; |
64 | coerce 'Bar::List' |
65 | => from 'ArrayRef[Str]' |
66 | => via { |
67 | [ map { +{ $_ => 1 } } @$_ ] |
68 | } |
69 | ; |
70 | has 'list' => ( |
71 | is => 'ro', |
72 | isa => 'Bar::List', |
73 | coerce => 1, |
74 | ); |
75 | } |
76 | |
77 | lives_and { |
78 | my @list = ( {a => 1}, {b => 1}, {c => 1} ); |
79 | my $bar = Bar->new(list => [ qw(a b c) ]); |
80 | |
81 | is_deeply( $bar->list, \@list, "list is as expected"); |
82 | } "coercion works"; |
83 | |
84 | throws_ok { |
85 | Bar->new(list => [ { 1 => 2 }, 2, 3 ]); |
86 | } qr/Attribute \(list\) does not pass the type constraint because: Validation failed for 'Bar::List' failed with value/, "Bad coercion parameter throws an error"; |
87 | } |
88 | |
315b97c2 |
89 | |
5fa003bf |
90 | |