Commit | Line | Data |
---|---|---|
4d5f58e3 | 1 | #!/usr/bin/perl |
2 | ||
3 | # In the case where a child type constraint's parent constraint fails, | |
4 | # the exception should reference the parent type constraint that actually | |
5 | # failed instead of always referencing the child'd type constraint | |
6 | ||
7 | use strict; | |
8 | use warnings; | |
9 | ||
a28e50e4 | 10 | use Test::More; |
b10dde3a | 11 | use Test::Fatal; |
4d5f58e3 | 12 | |
13 | BEGIN { | |
9978e85e | 14 | use_ok('Moose::Util::TypeConstraints'); |
4d5f58e3 | 15 | } |
16 | ||
b10dde3a | 17 | is( exception { |
9978e85e | 18 | subtype 'ParentConstraint' => as 'Str' => where {0}; |
b10dde3a | 19 | }, undef, 'specified parent type constraint' ); |
4d5f58e3 | 20 | |
21 | my $tc; | |
b10dde3a | 22 | is( exception { |
9978e85e | 23 | $tc = subtype 'ChildConstraint' => as 'ParentConstraint' => where {1}; |
b10dde3a | 24 | }, undef, 'specified child type constraint' ); |
4d5f58e3 | 25 | |
26 | { | |
9978e85e | 27 | my $errmsg = $tc->validate(); |
4d5f58e3 | 28 | |
9978e85e | 29 | TODO: { |
30 | local $TODO = 'Not yet supported'; | |
31 | ok($errmsg !~ /Validation failed for 'ChildConstraint'/, 'exception references failing parent constraint'); | |
32 | }; | |
4d5f58e3 | 33 | } |
a28e50e4 | 34 | |
35 | done_testing; |