Commit | Line | Data |
b2b106d7 |
1 | #!/usr/bin/perl |
c47cf415 |
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 | |
c47cf415 |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
b2b106d7 |
11 | use Test::Exception; |
12 | |
13 | use Mouse::Util::TypeConstraints; |
14 | use Mouse::Meta::TypeConstraint; |
15 | |
16 | |
17 | ## Create a subclass with a custom method |
18 | |
19 | { |
c47cf415 |
20 | package Test::Mouse::Meta::TypeConstraint; |
b2b106d7 |
21 | use Mouse; |
22 | extends 'Mouse::Meta::TypeConstraint'; |
23 | |
24 | sub my_custom_method { |
25 | return 1; |
26 | } |
27 | } |
28 | |
29 | my $Int = find_type_constraint('Int'); |
c47cf415 |
30 | ok $Int, 'Got a good type constraint'; |
b2b106d7 |
31 | |
c47cf415 |
32 | my $parent = Test::Mouse::Meta::TypeConstraint->new({ |
33 | name => "Test::Mouse::Meta::TypeConstraint" , |
34 | parent => $Int, |
b2b106d7 |
35 | }); |
36 | |
37 | ok $parent, 'Created type constraint'; |
38 | ok $parent->check(1), 'Correctly passed'; |
39 | ok ! $parent->check('a'), 'correctly failed'; |
40 | ok $parent->my_custom_method, 'found the custom method'; |
41 | |
42 | my $subtype1 = subtype 'another_subtype' => as $parent; |
43 | |
44 | ok $subtype1, 'Created type constraint'; |
45 | ok $subtype1->check(1), 'Correctly passed'; |
46 | ok ! $subtype1->check('a'), 'correctly failed'; |
47 | ok $subtype1->my_custom_method, 'found the custom method'; |
48 | |
49 | |
50 | my $subtype2 = subtype 'another_subtype' => as $subtype1 => where { $_ < 10 }; |
51 | |
52 | ok $subtype2, 'Created type constraint'; |
53 | ok $subtype2->check(1), 'Correctly passed'; |
54 | ok ! $subtype2->check('a'), 'correctly failed'; |
55 | ok ! $subtype2->check(100), 'correctly failed'; |
56 | |
57 | ok $subtype2->my_custom_method, 'found the custom method'; |
58 | |
59 | |
60 | { |
61 | package Foo; |
62 | |
63 | use Mouse; |
64 | } |
65 | |
66 | { |
67 | package Bar; |
68 | |
69 | use Mouse; |
70 | |
71 | extends 'Foo'; |
72 | } |
73 | |
74 | { |
75 | package Baz; |
76 | |
77 | use Mouse; |
78 | } |
79 | |
80 | my $foo = class_type 'Foo'; |
81 | my $isa_foo = subtype 'IsaFoo' => as $foo; |
82 | |
83 | ok $isa_foo, 'Created subtype of Foo type'; |
84 | ok $isa_foo->check( Foo->new ), 'Foo passes check'; |
85 | ok $isa_foo->check( Bar->new ), 'Bar passes check'; |
86 | ok ! $isa_foo->check( Baz->new ), 'Baz does not pass check'; |
c47cf415 |
87 | like $foo->get_message( Baz->new ), qr/^Validation failed for 'Foo' with value Baz=HASH\(0x\w+\) \(not isa Foo\)/, 'Better validation message'; |
b2b106d7 |
88 | |
89 | # Maybe in the future this *should* inherit? |
c47cf415 |
90 | like $isa_foo->get_message( Baz->new ), qr/^Validation failed for 'IsaFoo' with value Baz=HASH\(0x\w+\)$/, "Subtypes do not automatically inherit parent type's message"; |
b2b106d7 |
91 | |
92 | |
93 | # Implicit types |
94 | { |
95 | package Quux; |
96 | |
97 | use Mouse; |
98 | |
99 | has age => ( |
100 | isa => 'Positive', |
101 | is => 'bare', |
102 | ); |
103 | } |
104 | |
105 | throws_ok { |
106 | Quux->new(age => 3) |
c47cf415 |
107 | } qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/; |
b2b106d7 |
108 | |
109 | lives_ok { |
110 | Quux->new(age => (bless {}, 'Positive')); |
111 | }; |
112 | |
113 | eval " |
114 | package Positive; |
115 | use Mouse; |
116 | "; |
117 | |
118 | throws_ok { |
119 | Quux->new(age => 3) |
c47cf415 |
120 | } qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/; |
b2b106d7 |
121 | |
122 | lives_ok { |
123 | Quux->new(age => Positive->new) |
124 | }; |
125 | |
126 | class_type 'Negative' => message { "$_ is not a Negative Nancy" }; |
127 | |
128 | { |
129 | package Quux::Ier; |
130 | |
131 | use Mouse; |
132 | |
133 | has age => ( |
134 | isa => 'Negative', |
135 | is => 'bare', |
136 | ); |
137 | } |
138 | |
139 | throws_ok { |
140 | Quux::Ier->new(age => 3) |
141 | } qr/^Attribute \(age\) does not pass the type constraint because: 3 is not a Negative Nancy /; |
142 | |
143 | lives_ok { |
144 | Quux::Ier->new(age => (bless {}, 'Negative')) |
145 | }; |
c47cf415 |
146 | |
147 | done_testing; |