/
named-parameters.t
337 lines (277 loc) · 11.3 KB
/
named-parameters.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
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
use v6;
use Test;
plan 93;
# L<S06/Required parameters/"Passing a named argument that cannot be bound to
# a normal subroutine is also a fatal error.">
{
sub a($x = 4) {
return $x;
}
is a(3), 3, 'Can pass positional arguments';
#?pugs skip 'Named argument found where no matched parameter expected'
dies_ok { eval('a(g=>7)') }, 'Dies on passing superfluous arguments';
}
{
sub c(:$w=4){
return $w;
}
is c(w => 3), 3, 'Named argument passes an integer, not a Pair';
my $w = 5;
is c(:$w), 5, 'can use :$x colonpair syntax to call named arg';
#?pugs skip 'Named argument found where no matched parameter expected'
dies_ok {eval('my $y; c(:$y)')}, 'colonpair with wrong variable name dies';
}
{
sub add5(:$g) {
return $g + 5;
}
class A {
has $!g = 3;
method colonpair_private { add5(:$!g) }
};
class B {
has $.g = 7;
method colonpair_public { add5(:$.g) }
};
sub colonpair_positional {
add5(:$^g);
}
is A.new.colonpair_private, 8, 'colonpair with a privare variable';
is B.new.colonpair_public, 12, 'colonpair with a public variable';
#?rakudo skip 'nom regression'
#?pugs skip 'Named argument found where no matched parameter expected'
is colonpair_positional(:g<10>), 15, 'colonpair with a positional variable';
}
# L<S06/Named parameters/marked by a prefix>
sub simple_pos_params (:$x) { $x }
is(simple_pos_params( x => 4 ), 4, "simple named param");
sub foo (:$x = 3) { $x }
is(foo(), 3, "not specifying named params that aren't mandatory works");
# part of RT 53814
#?pugs todo 'bug'
dies_ok({foo(4)}, "using a named as a positional fails");
is(foo( x => 5), 5, "naming named param also works");
is(foo( :x<5> ), 5, "naming named param adverb-style also works");
sub foo2 (:$x = 3, :$y = 5) { $x + $y }
is(foo2(), 8, "not specifying named params that aren't mandatory works (foo2)");
#?pugs 2 todo 'bug'
dies_ok({foo2(4)}, "using a named as a positional fails (foo2)");
dies_ok({foo2(4, 10)}, "using a named as a positional fails (foo2)");
is(foo2( x => 5), 10, "naming named param x also works (foo2)");
is(foo2( y => 3), 6, "naming named param y also works (foo2)");
is(foo2( x => 10, y => 10), 20, "naming named param x & y also works (foo2)");
is(foo2( :x(5) ), 10, "naming named param x adverb-style also works (foo2)");
is(foo2( :y(3) ), 6, "naming named param y adverb-style also works (foo2)");
is(foo2( :x(10), :y(10) ), 20, "naming named params x & y adverb-style also works (foo2)");
is(foo2( x => 10, :y(10) ), 20, "mixing fat-comma and adverb naming styles also works for named params (foo2)");
is(foo2( :x(10), y => 10 ), 20, "mixing adverb and fat-comma naming styles also works for named params (foo2)");
#?pugs emit # dies with Undeclared variable on the $x here.
#?pugs emit #
sub assign_based_on_named_positional ($x, :$y = $x) { $y }
#?pugs skip "depends on previous sub"
is(assign_based_on_named_positional(5), 5, "When we don't explicitly specify, we get the original value");
#?pugs skip "depends on previous sub"
is(assign_based_on_named_positional(5, y => 2), 2, "When we explicitly specify, we get our value");
#?pugs skip "depends on previous sub"
is(assign_based_on_named_positional('y'=>2), ('y'=>2), "When we explicitly specify, we get our value");
#?pugs emit #
my $var = "y";
#?pugs skip "depends on previous sub"
is(assign_based_on_named_positional($var => 2), ("y"=>2),
"When we explicitly specify, we get our value");
# L<S06/Named arguments/multiple same-named arguments>
#?rakudo skip 'multiple same-named arguments NYI'
#?niecza skip 'multiple same-named arguments NYI'
#?pugs skip 'multiple same-named arguments NYI'
{
sub named_array(:@x) { +«@x }
is(named_array(:x), (1), 'named array taking one named arg');
is(named_array(:x, :!x), (1, 0), 'named array taking two named args');
is(named_array(:x(1), :x(2), :x(3)), (1, 2, 3), 'named array taking three named args');
}
# L<S06/Named arguments/Pairs intended as positional arguments>
#?rakudo skip 'multiple same-named arguments NYI'
#?niecza skip 'multiple same-named arguments NYI'
#?pugs skip 'unexpected =>'
{
sub named_array2(@x, :y) { (+«@x, 42, +«@y) }
# +«(:x) is (0, 1)
is(named_array2(:!x, :y), (0, 42, 1), 'named and unnamed args - two named');
is(named_array2(:!x, y => 1), (0, 42, 1), 'named and unnamed args - two named - fatarrow');
is(named_array2(:y, :!x), (0, 42, 1), 'named and unnamed args - two named - backwards');
is(named_array2(:y, (:x)), (0, 1, 42, 1), 'named and unnamed args - one named, one pair');
is(named_array2(1, 2), (1, 42), 'named and unnamed args - two unnamed');
is(named_array2(:!y, 1), (1, 42, 0), 'named and unnamed args - one named, one pos');
is(named_array2(1, :!y), (1, 42, 0), 'named and unnamed args - one named, one pos - backwards');
is(named_array2(:y, 1, :!y), (1, 42, 1, 0), 'named and unnamed args - two named, one pos');
nok(try { eval 'named_array2(:y, :y)'}.defined, 'named and unnamed args - two named with same name');
is(named_array2(:y, (:x)), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair');
is(named_array2(:y, (:y)), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair of same name');
is(named_array2(:y, :z), (0, 1, 42, 1), 'named and unnamed args - passing pair of unrelated name');
is(named_array2(:y, "x" => 1), (0, 1, 42, 1), 'named and unnamed args - passing pair with quoted fatarrow');
}
# L<S06/Named parameters/They are marked by a prefix>
# L<S06/Required parameters/declared with a trailing>
sub mandatory (:$param!) {
return $param;
}
is(mandatory(param => 5) , 5, "named mandatory parameter is returned");
#?pugs todo
dies_ok {eval 'mandatory()' }, "not specifying a mandatory parameter fails";
#?niecza skip "Unhandled trait required"
{
sub mandatory_by_trait (:$param is required) {
return $param;
}
is(mandatory_by_trait(param => 5) , 5, "named mandatory parameter is returned");
dies_ok( { mandatory_by_trait() }, "not specifying a mandatory parameter fails");
}
# L<S06/Named parameters/sub formalize>
sub formalize($text, :$case, :$justify) {
return($text,$case,$justify);
}
{
my ($text,$case,$justify) = formalize('title', case=>'upper');
is($text,'title', "text param was positional");
nok($justify.defined, "justification param was not given");
is($case, 'upper', "case param was named, and in justification param's position");
}
{
my ($text,$case,$justify) = formalize('title', justify=>'left');
is($text,'title', "text param was positional");
is($justify, 'left', "justify param was named");
nok($case.defined, "case was not given at all");
}
{
my ($text,$case,$justify) = formalize("title", :justify<right>, :case<title>);
is($text,'title', "title param was positional");
is($justify, 'right', "justify param was named with funny syntax");
is($case, 'title', "case param was named with funny syntax");
}
{
sub h($a,$b,$d) { $d ?? h($b,$a,$d-1) !! $a~$b }
is(h('a','b',1),'ba',"parameters don\'t bind incorrectly");
}
# Slurpy Hash Params
{
sub slurpee(*%args) { return %args }
my %fellowship = slurpee(hobbit => 'Frodo', wizard => 'Gandalf');
is(%fellowship<hobbit>, 'Frodo', "hobbit arg was slurped");
is(%fellowship<wizard>, 'Gandalf', "wizard arg was slurped");
is(+%fellowship, 2, "exactly 2 arguments were slurped");
nok(%fellowship<dwarf>.defined, "dwarf arg was not given");
}
{
sub named_and_slurp(:$grass, *%rest) { return($grass, %rest) }
my ($grass, %rest) = named_and_slurp(sky => 'blue', grass => 'green', fire => 'red');
is($grass, 'green', "explicit named arg received despite slurpy hash");
#?pugs todo
is(+%rest, 2, "exactly 2 arguments were slurped");
#?pugs todo
is(%rest<sky>, 'blue', "sky argument was slurped");
is(%rest<fire>, 'red', "fire argument was slurped");
nok(%rest<grass>.defined, "grass argument was NOT slurped");
}
{
my $ref;
sub setref($refin) {
$ref = $refin;
}
my $aref = [0];
setref($aref);
$aref[0]++;
is($aref[0], 1, "aref actually implemented");
is($ref[0], 1, "ref is the same as aref");
}
{
sub typed_named(Int :$x) { 1 }
is(typed_named(:x(42)), 1, 'typed named parameters work...');
is(typed_named(), 1, '...when value not supplied also...');
#?pugs todo
dies_ok({ typed_named("BBQ") }, 'and the type check is enforced');
}
#?pugs skip 'parsefail'
{
sub renames(:y($x)) { $x }
is(renames(:y(42)), 42, 'renaming of parameters works');
is(renames(y => 42), 42, 'renaming of parameters works');
dies_ok { renames(:x(23)) }, 'old name is not available';
}
# L<S06/Parameters and arguments/"A signature containing a name collision">
#?niecza 2 todo "sub params with the same name"
#?pugs todo
eval_dies_ok 'sub rt68086( $a, $a ) { }', 'two sub params with the same name';
#?pugs todo
eval_dies_ok 'sub svn28865( :$a, :@a ) {}',
'sub params with the same name and different types';
{
sub svn28870( $a, @a ) { return ( $a, +@a ) }
my $item = 'bughunt';
my @many = ( 22, 'twenty-two', 47 );
is( svn28870( $item, @many ), ( 'bughunt', 3 ),
'call to sub with position params of same name and different type' );
}
# RT #68524
#?pugs todo
{
sub rt68524( :$a! ) {}
ok( &rt68524.signature.perl ~~ m/\!/,
'.signature.perl with required parameter includes requirement' );
}
# RT #69516
#?pugs skip 'parsefail'
{
sub rt69516( :f($foo) ) { "You passed '$foo' as 'f'" }
ok( &rt69516.signature.perl ~~ m/ ':f(' \s* '$foo' \s* ')' /,
'parameter rename appears in .signature.perl' );
}
# L<S06/Named parameters/Bindings happen in declaration order>
#?rakudo skip 'where constraints'
#?pugs skip 'parsefail'
{
my $t = '';
sub order_test($a where { $t ~= 'a' }, #OK not used
$b where { $t ~= 'b' }, #OK not used
$c where { $t ~= 'c' }) { 8 }; #OK not used
is order_test(c => 5, a => 3, b => 2), 8,
'can fill positional by name';
ok $t ~~ /a.*b/, '$a was bound before $b';
ok $t ~~ /a.*c/, '$a was bound before $c';
ok $t ~~ /b.*c/, '$b was bound before $c';
}
# RT #67558
#?pugs skip 'parsefail'
{
#?niecza todo "Renaming a parameter to an existing positional should fail"
eval_dies_ok q[sub a(:$x, :foo($x) = $x) { $x }],
'Cannot rename a parameter to an already existing positional';
sub a(:$x, :foo($y) = $x) { $y };
is a(x => 2), 2, 'Can fill named parameter with default from other named';
is a(foo => 3), 3, 'Can fill in directly even it has a default value';
is a(x => 2, foo => 3), 3, 'direct fill takes precedence';
}
{
sub test_positional_named(:@a) { @a.join('|'); }
is test_positional_named(:a(3, 4, 5)), '3|4|5',
':a(1, 2, 3) can be passed to a :@a parameter';
is test_positional_named(:a[3, 4, 5]), '3|4|5',
':a[1, 2, 3] can be passed to a :@a parameter';
is test_positional_named(:a<3 4 5>), '3|4|5',
':a<1 2 3> can be passed to a :@a parameter';
}
#?pugs todo
{
sub quoted_named(:$x = 5) { $x };
dies_ok { quoted_named( "x" => 5 ) }, 'quoted pair key => positional parameter';
}
#?niecza skip "Abbreviated named parameter must have a name"
#?pugs skip 'parsefail'
{
sub named_empty(:$) {
42
}
my %h = '' => 500;
is named_empty(|%h), 42, 'can call function with empty named argument';
}
done;
# vim: ft=perl6