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;
10 $TODO = q{Mouse is not yet completed};
15 use Mouse::Util::TypeConstraints;
18 type Number => where { Scalar::Util::looks_like_number($_) };
20 => where { !ref($_) && !Number($_) }
21 => message { "This is not a string ($_)" };
27 subtype NaturalLessThanTen
30 => message { "The number '$_' is not less than 10" };
32 Mouse::Util::TypeConstraints->export_type_constraints_as_functions();
34 ok(Number(5), '... this is a Num');
35 ok(!defined(Number('Foo')), '... this is not a Num');
37 my $number_tc = Mouse::Util::TypeConstraints::find_type_constraint('Number');
38 is("$number_tc", 'Number', '... type constraint stringifies to name');
41 ok(String('Foo'), '... this is a Str');
42 ok(!defined(String(5)), '... this is not a Str');
44 ok(Natural(5), '... this is a Natural');
45 is(Natural(-5), undef, '... this is not a Natural');
46 is(Natural('Foo'), undef, '... this is not a Natural');
48 ok(NaturalLessThanTen(5), '... this is a NaturalLessThanTen');
49 is(NaturalLessThanTen(12), undef, '... this is not a NaturalLessThanTen');
50 is(NaturalLessThanTen(-5), undef, '... this is not a NaturalLessThanTen');
51 is(NaturalLessThanTen('Foo'), undef, '... this is not a NaturalLessThanTen');
55 my $negative = subtype Number => where { $_ < 0 };
56 ok(defined $negative, '... got a value back from negative');
57 isa_ok($negative, 'Mouse::Meta::TypeConstraint');
59 ok($negative->check(-5), '... this is a negative number');
60 ok(!defined($negative->check(5)), '... this is not a negative number');
61 is($negative->check('Foo'), undef, '... this is not a negative number');
63 ok($negative->is_subtype_of('Number'), '... $negative is a subtype of Number');
64 ok(!$negative->is_subtype_of('String'), '... $negative is not a subtype of String');
66 my $negative2 = subtype Number => where { $_ < 0 } => message {"$_ is not a negative number"};
68 ok(defined $negative2, '... got a value back from negative');
69 isa_ok($negative2, 'Mouse::Meta::TypeConstraint');
71 ok($negative2->check(-5), '... this is a negative number');
72 ok(!defined($negative2->check(5)), '... this is not a negative number');
73 is($negative2->check('Foo'), undef, '... this is not a negative number');
75 ok($negative2->is_subtype_of('Number'), '... $negative2 is a subtype of Number');
76 ok(!$negative2->is_subtype_of('String'), '... $negative is not a subtype of String');
78 ok($negative2->has_message, '... it has a message');
79 is($negative2->validate(2),
80 '2 is not a negative number',
81 '... validated unsuccessfully (got error)');
83 # check some meta-details
85 my $natural_less_than_ten = find_type_constraint('NaturalLessThanTen');
86 isa_ok($natural_less_than_ten, 'Mouse::Meta::TypeConstraint');
88 ok($natural_less_than_ten->is_subtype_of('Natural'), '... NaturalLessThanTen is subtype of Natural');
89 ok($natural_less_than_ten->is_subtype_of('Number'), '... NaturalLessThanTen is subtype of Number');
90 ok(!$natural_less_than_ten->is_subtype_of('String'), '... NaturalLessThanTen is not subtype of String');
92 ok($natural_less_than_ten->has_message, '... it has a message');
94 ok(!defined($natural_less_than_ten->validate(5)), '... validated successfully (no error)');
96 is($natural_less_than_ten->validate(15),
97 "The number '15' is not less than 10",
98 '... validated unsuccessfully (got error)');
100 my $natural = find_type_constraint('Natural');
101 isa_ok($natural, 'Mouse::Meta::TypeConstraint');
103 ok($natural->is_subtype_of('Number'), '... Natural is a subtype of Number');
104 ok(!$natural->is_subtype_of('String'), '... Natural is not a subtype of String');
106 ok(!$natural->has_message, '... it does not have a message');
108 ok(!defined($natural->validate(5)), '... validated successfully (no error)');
110 is($natural->validate(-5),
111 "Validation failed for 'Natural' with value -5",
112 '... validated unsuccessfully (got error)');
114 my $string = find_type_constraint('String');
115 isa_ok($string, 'Mouse::Meta::TypeConstraint');
117 ok($string->has_message, '... it does have a message');
119 ok(!defined($string->validate("Five")), '... validated successfully (no error)');
121 is($string->validate(5),
122 "This is not a string (5)",
123 '... validated unsuccessfully (got error)');
125 lives_ok { Mouse::Meta::Attribute->new('bob', isa => 'Spong') }
126 'meta-attr construction ok even when type constraint utils loaded first';
128 # Test type constraint predicate return values.
130 foreach my $predicate (qw/equals is_subtype_of is_a_type_of/) {
131 ok( !defined $string->$predicate('DoesNotExist'), "$predicate predicate returns undef for non existant constraint");
134 # Test adding things which don't look like types to the registry throws an exception
136 my $r = Mouse::Util::TypeConstraints->get_type_constraint_registry;
137 throws_ok {$r->add_type_constraint()} qr/not a valid type constraint/, '->add_type_constraint(undef) throws';
138 throws_ok {$r->add_type_constraint('foo')} qr/not a valid type constraint/, '->add_type_constraint("foo") throws';
139 throws_ok {$r->add_type_constraint(bless {}, 'SomeClass')} qr/not a valid type constraint/, '->add_type_constraint(SomeClass->new) throws';
141 # Test some specific things that in the past did not work,
142 # specifically weird variations on anon subtypes.
145 my $subtype = subtype as 'Str';
146 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got an anon subtype' );
147 is( $subtype->parent->name, 'Str', 'parent is Str' );
148 # This test sucks but is the best we can do
149 is( $subtype->constraint->(), 1,
150 'subtype has the null constraint' );
151 ok( ! $subtype->has_message, 'subtype has no message' );
155 my $subtype = subtype as 'ArrayRef[Num|Str]';
156 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got an anon subtype' );
157 is( $subtype->parent->name, 'ArrayRef[Num|Str]', 'parent is ArrayRef[Num|Str]' );
158 ok( ! $subtype->has_message, 'subtype has no message' );
162 my $subtype = subtype 'ArrayRef[Num|Str]' => message { 'foo' };
163 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got an anon subtype' );
164 is( $subtype->parent->name, 'ArrayRef[Num|Str]', 'parent is ArrayRef[Num|Str]' );
165 ok( $subtype->has_message, 'subtype does have a message' );
168 # alternative sugar-less calling style which is documented as legit:
170 my $subtype = subtype( 'MyStr', { as => 'Str' } );
171 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got a subtype' );
172 is( $subtype->name, 'MyStr', 'name is MyStr' );
173 is( $subtype->parent->name, 'Str', 'parent is Str' );
177 my $subtype = subtype( { as => 'Str' } );
178 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got a subtype' );
179 is( $subtype->name, '__ANON__', 'name is __ANON__' );
180 is( $subtype->parent->name, 'Str', 'parent is Str' );
184 my $subtype = subtype( { as => 'Str', where => sub { /X/ } } );
185 isa_ok( $subtype, 'Mouse::Meta::TypeConstraint', 'got a subtype' );
186 is( $subtype->name, '__ANON__', 'name is __ANON__' );
187 is( $subtype->parent->name, 'Str', 'parent is Str' );
188 ok( $subtype->check('FooX'), 'constraint accepts FooX' );
189 ok( ! $subtype->check('Foo'), 'constraint reject Foo' );
193 throws_ok { subtype 'Foo' } qr/cannot consist solely of a name/,
194 'Cannot call subtype with a single string argument';
197 # Back-compat for being called without sugar. Previously, calling with
198 # sugar was indistinguishable from calling directly.
201 no warnings 'redefine';
202 *Mouse::Deprecated::deprecated = sub { return };
206 my $type = type( 'Number2', sub { Scalar::Util::looks_like_number($_) } );
208 ok( $type->check(5), '... this is a Num' );
209 ok( ! $type->check('Foo'), '... this is not a Num' );
214 my $subtype = subtype( 'Number2', sub { $_ > 0 } );
216 ok( $subtype->check(5), '... this is a Natural');
217 ok( ! $subtype->check(-5), '... this is not a Natural');
218 ok( ! $subtype->check('Foo'), '... this is not a Natural');
222 my $subtype = subtype( 'Natural2', 'Number2', sub { $_ > 0 } );
224 ok( $subtype->check(5), '... this is a Natural');
225 ok( ! $subtype->check(-5), '... this is not a Natural');
226 ok( ! $subtype->check('Foo'), '... this is not a Natural');
230 my $subtype = subtype( 'Natural3', 'Number2' );
232 ok( $subtype->check(5), '... this is a Natural');
233 ok( $subtype->check(-5), '... this is a Natural');
234 ok( ! $subtype->check('Foo'), '... this is not a Natural');