t/type_constraints/subtyping_parameterized_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Moose::Util::TypeConstraints;
  10
  11 is( exception {
  12     subtype 'MySpecialHash' => as 'HashRef[Int]';
  13 }, undef, '... created the subtype special okay' );
  14
  15 {
  16     my $t = find_type_constraint('MySpecialHash');
  17     isa_ok($t, 'Moose::Meta::TypeConstraint');
  18
  19     is($t->name, 'MySpecialHash', '... name is correct');
  20
  21     my $p = $t->parent;
  22     isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
  23     isa_ok($p, 'Moose::Meta::TypeConstraint');
  24
  25     is($p->name, 'HashRef[Int]', '... parent name is correct');
  26
  27     ok($t->check({ one => 1, two => 2 }), '... validated {one=>1, two=>2} correctly');
  28     ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
  29
  30     ok( $t->equals($t), "equals to self" );
  31     ok( !$t->equals( $t->parent ), "not equal to parent" );
  32     ok( $t->parent->equals( $t->parent ), "parent equals to self" );
  33
  34     ok( !$t->is_a_type_of("ThisTypeDoesNotExist"), "not a non existant type" );
  35     ok( !$t->is_subtype_of("ThisTypeDoesNotExist"), "not a subtype of a non existant type" );
  36 }
  37
  38 is( exception {
  39     subtype 'MySpecialHashExtended'
  40         => as 'HashRef[Int]'
  41         => where {
  42             # all values are less then 10
  43             (scalar grep { $_ < 10 } values %{$_}) ? 1 : undef
  44         };
  45 }, undef, '... created the subtype special okay' );
  46
  47 {
  48     my $t = find_type_constraint('MySpecialHashExtended');
  49     isa_ok($t, 'Moose::Meta::TypeConstraint');
  50
  51     is($t->name, 'MySpecialHashExtended', '... name is correct');
  52
  53     my $p = $t->parent;
  54     isa_ok($p, 'Moose::Meta::TypeConstraint::Parameterized');
  55     isa_ok($p, 'Moose::Meta::TypeConstraint');
  56
  57     is($p->name, 'HashRef[Int]', '... parent name is correct');
  58
  59     ok($t->check({ one => 1, two => 2 }), '... validated it correctly');
  60     ok(!$t->check({ zero => 10, one => 11, two => 12 }), '... validated { zero => 10, one => 11, two => 12 } correctly');
  61     ok(!$t->check({ one => "ONE", two => "TWO" }), '... validated it correctly');
  62 }
  63
  64 is( exception {
  65     subtype 'MyNonSpecialHash'
  66         => as "HashRef"
  67         => where { keys %$_ == 3 };
  68 }, undef );
  69
  70 {
  71     my $t = find_type_constraint('MyNonSpecialHash');
  72
  73     isa_ok($t, 'Moose::Meta::TypeConstraint');
  74     isa_ok($t, 'Moose::Meta::TypeConstraint::Parameterizable');
  75
  76     ok( $t->check({ one => 1, two => "foo", three => [] }), "validated" );
  77     ok( !$t->check({ one => 1 }), "failed" );
  78 }
  79
  80 {
  81     my $t = Moose::Util::TypeConstraints::find_or_parse_type_constraint('MyNonSpecialHash[Int]');
  82
  83     isa_ok($t, 'Moose::Meta::TypeConstraint');
  84
  85     ok( $t->check({ one => 1, two => 2, three => 3 }), "validated" );
  86     ok( !$t->check({ one => 1, two => "foo", three => [] }), "failed" );
  87     ok( !$t->check({ one => 1 }), "failed" );
  88 }
  89
  90 {
  91     ## Because to throw errors in M:M:Parameterizable needs Moose loaded in
  92     ## order to throw errors.  In theory the use Moose belongs to that class
  93     ## but when I put it there causes all sorts or trouble.  In theory this is
  94     ## never a real problem since you are likely to use Moose somewhere when you
  95     ## are creating type constraints.
  96     use Moose ();
  97
  98     my $MyArrayRefInt =  subtype 'MyArrayRefInt',
  99         as 'ArrayRef[Int]';
 100
 101     my $BiggerInt = subtype 'BiggerInt',
 102         as 'Int',
 103         where {$_>10};
 104
 105     my $SubOfMyArrayRef = subtype 'SubOfMyArrayRef',
 106         as 'MyArrayRefInt[BiggerInt]';
 107
 108     ok $MyArrayRefInt->check([1,2,3]), '[1,2,3] is okay';
 109     ok ! $MyArrayRefInt->check(["a","b"]), '["a","b"] is not';
 110     ok $BiggerInt->check(100), '100 is  big enough';
 111     ok ! $BiggerInt->check(5), '5 is  big enough';
 112     ok $SubOfMyArrayRef->check([15,20,25]), '[15,20,25] is a bunch of big ints';
 113     ok ! $SubOfMyArrayRef->check([15,5,25]), '[15,5,25] is NOT a bunch of big ints';
 114
 115     like( exception {
 116         my $SubOfMyArrayRef = subtype 'SubSubOfMyArrayRef',
 117             as 'SubOfMyArrayRef[Str]';
 118     }, qr/Str is not a subtype of BiggerInt/, 'Failed to parameterize with a bad type parameter' );
 119 }
 120
 121 {
 122     my $RefToInt = subtype as 'ScalarRef[Int]';
 123
 124     ok $RefToInt->check(\1), '\1 is okay';
 125     ok !$RefToInt->check(1), '1 is not';
 126     ok !$RefToInt->check(\"foo"), '\"foo" is not';
 127 }
 128
 129 done_testing;