Simplistic implementation of type intersections, modeled after the implementation...
[gitmo/Moose.git] / t / 040_type_constraints / 035_subtyping_intersection_types.t
CommitLineData
8aab053a 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 19;
7use Test::Exception;
8
9BEGIN {
10 use_ok("Moose::Util::TypeConstraints");
11}
12
13lives_ok {
14 subtype 'MyCollections' => as 'ArrayRef & Ref';
15} '... created the subtype special okay';
16
17{
18 my $t = find_type_constraint('MyCollections');
19 isa_ok($t, 'Moose::Meta::TypeConstraint');
20
21 is($t->name, 'MyCollections', '... name is correct');
22
23 my $p = $t->parent;
24 isa_ok($p, 'Moose::Meta::TypeConstraint::Intersection');
25 isa_ok($p, 'Moose::Meta::TypeConstraint');
26
27 is($p->name, 'ArrayRef&Ref', '... parent name is correct');
28
29 ok($t->check([]), '... validated it correctly');
30 ok(!$t->check(1), '... validated it correctly');
31}
32
33lives_ok {
34 subtype 'MyCollectionsExtended'
35 => as 'ArrayRef&Ref'
36 => where {
37 if (ref($_) eq 'ARRAY') {
38 return if scalar(@$_) < 2;
39 }
40 1;
41 };
42} '... created the subtype special okay';
43
44{
45 my $t = find_type_constraint('MyCollectionsExtended');
46 isa_ok($t, 'Moose::Meta::TypeConstraint');
47
48 is($t->name, 'MyCollectionsExtended', '... name is correct');
49
50 my $p = $t->parent;
51 isa_ok($p, 'Moose::Meta::TypeConstraint::Intersection');
52 isa_ok($p, 'Moose::Meta::TypeConstraint');
53
54 is($p->name, 'ArrayRef&Ref', '... parent name is correct');
55
56 ok(!$t->check([]), '... validated it correctly');
57 ok($t->check([1, 2]), '... validated it correctly');
58
59 ok($t->check([ one => 1, two => 2 ]), '... validated it correctly');
60
61 ok(!$t->check(1), '... validated it correctly');
62}
63
64