Skip to content

Commit 169bc82

Browse files
KaiepiKaiepi
committed
Add tests for Parameter.BUILD
1 parent 925e482 commit 169bc82

File tree

2 files changed

+292
-0
lines changed

2 files changed

+292
-0
lines changed

‎S06-parameters/constructor.t‎

Lines changed: 291 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,291 @@
1+
use v6;
2+
use MONKEY-SEE-NO-EVAL;
3+
use Test;
4+
5+
plan 86;
6+
7+
for <$scalar @positional %associative &callable> -> Str:D $name {
8+
subtest $name, {
9+
plan 3;
10+
11+
my Parameter:D $lhs .= new: :$name;
12+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
13+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
14+
is $lhs.name, $rhs.name, 'parameter has the correct name';
15+
cmp-ok $lhs.type, &[=:=], $rhs.type, 'parameter has the correct type';
16+
};
17+
}
18+
19+
given <\sigilless> -> Str:D $name {
20+
subtest $name, {
21+
plan 3;
22+
23+
my Parameter:D $lhs .= new: :$name;
24+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
25+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
26+
is $lhs.name, $rhs.name, 'parameter has the correct name';
27+
is $lhs.raw, $rhs.raw, 'parameter is raw';
28+
};
29+
}
30+
31+
given <$*dynamic> -> Str:D $name {
32+
subtest $name, {
33+
plan 3;
34+
35+
my Parameter:D $lhs .= new: :$name;
36+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
37+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
38+
is $lhs.twigil, $rhs.twigil, 'parameter has the correct twigil';
39+
is $lhs.name, $rhs.name, 'parameter has the correct name';
40+
};
41+
}
42+
43+
for <$!private-attribute $.public-attribute> -> Str:D $name {
44+
subtest $name, {
45+
plan 3;
46+
47+
my Parameter:D $lhs .= new: :$name;
48+
my Parameter:D $rhs = Qs:to/CONTAINER/.&EVAL.^lookup('container').signature.params[1];
49+
class { has $name; method container($name) { } }
50+
CONTAINER
51+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
52+
is $lhs.twigil, $rhs.twigil, 'parameter has the correct twigil';
53+
is $lhs.name, $rhs.name, 'parameter has the correct name';
54+
};
55+
}
56+
57+
for <:$named :nested($named) :nested(:$named)> -> Str:D $name {
58+
subtest $name, {
59+
plan 3;
60+
61+
my Parameter:D $lhs .= new: :$name;
62+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
63+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
64+
cmp-ok $lhs.named_names, &[eqv], $rhs.named_names, 'parameter has the correct named names';
65+
is $lhs.name, $rhs.name, 'parameter has the correct name';
66+
};
67+
}
68+
69+
given <:$*dynamic> -> Str:D $name {
70+
subtest $name, {
71+
plan 4;
72+
73+
my Parameter:D $lhs .= new: :$name;
74+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
75+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
76+
is $lhs.twigil, $rhs.twigil, 'parameter has the correct twigil';
77+
cmp-ok $lhs.named_names, &[eqv], $rhs.named_names, 'parameter has the correct named names';
78+
is $lhs.name, $rhs.name, 'parameter has the correct name';
79+
};
80+
}
81+
82+
for <:$!private-attribute :$.public-attribute> -> Str:D $name {
83+
subtest $name, {
84+
plan 4;
85+
86+
my Parameter:D $lhs .= new: :$name;
87+
my Parameter:D $rhs = Qs:to/CONTAINER/.&EVAL.^lookup('container').signature.params[1];
88+
class { has $name.substr(1); method container($name) { } }
89+
CONTAINER
90+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
91+
is $lhs.twigil, $rhs.twigil, 'parameter has the correct twigil';
92+
cmp-ok $lhs.named_names, &[eqv], $rhs.named_names, 'parameter has the correct named names';
93+
is $lhs.name, $rhs.name, 'parameter has the correct name';
94+
};
95+
}
96+
97+
for <$optional? $mandatory! :$optional? :$mandatory!> -> Str:D $name {
98+
subtest $name, {
99+
plan 3;
100+
101+
my Parameter:D $lhs .= new: :$name;
102+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
103+
is $lhs.suffix, $rhs.suffix, 'parameter has the correct suffix';
104+
is $lhs.name, $rhs.name, 'parameter has the correct name';
105+
is $lhs.optional, $rhs.optional, 'parameter has the correct optionality';
106+
};
107+
}
108+
109+
given <*%slurpy> -> Str:D $name {
110+
subtest $name, {
111+
plan 5;
112+
113+
my Parameter:D $lhs .= new: :$name;
114+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
115+
is $lhs.prefix, $rhs.prefix, 'parameter has the correct prefix';
116+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
117+
is $lhs.name, $rhs.name, 'parameter has the correct name';
118+
is $lhs.named, $rhs.named, 'parameter is named';
119+
is $lhs.slurpy, $rhs.slurpy, 'parameter is slurpy';
120+
};
121+
}
122+
123+
for <*@slurpy **@slurpy +@slurpy> -> Str:D $name {
124+
subtest $name, {
125+
plan 5;
126+
127+
my Parameter:D $lhs .= new: :$name;
128+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
129+
is $lhs.prefix, $rhs.prefix, 'parameter has the correct prefix';
130+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
131+
is $lhs.name, $rhs.name, 'parameter has the correct name';
132+
is $lhs.positional, $rhs.positional, 'parameter is positional';
133+
is $lhs.slurpy, $rhs.slurpy, 'parameter is slurpy';
134+
};
135+
}
136+
137+
given <+slurpy> -> Str:D $name {
138+
subtest $name, {
139+
plan 6;
140+
141+
my Parameter:D $lhs .= new: :$name;
142+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
143+
is $lhs.prefix, $rhs.prefix, 'parameter has the correct prefix';
144+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
145+
is $lhs.name, $rhs.name, 'parameter has the correct name';
146+
is $lhs.positional, $rhs.positional, 'parameter is positional';
147+
is $lhs.slurpy, $rhs.slurpy, 'parameter is slurpy';
148+
is $lhs.raw, $rhs.raw, 'parameter is raw';
149+
};
150+
}
151+
152+
given <|capture> -> Str:D $name {
153+
subtest $name, {
154+
plan 5;
155+
156+
my Parameter:D $lhs .= new: :$name;
157+
my Parameter:D $rhs = ":($name)".&EVAL.params[0];
158+
is $lhs.prefix, $rhs.prefix, 'parameter has the correct prefix';
159+
is $lhs.sigil, $rhs.sigil, 'parameter has the correct sigil';
160+
is $lhs.name, $rhs.name, 'parameter has the correct name';
161+
is $lhs.capture, $rhs.capture, 'parameter is a capture';
162+
is $lhs.raw, $rhs.raw, 'parameter is raw';
163+
};
164+
}
165+
166+
for <*%slurpy *@slurpy **@slurpy +@slurpy +slurpy |capture> X~ <! ?> -> Str:D $name {
167+
# XXX: These need to be bound due to a bug in &[eqv]'s Parameter
168+
# candidate.
169+
my Parameter:D $lhs := Parameter.new: :$name;
170+
my Parameter:D $rhs := Parameter.new: :name($name.chop);
171+
cmp-ok $lhs, &[eqv], $rhs, "'$name' is equivalent to '$name.chop()'";
172+
}
173+
174+
given <$scalar> -> Str:D $name {
175+
ok Parameter.new(:$name, :named).named,
176+
'can mark parameters as being named';
177+
ok Parameter.new(:$name, :optional).optional,
178+
'can mark parameters as being optional';
179+
nok Parameter.new(:$name, :named, :mandatory).optional,
180+
'can mark parameters as being mandatory';
181+
ok Parameter.new(:name("$name?"), :mandatory).optional,
182+
'optional positional parameters ignore any mandatory marker';
183+
nok Parameter.new(:name("$name!"), :optional).optional,
184+
'mandatory positional parameters ignore any optional marker';
185+
ok Parameter.new(:name("$name?"), :named, :mandatory).optional,
186+
'optional named parameters ignore any mandatory marker';
187+
nok Parameter.new(:name("$name!"), :named, :optional).optional,
188+
'mandatory named parameters ignore any optional marker';
189+
ok Parameter.new(:$name, :is-copy).copy,
190+
'can mark parameters as being copies';
191+
ok Parameter.new(:$name, :is-raw).raw,
192+
'can mark parameters as being raw';
193+
nok Parameter.new(:$name, :is-rw).readonly,
194+
'can mark mandatory scalar parameters as being rw';
195+
ok Parameter.new(:$name, :named, :is-rw).readonly,
196+
'cannot mark optional scalar parameters as being rw';
197+
}
198+
199+
for <@positional %associative &callable> -> Str:D $name {
200+
my Str:D $kind = $name.substr: 1;
201+
ok Parameter.new(:$name, :is-rw).readonly, "cannot mark mandatory $kind parameters as being rw";
202+
ok Parameter.new(:$name, :named, :is-rw).readonly, "cannot mark optional $kind parameters as being rw";
203+
}
204+
205+
given <\sigilless> -> Str:D $name {
206+
my Str:D $kind = $name.substr: 1;
207+
nok Parameter.new(:$name, :is-rw).readonly, "cannot mark $kind parameters as being rw";
208+
}
209+
210+
given 1 -> Int:D $default {
211+
for <$scalar :$scalar> -> Str:D $name {
212+
my Parameter:D $parameter .= new: :$name, :$default;
213+
ok $parameter.default, "'$name' can have a default value";
214+
}
215+
for <*@slurpy **@slurpy +@slurpy +slurpy |capture> -> Str:D $name {
216+
my Parameter:D $parameter .= new: :$name, :$default;
217+
nok $parameter.default, "'$name' cannot have a default value";
218+
}
219+
}
220+
221+
given Any -> Mu $type is raw {
222+
cmp-ok Parameter.new(:$type).type, &[=:=], $type, 'can pass type objects as types to Parameter.new';
223+
cmp-ok Parameter.new(:type($type.new)).type, &[=:=], $type, 'can pass instances as types to Parameter.new';
224+
}
225+
226+
given <Int> -> Str:D $type {
227+
for <$typed @typed %typed &typed> -> Str:D $name {
228+
my Parameter:D $lhs .= new: :$name, :$type;
229+
my Parameter:D $rhs = ":($type $name)".&EVAL.params[0];
230+
cmp-ok $lhs.type, &[=:=], $rhs.type, "'$type $name' has the correct type";
231+
}
232+
}
233+
234+
given <Int:D> -> Str:D $type {
235+
for <$typed @typed %typed &typed> -> Str:D $name {
236+
subtest "$type $name", {
237+
plan 2;
238+
239+
my Parameter:D $lhs .= new: :$name, :$type;
240+
my Parameter:D $rhs = ":($type $name)".&EVAL.params[0];
241+
cmp-ok $lhs.type, &[=:=], $rhs.type, "parameter has the correct type";
242+
is $lhs.modifier, $rhs.modifier, "parameter has the correct modifier";
243+
}
244+
}
245+
}
246+
247+
given <Int(Num(Str))> -> Str:D $type {
248+
for <$typed @typed %typed &typed> -> Str:D $name {
249+
subtest "$type $name", {
250+
plan 2;
251+
252+
my Parameter:D $lhs .= new: :$name, :$type;
253+
my Parameter:D $rhs = ":($type $name)".&EVAL.params[0];
254+
is $lhs.type.^name, $rhs.type.^name, 'parameter has the correct type';
255+
is $lhs.coerce_type.^name, $rhs.coerce_type.^name, 'parameter has the correct coercion type';
256+
};
257+
}
258+
}
259+
260+
given <Int:D(Num:U(Str:_))> -> Str:D $type {
261+
for <$typed @typed %typed &typed> -> Str:D $name {
262+
subtest "$type $name", {
263+
plan 3;
264+
265+
my Parameter:D $lhs .= new: :$name, :$type;
266+
my Parameter:D $rhs = ":($type $name)".&EVAL.params[0];
267+
is $lhs.type.^name, $rhs.type.^name, 'parameter has the correct type';
268+
is $lhs.coerce_type.^name, $rhs.coerce_type.^name, 'parameter has the correct coercion type';
269+
is $lhs.modifier, $rhs.modifier, 'parameter has the correct modifier';
270+
};
271+
}
272+
}
273+
274+
given Int:D -> Mu $type is raw {
275+
for <*@slurpy **@slurpy +@slurpy +slurpy |capture> -> Str:D $name {
276+
my Parameter:D $param .= new: :$name, :$type;
277+
cmp-ok $param.type, &[!=:=], $type, "'$type.^name() $name' does not get typed";
278+
}
279+
}
280+
281+
given <$constrained>, ({ 1 },) -> [Str:D $name, @where] {
282+
my Parameter:D $param = Parameter.new: :$name, :@where;
283+
cmp-ok @where.all, &[~~], $param.constraints, "'$name where 1' has the correct constraints";
284+
}
285+
286+
given <@sub-signatured>, :(Int:D) -> [Str:D $name, Signature:D $sub-signature] {
287+
my Parameter:D $param = Parameter.new: :$name, :$sub-signature;
288+
cmp-ok (1,), &[~~], $param.sub_signature, "'$name $sub-signature.gist()' has the correct sub-signature";
289+
}
290+
291+
# vim: expandtab shiftwidth=4

‎spectest.data‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -530,6 +530,7 @@ S06-other/main-semicolon.t
530530
S06-other/misc.t
531531
S06-other/pairs-as-lvalues.t
532532
S06-parameters/smiley.t
533+
S06-parameters/constructor.t
533534
S06-routine-modifiers/lvalue-subroutines.t
534535
S06-routine-modifiers/native-lvalue-subroutines.t
535536
S06-routine-modifiers/proxy.t

0 commit comments

Comments
 (0)