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 $ArrayRef_or_HashRef = Moose::Meta::TypeConstraint::Union->new(
 104     type_constraints => [ $ArrayRef, $HashRef ] );
 105 isa_ok( $ArrayRef_or_HashRef, 'Moose::Meta::TypeConstraint::Union' );
 106
 107 ok( $ArrayRef_or_HashRef->check( [] ),
 108     '... (ArrayRef | HashRef) can accept []' );
 109 ok( $ArrayRef_or_HashRef->check( {} ),
 110     '... (ArrayRef | HashRef) can accept {}' );
 111
 112 ok(
 113     !$ArrayRef_or_HashRef->check( \( my $var1 ) ),
 114     '... (ArrayRef | HashRef) cannot accept scalar refs'
 115 );
 116 ok(
 117     !$ArrayRef_or_HashRef->check( sub { } ),
 118     '... (ArrayRef | HashRef) cannot accept code refs'
 119 );
 120 ok(
 121     !$ArrayRef_or_HashRef->check(50),
 122     '... (ArrayRef | HashRef) cannot accept Numbers'
 123 );
 124
 125 diag $ArrayRef_or_HashRef->validate( [] );
 126
 127 ok(
 128     !defined( $ArrayRef_or_HashRef->validate( [] ) ),
 129     '... (ArrayRef | HashRef) can accept []'
 130 );
 131 ok(
 132     !defined( $ArrayRef_or_HashRef->validate( {} ) ),
 133     '... (ArrayRef | HashRef) can accept {}'
 134 );
 135
 136 like(
 137     $ArrayRef_or_HashRef->validate( \( my $var2 ) ),
 138     qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/,
 139     '... (ArrayRef | HashRef) cannot accept scalar refs'
 140 );
 141
 142 like(
 143     $ArrayRef_or_HashRef->validate( sub { } ),
 144     qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/,
 145     '... (ArrayRef | HashRef) cannot accept code refs'
 146 );
 147
 148 is(
 149     $ArrayRef_or_HashRef->validate(50),
 150     'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)',
 151     '... (ArrayRef | HashRef) cannot accept Numbers'
 152 );
 153
 154 is(
 155     $ArrayRef_or_HashRef->parent,
 156     find_type_constraint('Ref'),
 157     'parent of ArrayRef|HashRef is Ref'
 158 );
 159
 160 done_testing;