Commit | Line | Data |
---|---|---|
bbd2fe69 | 1 | #!/usr/bin/perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
7ff56534 | 6 | use Test::More tests => 7; |
bbd2fe69 | 7 | use Test::Exception; |
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 | ||
1808c2da | 38 | is($foo_constraint->parent->name, 'Value', 'got the Value subtype for Foo'); |
bbd2fe69 | 39 | |
1808c2da | 40 | ok($foo_constraint->check('Foo'), 'my constraint passed correctly'); |
41 | ok(!$foo_constraint->check('Bar'), 'my constraint failed correctly'); | |
bbd2fe69 | 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 | ||
53 | lives_ok { | |
d03bd989 | 54 | $bar->foo('Foo'); |
1808c2da | 55 | } 'checked the type constraint correctly'; |
bbd2fe69 | 56 | |
57 | dies_ok { | |
d03bd989 | 58 | $bar->foo(Foo->new); |
1808c2da | 59 | } 'checked the type constraint correctly'; |
bbd2fe69 | 60 | |
61 | ||
62 |