t/type_constraints/union_is_a_type_of.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::Fatal;
   7 use Test::More;
   8
   9 use Moose::Util::TypeConstraints 'find_type_constraint';
  10
  11 use Moose::Meta::TypeConstraint::Union;
  12
  13 my ( $item, $int, $classname, $num )
  14     = map { find_type_constraint($_) } qw{Item Int ClassName Num};
  15
  16 ok( $int->is_subtype_of($item),       'Int is subtype of Item' );
  17 ok( $classname->is_subtype_of($item), 'ClassName is subtype of Item' );
  18 ok(
  19     ( not $int->is_subtype_of($classname) ),
  20     'Int is not subtype of ClassName'
  21 );
  22 ok(
  23     ( not $classname->is_subtype_of($int) ),
  24     'ClassName is not subtype of Int'
  25 );
  26
  27 my $union = Moose::Meta::TypeConstraint::Union->new(
  28     type_constraints => [ $int, $classname ] );
  29
  30 my @domain_values = qw( 85439 Moose::Meta::TypeConstraint );
  31 is(
  32     exception { $union->assert_valid($_) },
  33     undef,
  34     qq{Union accepts "$_".}
  35 ) for @domain_values;
  36
  37 ok(
  38     $union->is_subtype_of( find_type_constraint($_) ),
  39     "Int|ClassName is a subtype of $_"
  40 ) for qw{Item Defined Value Str};
  41
  42 ok(
  43     ( not $union->is_subtype_of( find_type_constraint($_) ) ),
  44     "Int|ClassName is not a subtype of $_"
  45 ) for qw{Num Int ClassName};
  46
  47 ok(
  48     ( not $union->is_a_type_of( find_type_constraint($_) ) ),
  49     "Int|ClassName is not a type of $_"
  50 ) for qw{Int ClassName};
  51 done_testing;