9 use Moose::Util::TypeConstraints;
10 use Moose::Meta::TypeConstraint;
13 ## Create a subclass with a custom method
16 package Test::Moose::Meta::TypeConstraint::AnySubType;
18 extends 'Moose::Meta::TypeConstraint';
20 sub my_custom_method {
25 my $Int = find_type_constraint('Int');
26 ok $Int, 'Got a good type constraint';
28 my $parent = Test::Moose::Meta::TypeConstraint::AnySubType->new({
29 name => "Test::Moose::Meta::TypeConstraint::AnySubType" ,
33 ok $parent, 'Created type constraint';
34 ok $parent->check(1), 'Correctly passed';
35 ok ! $parent->check('a'), 'correctly failed';
36 ok $parent->my_custom_method, 'found the custom method';
38 my $subtype1 = subtype 'another_subtype' => as $parent;
40 ok $subtype1, 'Created type constraint';
41 ok $subtype1->check(1), 'Correctly passed';
42 ok ! $subtype1->check('a'), 'correctly failed';
43 ok $subtype1->my_custom_method, 'found the custom method';
46 my $subtype2 = subtype 'another_subtype' => as $subtype1 => where { $_ < 10 };
48 ok $subtype2, 'Created type constraint';
49 ok $subtype2->check(1), 'Correctly passed';
50 ok ! $subtype2->check('a'), 'correctly failed';
51 ok ! $subtype2->check(100), 'correctly failed';
53 ok $subtype2->my_custom_method, 'found the custom method';
76 my $foo = class_type 'Foo';
77 my $isa_foo = subtype 'IsaFoo' => as $foo;
79 ok $isa_foo, 'Created subtype of Foo type';
80 ok $isa_foo->check( Foo->new ), 'Foo passes check';
81 ok $isa_foo->check( Bar->new ), 'Bar passes check';
82 ok ! $isa_foo->check( Baz->new ), 'Baz does not pass check';
83 like $foo->get_message( Baz->new ), qr/^Validation failed for 'Foo' with value .*Baz.* \(not isa Foo\)/, 'Better validation message';
85 # Maybe in the future this *should* inherit?
86 like $isa_foo->get_message( Baz->new ), qr/^Validation failed for 'IsaFoo' with value .*Baz.*/, "Subtypes do not automatically inherit parent type's message";
103 }, qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/ );
106 Quux->new(age => (bless {}, 'Positive'));
116 }, qr/^Attribute \(age\) does not pass the type constraint because: Validation failed for 'Positive' with value 3 \(not isa Positive\)/ );
119 Quux->new(age => Positive->new)
122 class_type 'Negative' => message { "$_ is not a Negative Nancy" };
136 Quux::Ier->new(age => 3)
137 }, qr/^Attribute \(age\) does not pass the type constraint because: 3 is not a Negative Nancy / );
140 Quux::Ier->new(age => (bless {}, 'Negative'))