-
Notifications
You must be signed in to change notification settings - Fork 135
/
subtypes.t
227 lines (182 loc) · 7.28 KB
/
subtypes.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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
use v6;
use Test;
=begin description
Tests subtypes, specifically in the context of multimethod dispatch.
=end description
# L<S12/"Types and Subtypes">
my $abs = '
our multi sub my_abs (Int $n where { $^n >= 0 }){ $n }
our multi sub my_abs (Int $n where { $^n < 0 }){ -$n }
';
ok(eval("$abs; 1"), "we can compile subtype declarations");
is(eval("my_abs(3)"), 3, "and we can use them, too");
is(eval("my_abs(-5)"), 5, "and they actually work");
# another nice example
{
multi factorial (Int $x) { $x * factorial($x-1) };
multi factorial (Int $x where 0 ) { 1 }; #OK not used
is factorial(3), 6, 'subset types refine candidate matches';
}
# Basic subtype creation
{
subset Num::Odd of Num where { $^num % 2 == 1 };
#?rakudo 2 todo 'subsets and eval (?)'
is eval('my Num::Odd $a = 3'), 3, "3 is an odd num";
# The eval inside the eval is/will be necessary to hider our smarty
# compiler's compile-time from bailing.
# (Actually, if the compiler is *really* smarty, it will notice our eval trick,
# too :))
is eval('my Num::Odd $b = 3; try { $b = eval "4" }; $b'), 3,
"objects of Num::Odd don't get even";
# Subtypes should be undefined.
nok Num::Odd.defined, 'subtypes are undefined';
# Subs with arguments of a subtype
sub only_accepts_odds(Num::Odd $odd) { $odd + 1 }
is only_accepts_odds(3), 4, "calling sub worked";
dies_ok { only_accepts_odds(4) }, "calling sub did not work";
# Normal Ints automatically morphed to Num::Odd
sub is_num_odd(Num::Odd $odd) { $odd ~~ Num::Odd },
ok is_num_odd(3), "Int accepted by Num::Odd";
}
# The same, but lexically
{
my subset Num::Even of Num where { $^num % 2 == 0 }
ok my Num::Even $c = 6;
ok $c ~~ Num::Even, "our var is a Num::Even";
try { $c = eval 7 }
is $c, 6, "setting a Num::Even to an odd value dies";
#?rakudo todo 'lexical subtypes'
ok eval('!try { my Num::Even $d }'),
"lexically declared subtype went out of scope";
}
# Following code is evil, but should work:
#?rakudo skip 'scoping bug'
{
my Int $multiple_of;
subset Num::Multiple of Int where { $^num % $multiple_of == 0 }
$multiple_of = 5;
ok $multiple_of ~~ Int, "basic sanity (1)";
is $multiple_of, 5, "basic sanity (2)";
ok (my Num::Multiple $d = 10), "creating a new Num::Multiple";
is $d, 10, "creating a new Num::Multiple actually worked";
dies_ok { $d = 7 }, 'negative test also works';
is $d, 10, 'variable kept previous value';
$multiple_of = 6;
dies_ok { my Num::Multiple $e = 10 }, "changed subtype definition worked";
}
# Rakudo had a bug where 'where /regex/' failed
# http://rt.perl.org/rt3/Ticket/Display.html?id=60976
#?DOES 2
{
subset HasA of Str where /a/;
lives_ok { my HasA $x = 'bla' }, 'where /regex/ works (positive)';
eval_dies_ok 'my HasA $x = "foo"', 'where /regex/ works (negative)';
}
# You can write just an expression rather than a block after where in a sub
# and it will smart-match it.
{
sub anon_where_1($x where "x") { 1 } #OK not used
sub anon_where_2($x where /x/) { 1 } #OK not used
is(anon_where_1('x'), 1, 'where works with smart-matching on string');
dies_ok({ anon_where_1('y') }, 'where works with smart-matching on string');
is(anon_where_2('x'), 1, 'where works with smart-matching on regex');
is(anon_where_2('xyz'), 1, 'where works with smart-matching on regex');
dies_ok({ anon_where_2('y') }, 'where works with smart-matching on regex');
}
# Block parameter to smart-match is readonly.
{
subset SoWrong of Str where { $^epic = "fail" }
sub so_wrong_too($x where { $^epic = "fail" }) { } #OK not used
my SoWrong $x;
dies_ok({ $x = 42 }, 'parameter in subtype is read-only...');
dies_ok({ so_wrong_too(42) }, '...even in anonymous ones.');
}
# ensure that various operations do type cheks
{
subset AnotherEven of Int where { $_ % 2 == 0 };
my AnotherEven $x = 2;
dies_ok { $x++ }, 'Even $x can not be ++ed';
is $x, 2, '..and the value was preserved';
dies_ok { $x-- }, 'Even $x can not be --ed';
is $x, 2, 'and the value was preserved';
}
{
# chained subset types
subset Positive of Int where { $_ > 0 };
subset NotTooLarge of Positive where { $_ < 10 };
my NotTooLarge $x;
lives_ok { $x = 5 }, 'can satisfy both conditions on chained subset types';
dies_ok { $x = -2 }, 'violating first condition barfs';
dies_ok { $x = 22 }, 'violating second condition barfs';
}
# subtypes based on user defined classes and roles
{
class C1 { has $.a }
subset SC1 of C1 where { .a == 42 }
ok !(C1.new(a => 1) ~~ SC1), 'subtypes based on classes work';
ok C1.new(a => 42) ~~ SC1, 'subtypes based on classes work';
}
{
role R1 { };
subset SR1 of R1 where 1;
ok !(1 ~~ SR1), 'subtypes based on roles work';
my $x = 1 but R1;
ok $x ~~ SR1, 'subtypes based on roles work';
}
subset NW1 of Int;
ok NW1 ~~ Int, 'subset declaration without where clause does type it refines';
ok 0 ~~ NW1, 'subset declaration without where clause accepts right value';
ok 42 ~~ NW1, 'subset declaration without where clause accepts right value';
ok 4.2 !~~ NW1, 'subset declaration without where clause rejects wrong value';
ok "x" !~~ NW1, 'subset declaration without where clause rejects wrong value';
# RT #65700
{
subset Small of Int where { $^n < 10 }
class RT65700 {
has Small $.small;
}
dies_ok { RT65700.new( small => 20 ) }, 'subset type is enforced as attribute in new() (1)';
lives_ok { RT65700.new( small => 2 ) }, 'subset type enforced as attribute in new() (2)';
my subset Teeny of Int where { $^n < 10 }
class T { has Teeny $.teeny }
#?rakudo 2 todo 'RT 65700'
dies_ok { T.new( small => 20 ) }, 'my subset type is enforced as attribute in new() (1)';
lives_ok { T.new( small => 2 ) }, 'my subset type enforced as attribute in new() (2)';
}
# RT #78318
{
my @*rt78318;
subset Bug of Int where { @*rt78318.push( 'bug' ) };
subset Hunt of Bug where { @*rt78318.push( 'hunt' ) };
78318 ~~ Hunt;
#?rakudo todo 'RT 78318'
is @*rt78318, <bug hunt>, 'code called when subtype built on subtype';
}
# RT #78322
{
my $*call1;
my $*call2;
$*call1 = 0;$*call2 = 0;
subset RT78322 of Int where { $*call1++; $^a == 78322 };
subset Bughunt of RT78322 where { $*call2++; ?1 };
$*call1 = 0;$*call2 = 0;
nok 22 ~~ RT78322, 'level one subset check is false';
is $*call1, 1, 'level one subset checked (should fail)';
is $*call2, 0, 'level two subset not checked';
#?rakudo 3 todo 'RT 78322'
$*call1 = 0;$*call2 = 0;
nok 22 ~~ Bughunt, 'overall subset check is false';
is $*call1, 1, 'level one subset checked (should fail)';
is $*call2, 0, 'level two subset not checked';
$*call1 = 0;$*call2 = 0;
ok 78322 ~~ RT78322, 'level one subset check is true';
is $*call1, 1, 'level one subset checked (should succeed)';
is $*call2, 0, 'level two subset not checked';
$*call1 = 0;$*call2 = 0;
ok 78322 ~~ Bughunt, 'overall subset check is true';
#?rakudo 2 todo 'RT 78322'
is $*call1, 1, 'level one subset checked (should succeed)';
is $*call2, 1, 'level two subset checked (should succeed)';
}
done;
# vim: ft=perl6