Subject: | Union types reports spurious parent types |
After reading the documentation of Moose::Meta::TypeConstraint::Union, I
believe I have found a nasty error.
If you have a type constraint hierarchy:
Defined
Value
Str
Num
Int
ClassName
RoleName
This means that anything a Num constraint matches, is always matched by
any of its parents, i.e. Value and Defined. Generally, any constraint
will always match any value that has been matched by any of its children.
The same is stated in Moose::Manual::Types:
A subtype is defined in terms of a parent type and a constraint. Any
constraints defined by the parent(s) will be checked first, followed by
constraints defined by the subtype. A value must pass all of these
checks to be valid for the subtype.
Looking in the documentation of Moose::Meta::TypeConstraint::Union, it
states something very different:
$constraint->is_a_type_of($type_name_or_object)
This returns true if any of the member type constraints return true
for the is_a_type_of method.
$constraint->is_subtype_of
This returns true if any of the member type constraints return true
for the is_a_subtype_of method.
The word "any" (occuring twice above) should be replaced with "all".
Also, the code behaves as written.
I've written the test attached to illustrate the issue.
(Run on Ubuntu 9.x, perl 5.10.0.)
Subject: | union_subtype.t |
#!perl
use Test::More;
use Moose;
use Moose::Util::TypeConstraints 'find_type_constraint';
use Moose::Meta::TypeConstraint::Union;
my($item, $int, $classname, $num) = map {find_type_constraint($_)} qw{Item Int ClassName Num};
ok($int->is_subtype_of($item), 'Int is subtype of Item');
ok($classname->is_subtype_of($item), 'ClassName is subtype of Item');
ok((not $int->is_subtype_of($classname)), 'Int is not subtype of ClassName');
ok((not $classname->is_subtype_of($int)), 'ClassName is not subtype of Int');
my $union = Moose::Meta::TypeConstraint::Union->new(
type_constraints => [$int, $classname]
);
my @domain_values = qw{85439 Moose::Meta::TypeConstraint};
ok($union->constraint->($_), "Composite accepts \"$_\".")
for @domain_values;
diag "Finished warming up. All the tests above should pass.";
diag "Now to the tests that fail because of the bug reported.";
diag "Any proper parent type should pass all the following tests:";
for(@{$union->parents}) {
my $type_con = find_type_constraint($_);
diag "Testing parent: $_";
ok($type_con->constraint->($_), "Parent accepts \"$_\".")
for @domain_values;
}
diag "In other words, a union type can't rely on being type of all the types used:";
diag "In this case, \$union should be a subtype of Item, Defined, Value and Str:";
ok($union->is_subtype_of(find_type_constraint($_)), "Union is subtype of $_")
for qw{Item Defined Value Str};
diag "But not a subtype of Num:";
ok((not $union->is_subtype_of(find_type_constraint($_))), "Union is not subtype of $_")
for qw{Num Int ClassName};
diag "And definately not a type of Int or ClassName:";
ok((not $union->is_a_type_of(find_type_constraint($_))), "Union is not type of $_")
for qw{Int ClassName};
done_testing;