for my $name ( sort keys %tests ) {
test_constraint( $name, $tests{$name} );
+
+ test_constraint(
+ Moose::Util::TypeConstraints::find_or_create_type_constraint(
+ "$name|$name"),
+ $tests{$name}
+ );
}
-# We need to test that the Str constraint accepts the return val of substr() -
-# which means passing that return val directly to the checking code
+my %substr_test_str = (
+ ClassName => 'x' . $CLASS_NAME,
+ RoleName => 'x' . $ROLE_NAME,
+);
+
+# We need to test that the Str constraint (and types that derive from it)
+# accept the return val of substr() - which means passing that return val
+# directly to the checking code
+foreach my $type_name (qw(Str Num Int ClassName RoleName))
{
- my $str = 'some string';
+ my $str = $substr_test_str{$type_name} || '123456789';
- my $type = Moose::Util::TypeConstraints::find_type_constraint('Str');
+ my $type = Moose::Util::TypeConstraints::find_type_constraint($type_name);
my $unoptimized
= $type->has_parent
}
ok(
- $type->check( substr( $str, 1, 3 ) ),
- 'Str accepts return val from substr using ->check'
+ $type->check( substr( $str, 1, 5 ) ),
+ $type_name . ' accepts return val from substr using ->check'
);
ok(
- $unoptimized->( substr( $str, 1, 3 ) ),
- 'Str accepts return val from substr using unoptimized constraint'
+ $unoptimized->( substr( $str, 1, 5 ) ),
+ $type_name . ' accepts return val from substr using unoptimized constraint'
);
ok(
- $inlined->( substr( $str, 1, 3 ) ),
- 'Str accepts return val from substr using inlined constraint'
+ $inlined->( substr( $str, 1, 5 ) ),
+ $type_name . ' accepts return val from substr using inlined constraint'
);
+ # only Str accepts empty strings.
+ next unless $type_name eq 'Str';
+
ok(
$type->check( substr( $str, 0, 0 ) ),
- 'Str accepts empty return val from substr using ->check'
+ $type_name . ' accepts empty return val from substr using ->check'
);
ok(
$unoptimized->( substr( $str, 0, 0 ) ),
- 'Str accepts empty return val from substr using unoptimized constraint'
+ $type_name . ' accepts empty return val from substr using unoptimized constraint'
);
ok(
$inlined->( substr( $str, 0, 0 ) ),
- 'Str accepts empty return val from substr using inlined constraint'
+ $type_name . ' accepts empty return val from substr using inlined constraint'
);
}
}
);
}
+{
+ note 'Anonymous Union Test';
+
+ my $union = union(['Int','Object']);
+
+ test_constraint(
+ $union, {
+ accept => [
+ $ZERO,
+ $ONE,
+ $INT,
+ $NEG_INT,
+ $FH_OBJECT,
+ $REGEX,
+ $REGEX_OBJ,
+ $FAKE_REGEX,
+ $OBJECT,
+ ],
+ reject => [
+ $NUM,
+ $NEG_NUM,
+ $EMPTY_STRING,
+ $STRING,
+ $NUM_IN_STRING,
+ $INT_WITH_NL1,
+ $INT_WITH_NL2,
+ $SCALAR_REF,
+ $SCALAR_REF_REF,
+ $ARRAY_REF,
+ $HASH_REF,
+ $CODE_REF,
+ $GLOB,
+ $GLOB_REF,
+ $FH,
+ $UNDEF,
+ ],
+ }
+ );
+}
+{
+ note 'Named Union Test';
+ union 'NamedUnion' => ['Int','Object'];
+
+ test_constraint(
+ 'NamedUnion', {
+ accept => [
+ $ZERO,
+ $ONE,
+ $INT,
+ $NEG_INT,
+ $FH_OBJECT,
+ $REGEX,
+ $REGEX_OBJ,
+ $FAKE_REGEX,
+ $OBJECT,
+ ],
+ reject => [
+ $NUM,
+ $NEG_NUM,
+ $EMPTY_STRING,
+ $STRING,
+ $NUM_IN_STRING,
+ $INT_WITH_NL1,
+ $INT_WITH_NL2,
+ $SCALAR_REF,
+ $SCALAR_REF_REF,
+ $ARRAY_REF,
+ $HASH_REF,
+ $CODE_REF,
+ $GLOB,
+ $GLOB_REF,
+ $FH,
+ $UNDEF,
+ ],
+ }
+ );
+}
+
+{
+ note 'Combined Union Test';
+ my $union = union( [ 'Int', enum( [qw[ red green blue ]] ) ] );
+
+ test_constraint(
+ $union, {
+ accept => [
+ $ZERO,
+ $ONE,
+ $INT,
+ $NEG_INT,
+ 'red',
+ 'green',
+ 'blue',
+ ],
+ reject => [
+ 'yellow',
+ 'pink',
+ $FH_OBJECT,
+ $REGEX,
+ $REGEX_OBJ,
+ $FAKE_REGEX,
+ $OBJECT,
+ $NUM,
+ $NEG_NUM,
+ $EMPTY_STRING,
+ $STRING,
+ $NUM_IN_STRING,
+ $INT_WITH_NL1,
+ $INT_WITH_NL2,
+ $SCALAR_REF,
+ $SCALAR_REF_REF,
+ $ARRAY_REF,
+ $HASH_REF,
+ $CODE_REF,
+ $GLOB,
+ $GLOB_REF,
+ $FH,
+ $UNDEF,
+ ],
+ }
+ );
+}
+
+
+{
+ enum 'Enum1' => 'a', 'b';
+ enum 'Enum2' => 'x', 'y';
+
+ subtype 'EnumUnion', as 'Enum1 | Enum2';
+
+ test_constraint(
+ 'EnumUnion', {
+ accept => [qw( a b x y )],
+ reject => [
+ $ZERO,
+ $ONE,
+ $INT,
+ $NEG_INT,
+ $NUM,
+ $NEG_NUM,
+ $EMPTY_STRING,
+ $STRING,
+ $NUM_IN_STRING,
+ $INT_WITH_NL1,
+ $INT_WITH_NL2,
+ $SCALAR_REF,
+ $SCALAR_REF_REF,
+ $ARRAY_REF,
+ $HASH_REF,
+ $CODE_REF,
+ $GLOB,
+ $GLOB_REF,
+ $FH,
+ $FH_OBJECT,
+ $REGEX,
+ $REGEX_OBJ,
+ $FAKE_REGEX,
+ $OBJECT,
+ $UNDEF,
+ ],
+ }
+ );
+}
{
package DoesRole;