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