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