Commit | Line | Data |
---|---|---|
bbd2fe69 | 1 | #!/usr/bin/perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
a28e50e4 | 6 | use Test::More; |
53a4d826 | 7 | use Test::Exception; |
bbd2fe69 | 8 | |
7ff56534 | 9 | use Moose::Util::TypeConstraints; |
bbd2fe69 | 10 | |
11 | =pod | |
12 | ||
d03bd989 | 13 | This tests demonstrates that Moose will not override |
14 | a preexisting type constraint of the same name when | |
bbd2fe69 | 15 | making constraints for a Moose-class. |
16 | ||
17 | It also tests that an attribute which uses a 'Foo' for | |
d03bd989 | 18 | it's isa option will get the subtype Foo, and not a |
bbd2fe69 | 19 | type representing the Foo moose class. |
20 | ||
21 | =cut | |
22 | ||
d03bd989 | 23 | BEGIN { |
bbd2fe69 | 24 | # create this subtype first (in BEGIN) |
d03bd989 | 25 | subtype Foo |
26 | => as 'Value' | |
bbd2fe69 | 27 | => where { $_ eq 'Foo' }; |
28 | } | |
29 | ||
30 | { # now seee if Moose will override it | |
31 | package Foo; | |
bbd2fe69 | 32 | use Moose; |
33 | } | |
34 | ||
35 | my $foo_constraint = find_type_constraint('Foo'); | |
36 | isa_ok($foo_constraint, 'Moose::Meta::TypeConstraint'); | |
37 | ||
38 | is($foo_constraint->parent->name, 'Value', '... got the Value subtype for Foo'); | |
39 | ||
40 | ok($foo_constraint->check('Foo'), '... my constraint passed correctly'); | |
41 | ok(!$foo_constraint->check('Bar'), '... my constraint failed correctly'); | |
42 | ||
43 | { | |
44 | package Bar; | |
bbd2fe69 | 45 | use Moose; |
d03bd989 | 46 | |
bbd2fe69 | 47 | has 'foo' => (is => 'rw', isa => 'Foo'); |
48 | } | |
49 | ||
50 | my $bar = Bar->new; | |
51 | isa_ok($bar, 'Bar'); | |
52 | ||
53a4d826 | 53 | lives_ok { |
d03bd989 | 54 | $bar->foo('Foo'); |
53a4d826 | 55 | } '... checked the type constraint correctly'; |
bbd2fe69 | 56 | |
53a4d826 | 57 | dies_ok { |
d03bd989 | 58 | $bar->foo(Foo->new); |
53a4d826 | 59 | } '... checked the type constraint correctly'; |
bbd2fe69 | 60 | |
a28e50e4 | 61 | done_testing; |