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