Commit | Line | Data |
b2b106d7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 9; |
7 | use Test::Exception; |
8 | |
9 | { |
10 | package Animal; |
11 | use Mouse; |
12 | use Mouse::Util::TypeConstraints; |
13 | |
14 | subtype 'Natural' => as 'Int' => where { $_ > 0 } => |
15 | message {"This number ($_) is not a positive integer!"}; |
16 | |
17 | subtype 'NaturalLessThanTen' => as 'Natural' => where { $_ < 10 } => |
18 | message {"This number ($_) is not less than ten!"}; |
19 | |
20 | has leg_count => ( |
21 | is => 'rw', |
22 | isa => 'NaturalLessThanTen', |
23 | lazy => 1, |
24 | default => 0, |
25 | ); |
26 | } |
27 | |
28 | lives_ok { my $goat = Animal->new( leg_count => 4 ) } |
29 | '... no errors thrown, value is good'; |
30 | lives_ok { my $spider = Animal->new( leg_count => 8 ) } |
31 | '... no errors thrown, value is good'; |
32 | |
33 | throws_ok { my $fern = Animal->new( leg_count => 0 ) } |
34 | qr/This number \(0\) is not less than ten!/, |
35 | 'gave custom supertype error message on new'; |
36 | |
37 | throws_ok { my $centipede = Animal->new( leg_count => 30 ) } |
38 | qr/This number \(30\) is not less than ten!/, |
39 | 'gave custom subtype error message on new'; |
40 | |
41 | my $chimera; |
42 | lives_ok { $chimera = Animal->new( leg_count => 4 ) } |
43 | '... no errors thrown, value is good'; |
44 | |
45 | throws_ok { $chimera->leg_count(0) } |
46 | qr/This number \(0\) is not less than ten!/, |
47 | 'gave custom supertype error message on set to 0'; |
48 | |
49 | throws_ok { $chimera->leg_count(16) } |
50 | qr/This number \(16\) is not less than ten!/, |
51 | 'gave custom subtype error message on set to 16'; |
52 | |
53 | my $gimp = eval { Animal->new() }; |
54 | is( $@, '', '... no errors thrown, value is good' ); |
55 | |
56 | throws_ok { $gimp->leg_count } |
57 | qr/This number \(0\) is not less than ten!/, |
58 | 'gave custom supertype error message on lazy set to 0'; |
59 | |