-
Notifications
You must be signed in to change notification settings - Fork 32
/
021_maybe_type_constraint.t
143 lines (108 loc) · 3.92 KB
/
021_maybe_type_constraint.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
#!/usr/bin/perl
# This is automatically generated by author/import-moose-test.pl.
# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
use t::lib::MooseCompat;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Mouse::Util::TypeConstraints;
use Mouse::Util;
my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]');
isa_ok($type, 'Mouse::Meta::TypeConstraint');
isa_ok($type, 'Mouse::Meta::TypeConstraint');
{ local $TODO = "not yet"; ok( $type->equals($type), "equals self" );
}
ok( !$type->equals($type->parent), "not equal to parent" );
ok( !$type->equals(find_type_constraint("Maybe")), "not equal to Maybe" );
{ local $TODO = "not yet"; ok( $type->parent->equals(find_type_constraint("Maybe")), "parent is Maybe" );
}
{ local $TODO = "not yet"; ok( $type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Int") ) ), "equal to clone" );
}
ok( !$type->equals( Mouse::Meta::TypeConstraint->new( name => "__ANON__", parent => find_type_constraint("Maybe"), type_parameter => find_type_constraint("Str") ) ), "not equal to clone with diff param" );
ok( !$type->equals( Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Str]') ), "not equal to declarative version of diff param" );
ok($type->check(10), '... checked type correctly (pass)');
ok($type->check(undef), '... checked type correctly (pass)');
ok(!$type->check('Hello World'), '... checked type correctly (fail)');
ok(!$type->check([]), '... checked type correctly (fail)');
{
package Bar;
use Mouse;
package Foo;
use Mouse;
use Mouse::Util::TypeConstraints;
has 'arr' => (is => 'rw', isa => 'Maybe[ArrayRef]', required => 1);
has 'bar' => (is => 'rw', isa => class_type('Bar'));
has 'maybe_bar' => (is => 'rw', isa => maybe_type(class_type('Bar')));
}
lives_ok {
Foo->new(arr => [], bar => Bar->new);
} '... Bar->new isa Bar';
dies_ok {
Foo->new(arr => [], bar => undef);
} '... undef isnta Bar';
lives_ok {
Foo->new(arr => [], maybe_bar => Bar->new);
} '... Bar->new isa maybe(Bar)';
lives_ok {
Foo->new(arr => [], maybe_bar => undef);
} '... undef isa maybe(Bar)';
dies_ok {
Foo->new(arr => [], maybe_bar => 1);
} '... 1 isnta maybe(Bar)';
lives_ok {
Foo->new(arr => []);
} '... it worked!';
lives_ok {
Foo->new(arr => undef);
} '... it worked!';
dies_ok {
Foo->new(arr => 100);
} '... failed the type check';
dies_ok {
Foo->new(arr => 'hello world');
} '... failed the type check';
{
package Test::MouseX::Types::Maybe;
use Mouse;
has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]');
has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]');
has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]');
has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]');
has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]');
}
ok my $obj = Test::MouseX::Types::Maybe->new
=> 'Create good test object';
## Maybe[Int]
ok my $Maybe_Int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]')
=> 'made TC Maybe[Int]';
ok $Maybe_Int->check(1)
=> 'passed (1)';
ok $obj->Maybe_Int(1)
=> 'assigned (1)';
{
local $TODO = "considered miss design" if Mouse::Util::MOUSE_XS();
ok eval { $Maybe_Int->check() }
=> 'passed ()';
}
ok $obj->Maybe_Int()
=> 'assigned ()';
ok $Maybe_Int->check(0)
=> 'passed (0)';
ok defined $obj->Maybe_Int(0)
=> 'assigned (0)';
ok $Maybe_Int->check(undef)
=> 'passed (undef)';
ok sub {$obj->Maybe_Int(undef); 1}->()
=> 'assigned (undef)';
ok !$Maybe_Int->check("")
=> 'failed ("")';
throws_ok sub { $obj->Maybe_Int("") },
qr/Attribute \(Maybe_Int\) does not pass the type constraint/
=> 'failed assigned ("")';
ok !$Maybe_Int->check("a")
=> 'failed ("a")';
throws_ok sub { $obj->Maybe_Int("a") },
qr/Attribute \(Maybe_Int\) does not pass the type constraint/
=> 'failed assigned ("a")';
done_testing;