Require Dist::Zilla 4.200016+

[gitmo/Moose.git] / t / type_constraints / union_types.t

#!/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;