Commit | Line | Data |
39aba5c9 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
39aba5c9 |
8 | |
9 | BEGIN { |
10 | use_ok("Moose::Util::TypeConstraints"); |
11 | use_ok('Moose::Meta::TypeConstraint::Parameterized'); |
12 | } |
13 | |
b10dde3a |
14 | is( exception { |
39aba5c9 |
15 | subtype 'AlphaKeyHash' => as 'HashRef' |
16 | => where { |
17 | # no keys match non-alpha |
18 | (grep { /[^a-zA-Z]/ } keys %$_) == 0 |
19 | }; |
b10dde3a |
20 | }, undef, '... created the subtype special okay' ); |
39aba5c9 |
21 | |
b10dde3a |
22 | is( exception { |
39aba5c9 |
23 | subtype 'Trihash' => as 'AlphaKeyHash' |
24 | => where { |
25 | keys(%$_) == 3 |
26 | }; |
b10dde3a |
27 | }, undef, '... created the subtype special okay' ); |
39aba5c9 |
28 | |
b10dde3a |
29 | is( exception { |
39aba5c9 |
30 | subtype 'Noncon' => as 'Item'; |
b10dde3a |
31 | }, undef, '... created the subtype special okay' ); |
39aba5c9 |
32 | |
33 | { |
34 | my $t = find_type_constraint('AlphaKeyHash'); |
35 | isa_ok($t, 'Moose::Meta::TypeConstraint'); |
36 | |
37 | is($t->name, 'AlphaKeyHash', '... name is correct'); |
38 | |
39 | my $p = $t->parent; |
40 | isa_ok($p, 'Moose::Meta::TypeConstraint'); |
41 | |
42 | is($p->name, 'HashRef', '... parent name is correct'); |
43 | |
44 | ok($t->check({ one => 1, two => 2 }), '... validated it correctly'); |
45 | ok(!$t->check({ one1 => 1, two2 => 2 }), '... validated it correctly'); |
dabed765 |
46 | |
47 | ok( $t->equals($t), "equals to self" ); |
48 | ok( !$t->equals($t->parent), "not equal to parent" ); |
39aba5c9 |
49 | } |
50 | |
620db045 |
51 | my $hoi = Moose::Util::TypeConstraints::find_or_parse_type_constraint('AlphaKeyHash[Int]'); |
39aba5c9 |
52 | |
53 | ok($hoi->check({ one => 1, two => 2 }), '... validated it correctly'); |
54 | ok(!$hoi->check({ one1 => 1, two2 => 2 }), '... validated it correctly'); |
55 | ok(!$hoi->check({ one => 'uno', two => 'dos' }), '... validated it correctly'); |
56 | ok(!$hoi->check({ one1 => 'un', two2 => 'deux' }), '... validated it correctly'); |
57 | |
dabed765 |
58 | ok( $hoi->equals($hoi), "equals to self" ); |
59 | ok( !$hoi->equals($hoi->parent), "equals to self" ); |
60 | ok( !$hoi->equals(find_type_constraint('AlphaKeyHash')), "not equal to unparametrized self" ); |
61 | ok( $hoi->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "Blah", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" ); |
62 | ok( !$hoi->equals( Moose::Meta::TypeConstraint::Parameterized->new( name => "Oink", parent => find_type_constraint("AlphaKeyHash"), type_parameter => find_type_constraint("Str") ) ), "not equal to different parameter" ); |
63 | |
620db045 |
64 | my $th = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Trihash[Bool]'); |
39aba5c9 |
65 | |
66 | ok(!$th->check({ one => 1, two => 1 }), '... validated it correctly'); |
67 | ok($th->check({ one => 1, two => 0, three => 1 }), '... validated it correctly'); |
68 | ok(!$th->check({ one => 1, two => 2, three => 1 }), '... validated it correctly'); |
69 | ok(!$th->check({foo1 => 1, bar2 => 0, baz3 => 1}), '... validated it correctly'); |
70 | |
b10dde3a |
71 | isnt( exception { |
39aba5c9 |
72 | Moose::Meta::TypeConstraint::Parameterized->new( |
73 | name => 'Str[Int]', |
74 | parent => find_type_constraint('Str'), |
75 | type_parameter => find_type_constraint('Int'), |
76 | ); |
b10dde3a |
77 | }, undef, 'non-containers cannot be parameterized' ); |
39aba5c9 |
78 | |
b10dde3a |
79 | isnt( exception { |
39aba5c9 |
80 | Moose::Meta::TypeConstraint::Parameterized->new( |
81 | name => 'Noncon[Int]', |
82 | parent => find_type_constraint('Noncon'), |
83 | type_parameter => find_type_constraint('Int'), |
84 | ); |
b10dde3a |
85 | }, undef, 'non-containers cannot be parameterized' ); |
39aba5c9 |
86 | |
a28e50e4 |
87 | done_testing; |