Commit | Line | Data |
a0f8153d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
36dbd105 |
6 | use Test::More tests => 30; |
a0f8153d |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok("Moose::Util::TypeConstraints"); |
11 | } |
12 | |
13 | lives_ok { |
14 | subtype 'MySpecialHash' => as 'HashRef[Int]'; |
15 | } '... created the subtype special okay'; |
16 | |
17 | { |
18 | my $t = find_type_constraint('MySpecialHash'); |
19 | isa_ok($t, 'Moose::Meta::TypeConstraint'); |
20 | |
21 | is($t->name, 'MySpecialHash', '... name is correct'); |
22 | |
23 | my $p = $t->parent; |
24 | isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized'); |
25 | isa_ok($p, 'Moose::Meta::TypeConstraint'); |
26 | |
27 | is($p->name, 'HashRef[Int]', '... parent name is correct'); |
28 | |
29 | ok($t->check({ one => 1, two => 2 }), '... validated it correctly'); |
30 | ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly'); |
dabed765 |
31 | |
32 | ok( $t->equals($t), "equals to self" ); |
33 | ok( !$t->equals( $t->parent ), "not equal to parent" ); |
34 | ok( $t->parent->equals( $t->parent ), "parent equals to self" ); |
a0f8153d |
35 | } |
36 | |
37 | lives_ok { |
38 | subtype 'MySpecialHashExtended' |
39 | => as 'HashRef[Int]' |
40 | => where { |
41 | # all values are less then 10 |
42 | (scalar grep { $_ < 10 } values %{$_}) ? 1 : undef |
43 | }; |
44 | } '... created the subtype special okay'; |
45 | |
46 | { |
47 | my $t = find_type_constraint('MySpecialHashExtended'); |
48 | isa_ok($t, 'Moose::Meta::TypeConstraint'); |
49 | |
50 | is($t->name, 'MySpecialHashExtended', '... name is correct'); |
51 | |
52 | my $p = $t->parent; |
53 | isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized'); |
54 | isa_ok($p, 'Moose::Meta::TypeConstraint'); |
55 | |
56 | is($p->name, 'HashRef[Int]', '... parent name is correct'); |
57 | |
58 | ok($t->check({ one => 1, two => 2 }), '... validated it correctly'); |
59 | ok(!$t->check({ zero => 10, one => 11, two => 12 }), '... validated it correctly'); |
60 | ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly'); |
61 | } |
62 | |
36dbd105 |
63 | lives_ok { |
64 | subtype 'MyNonSpecialHash' |
65 | => as "HashRef" |
66 | => where { keys %$_ == 3 }; |
67 | }; |
68 | |
69 | { |
70 | my $t = find_type_constraint('MyNonSpecialHash'); |
71 | |
72 | isa_ok($t, 'Moose::Meta::TypeConstraint'); |
73 | isa_ok($t, 'Moose::Meta::TypeConstraint::Parameterizable'); |
74 | |
75 | ok( $t->check({ one => 1, two => "foo", three => [] }), "validated" ); |
76 | ok( !$t->check({ one => 1 }), "failed" ); |
77 | } |
78 | |
79 | { |
80 | my $t = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MyNonSpecialHash[Int]'); |
81 | |
82 | isa_ok($t, 'Moose::Meta::TypeConstraint'); |
83 | |
84 | ok( $t->check({ one => 1, two => 2, three => 3 }), "validated" ); |
85 | ok( !$t->check({ one => 1, two => "foo", three => [] }), "failed" ); |
86 | ok( !$t->check({ one => 1 }), "failed" ); |
87 | } |