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 | |
28fdde7f | 13 | use Moose::Util::TypeConstraints; |
4d5f58e3 | 14 | |
b10dde3a | 15 | is( exception { |
9978e85e | 16 | subtype 'ParentConstraint' => as 'Str' => where {0}; |
b10dde3a | 17 | }, undef, 'specified parent type constraint' ); |
4d5f58e3 | 18 | |
19 | my $tc; | |
b10dde3a | 20 | is( exception { |
9978e85e | 21 | $tc = subtype 'ChildConstraint' => as 'ParentConstraint' => where {1}; |
b10dde3a | 22 | }, undef, 'specified child type constraint' ); |
4d5f58e3 | 23 | |
24 | { | |
9978e85e | 25 | my $errmsg = $tc->validate(); |
4d5f58e3 | 26 | |
9978e85e | 27 | TODO: { |
28 | local $TODO = 'Not yet supported'; | |
29 | ok($errmsg !~ /Validation failed for 'ChildConstraint'/, 'exception references failing parent constraint'); | |
30 | }; | |
4d5f58e3 | 31 | } |
a28e50e4 | 32 | |
33 | done_testing; |