#!/usr/bin/perl use strict; use warnings; use Test::More; use Moose::Util::TypeConstraints; my $Str = find_type_constraint('Str'); isa_ok( $Str, 'Moose::Meta::TypeConstraint' ); my $Undef = find_type_constraint('Undef'); isa_ok( $Undef, 'Moose::Meta::TypeConstraint' ); ok( !$Str->check(undef), '... Str cannot accept an Undef value' ); ok( $Str->check('String'), '... Str can accept an String value' ); ok( !$Undef->check('String'), '... Undef cannot accept an Str value' ); ok( $Undef->check(undef), '... Undef can accept an Undef value' ); my $Str_or_Undef = Moose::Meta::TypeConstraint::Union->new( type_constraints => [ $Str, $Undef ] ); isa_ok( $Str_or_Undef, 'Moose::Meta::TypeConstraint::Union' ); ok( $Str_or_Undef->check(undef), '... (Str | Undef) can accept an Undef value' ); ok( $Str_or_Undef->check('String'), '... (Str | Undef) can accept a String value' ); ok( !$Str_or_Undef->is_a_type_of($Str), "not a subtype of Str" ); ok( !$Str_or_Undef->is_a_type_of($Undef), "not a subtype of Undef" ); cmp_ok( $Str_or_Undef->find_type_for('String'), 'eq', 'Str', 'find_type_for Str' ); cmp_ok( $Str_or_Undef->find_type_for(undef), 'eq', 'Undef', 'find_type_for Undef' ); ok( !defined( $Str_or_Undef->find_type_for( sub { } ) ), 'no find_type_for CodeRef' ); ok( !$Str_or_Undef->equals($Str), "not equal to Str" ); ok( $Str_or_Undef->equals($Str_or_Undef), "equal to self" ); ok( $Str_or_Undef->equals( Moose::Meta::TypeConstraint::Union->new( type_constraints => [ $Str, $Undef ] ) ), "equal to clone" ); ok( $Str_or_Undef->equals( Moose::Meta::TypeConstraint::Union->new( type_constraints => [ $Undef, $Str ] ) ), "equal to reversed clone" ); ok( !$Str_or_Undef->is_a_type_of("ThisTypeDoesNotExist"), "not type of non existent type" ); ok( !$Str_or_Undef->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of non existent type" ); is( $Str_or_Undef->parent, find_type_constraint('Item'), 'parent of Str|Undef is Item' ); is_deeply( [$Str_or_Undef->parents], [find_type_constraint('Item')], 'parents of Str|Undef is Item' ); # another .... my $ArrayRef = find_type_constraint('ArrayRef'); isa_ok( $ArrayRef, 'Moose::Meta::TypeConstraint' ); my $HashRef = find_type_constraint('HashRef'); isa_ok( $HashRef, 'Moose::Meta::TypeConstraint' ); ok( $ArrayRef->check( [] ), '... ArrayRef can accept an [] value' ); ok( !$ArrayRef->check( {} ), '... ArrayRef cannot accept an {} value' ); ok( $HashRef->check( {} ), '... HashRef can accept an {} value' ); ok( !$HashRef->check( [] ), '... HashRef cannot accept an [] value' ); my $ArrayRef_or_HashRef = Moose::Meta::TypeConstraint::Union->new( type_constraints => [ $ArrayRef, $HashRef ] ); isa_ok( $ArrayRef_or_HashRef, 'Moose::Meta::TypeConstraint::Union' ); ok( $ArrayRef_or_HashRef->check( [] ), '... (ArrayRef | HashRef) can accept []' ); ok( $ArrayRef_or_HashRef->check( {} ), '... (ArrayRef | HashRef) can accept {}' ); ok( !$ArrayRef_or_HashRef->check( \( my $var1 ) ), '... (ArrayRef | HashRef) cannot accept scalar refs' ); ok( !$ArrayRef_or_HashRef->check( sub { } ), '... (ArrayRef | HashRef) cannot accept code refs' ); ok( !$ArrayRef_or_HashRef->check(50), '... (ArrayRef | HashRef) cannot accept Numbers' ); diag $ArrayRef_or_HashRef->validate( [] ); ok( !defined( $ArrayRef_or_HashRef->validate( [] ) ), '... (ArrayRef | HashRef) can accept []' ); ok( !defined( $ArrayRef_or_HashRef->validate( {} ) ), '... (ArrayRef | HashRef) can accept {}' ); like( $ArrayRef_or_HashRef->validate( \( my $var2 ) ), qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/, '... (ArrayRef | HashRef) cannot accept scalar refs' ); like( $ArrayRef_or_HashRef->validate( sub { } ), qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/, '... (ArrayRef | HashRef) cannot accept code refs' ); is( $ArrayRef_or_HashRef->validate(50), 'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)', '... (ArrayRef | HashRef) cannot accept Numbers' ); is( $ArrayRef_or_HashRef->parent, find_type_constraint('Ref'), 'parent of ArrayRef|HashRef is Ref' ); my $double_union = Moose::Meta::TypeConstraint::Union->new( type_constraints => [ $Str_or_Undef, $ArrayRef_or_HashRef ] ); is( $double_union->parent, find_type_constraint('Item'), 'parent of (Str|Undef)|(ArrayRef|HashRef) is Item' ); ok( $double_union->is_subtype_of('Item'), '(Str|Undef)|(ArrayRef|HashRef) is a subtype of Item' ); ok( $double_union->is_a_type_of('Item'), '(Str|Undef)|(ArrayRef|HashRef) is a type of Item' ); ok( !$double_union->is_a_type_of('Str'), '(Str|Undef)|(ArrayRef|HashRef) is not a type of Str' ); type 'SomeType', where { 1 }; type 'OtherType', where { 1 }; my $parentless_union = Moose::Meta::TypeConstraint::Union->new( type_constraints => [ find_type_constraint('SomeType'), find_type_constraint('OtherType'), ], ); is($parentless_union->parent, undef, "no common ancestor gives undef parent"); done_testing;