t/type_constraints/union_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Moose::Util::TypeConstraints;
   9
  10 my $Str = find_type_constraint('Str');
  11 isa_ok( $Str, 'Moose::Meta::TypeConstraint' );
  12
  13 my $Undef = find_type_constraint('Undef');
  14 isa_ok( $Undef, 'Moose::Meta::TypeConstraint' );
  15
  16 ok( !$Str->check(undef),      '... Str cannot accept an Undef value' );
  17 ok( $Str->check('String'),    '... Str can accept an String value' );
  18 ok( !$Undef->check('String'), '... Undef cannot accept an Str value' );
  19 ok( $Undef->check(undef),     '... Undef can accept an Undef value' );
  20
  21 my $Str_or_Undef = Moose::Meta::TypeConstraint::Union->new(
  22     type_constraints => [ $Str, $Undef ] );
  23 isa_ok( $Str_or_Undef, 'Moose::Meta::TypeConstraint::Union' );
  24
  25 ok(
  26     $Str_or_Undef->check(undef),
  27     '... (Str | Undef) can accept an Undef value'
  28 );
  29 ok(
  30     $Str_or_Undef->check('String'),
  31     '... (Str | Undef) can accept a String value'
  32 );
  33
  34 ok( !$Str_or_Undef->is_a_type_of($Str),   "not a subtype of Str" );
  35 ok( !$Str_or_Undef->is_a_type_of($Undef), "not a subtype of Undef" );
  36
  37 cmp_ok(
  38     $Str_or_Undef->find_type_for('String'), 'eq', 'Str',
  39     'find_type_for Str'
  40 );
  41 cmp_ok(
  42     $Str_or_Undef->find_type_for(undef), 'eq', 'Undef',
  43     'find_type_for Undef'
  44 );
  45 ok(
  46     !defined( $Str_or_Undef->find_type_for( sub { } ) ),
  47     'no find_type_for CodeRef'
  48 );
  49
  50 ok( !$Str_or_Undef->equals($Str),         "not equal to Str" );
  51 ok( $Str_or_Undef->equals($Str_or_Undef), "equal to self" );
  52 ok(
  53     $Str_or_Undef->equals(
  54         Moose::Meta::TypeConstraint::Union->new(
  55             type_constraints => [ $Str, $Undef ]
  56         )
  57     ),
  58     "equal to clone"
  59 );
  60 ok(
  61     $Str_or_Undef->equals(
  62         Moose::Meta::TypeConstraint::Union->new(
  63             type_constraints => [ $Undef, $Str ]
  64         )
  65     ),
  66     "equal to reversed clone"
  67 );
  68
  69 ok(
  70     !$Str_or_Undef->is_a_type_of("ThisTypeDoesNotExist"),
  71     "not type of non existent type"
  72 );
  73 ok(
  74     !$Str_or_Undef->is_subtype_of("ThisTypeDoesNotExist"),
  75     "not subtype of non existent type"
  76 );
  77
  78 is(
  79     $Str_or_Undef->parent,
  80     find_type_constraint('Item'),
  81     'parent of Str|Undef is Item'
  82 );
  83
  84 is(
  85     $Str_or_Undef->parents,
  86     find_type_constraint('Item'),
  87     'parents of Str|Undef is Item'
  88 );
  89
  90 # another ....
  91
  92 my $ArrayRef = find_type_constraint('ArrayRef');
  93 isa_ok( $ArrayRef, 'Moose::Meta::TypeConstraint' );
  94
  95 my $HashRef = find_type_constraint('HashRef');
  96 isa_ok( $HashRef, 'Moose::Meta::TypeConstraint' );
  97
  98 ok( $ArrayRef->check( [] ), '... ArrayRef can accept an [] value' );
  99 ok( !$ArrayRef->check( {} ), '... ArrayRef cannot accept an {} value' );
 100 ok( $HashRef->check(   {} ), '... HashRef can accept an {} value' );
 101 ok( !$HashRef->check( [] ), '... HashRef cannot accept an [] value' );
 102
 103 my $HashOrArray = Moose::Meta::TypeConstraint::Union->new(
 104     type_constraints => [ $ArrayRef, $HashRef ] );
 105 isa_ok( $HashOrArray, 'Moose::Meta::TypeConstraint::Union' );
 106
 107 ok( $HashOrArray->check( [] ), '... (ArrayRef | HashRef) can accept []' );
 108 ok( $HashOrArray->check( {} ), '... (ArrayRef | HashRef) can accept {}' );
 109
 110 ok(
 111     !$HashOrArray->check( \( my $var1 ) ),
 112     '... (ArrayRef | HashRef) cannot accept scalar refs'
 113 );
 114 ok(
 115     !$HashOrArray->check( sub { } ),
 116     '... (ArrayRef | HashRef) cannot accept code refs'
 117 );
 118 ok(
 119     !$HashOrArray->check(50),
 120     '... (ArrayRef | HashRef) cannot accept Numbers'
 121 );
 122
 123 diag $HashOrArray->validate( [] );
 124
 125 ok(
 126     !defined( $HashOrArray->validate( [] ) ),
 127     '... (ArrayRef | HashRef) can accept []'
 128 );
 129 ok(
 130     !defined( $HashOrArray->validate( {} ) ),
 131     '... (ArrayRef | HashRef) can accept {}'
 132 );
 133
 134 like(
 135     $HashOrArray->validate( \( my $var2 ) ),
 136     qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/,
 137     '... (ArrayRef | HashRef) cannot accept scalar refs'
 138 );
 139
 140 like(
 141     $HashOrArray->validate( sub { } ),
 142     qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/,
 143     '... (ArrayRef | HashRef) cannot accept code refs'
 144 );
 145
 146 is(
 147     $HashOrArray->validate(50),
 148     'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)',
 149     '... (ArrayRef | HashRef) cannot accept Numbers'
 150 );
 151
 152 is(
 153    $HasOr
 154
 155 done_testing;