Commit | Line | Data |
86629f93 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
ed90007b |
8 | use Scalar::Util qw(refaddr); |
86629f93 |
9 | |
10 | BEGIN { |
d03bd989 |
11 | use_ok('Moose::Util::TypeConstraints'); |
86629f93 |
12 | } |
13 | |
14 | # subtype 'aliasing' ... |
15 | |
b10dde3a |
16 | is( exception { |
86629f93 |
17 | subtype 'Numb3rs' => as 'Num'; |
b10dde3a |
18 | }, undef, '... create bare subtype fine' ); |
86629f93 |
19 | |
20 | my $numb3rs = find_type_constraint('Numb3rs'); |
9c434902 |
21 | isa_ok($numb3rs, 'Moose::Meta::TypeConstraint'); |
22 | |
23 | # subtype with unions |
24 | |
25 | { |
26 | package Test::Moose::Meta::TypeConstraint::Union; |
d4d3bd09 |
27 | |
28 | use overload '""' => sub {'Broken|Test'}, fallback => 1; |
9c434902 |
29 | use Moose; |
d4d3bd09 |
30 | |
9c434902 |
31 | extends 'Moose::Meta::TypeConstraint'; |
32 | } |
33 | |
d4d3bd09 |
34 | my $dummy_instance = Test::Moose::Meta::TypeConstraint::Union->new; |
35 | |
36 | ok $dummy_instance => "Created Instance"; |
37 | |
38 | isa_ok $dummy_instance, |
39 | 'Test::Moose::Meta::TypeConstraint::Union' => 'isa correct type'; |
40 | |
41 | is "$dummy_instance", "Broken|Test" => |
42 | 'Got expected stringification result'; |
43 | |
44 | my $subtype1 = subtype 'New1' => as $dummy_instance; |
45 | |
46 | ok $subtype1 => 'made a subtype from our type object'; |
9c434902 |
47 | |
d4d3bd09 |
48 | my $subtype2 = subtype 'New2' => as $subtype1; |
9c434902 |
49 | |
d4d3bd09 |
50 | ok $subtype2 => 'made a subtype of our subtype'; |
c24269b3 |
51 | |
52 | # assert_valid |
53 | |
54 | { |
55 | my $type = find_type_constraint('Num'); |
56 | |
57 | my $ok_1 = eval { $type->assert_valid(1); }; |
58 | ok($ok_1, "we can assert_valid that 1 is of type $type"); |
59 | |
60 | my $ok_2 = eval { $type->assert_valid('foo'); }; |
61 | my $error = $@; |
62 | ok(! $ok_2, "'foo' is not of type $type"); |
63 | like( |
64 | $error, |
65 | qr{validation failed for .\Q$type\E.}i, |
66 | "correct error thrown" |
67 | ); |
68 | } |
a28e50e4 |
69 | |
c38be063 |
70 | { |
71 | for my $t (qw(Bar Foo)) { |
72 | my $tc = Moose::Meta::TypeConstraint->new({ |
73 | name => $t, |
74 | }); |
75 | |
76 | Moose::Util::TypeConstraints::register_type_constraint($tc); |
77 | } |
78 | |
79 | my $foo = Moose::Util::TypeConstraints::find_type_constraint('Foo'); |
80 | my $bar = Moose::Util::TypeConstraints::find_type_constraint('Bar'); |
81 | |
ed90007b |
82 | ok(!$foo->equals($bar), "Foo type is not equal to Bar type"); |
83 | ok( $foo->equals($foo), "Foo equals Foo"); |
84 | ok( 0+$foo == refaddr($foo), "overloading works"); |
c38be063 |
85 | } |
86 | |
72e389bf |
87 | ok $subtype1, "type constraint boolean overload works"; |
88 | |
a28e50e4 |
89 | done_testing; |