-
Notifications
You must be signed in to change notification settings - Fork 135
/
named-parameters.t
244 lines (196 loc) · 8.8 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
use v6;
use Test;
plan *;
# 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';
eval_dies_ok('a(g=>7)', 'Dies on passing superfluous arguments');
}
{
sub b($x) {
return $x;
}
is b(:x(3)), 3, 'Can pass positional parameters as named ones';
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';
eval_dies_ok 'my $y; c(:$y)', 'colonpair with wrong variable name dies';
}
# L<S06/Named parameters>
sub simple_pos_param($x) { $x }
is simple_pos_param(x => 3), 3, "positional param may be addressed by name (1)";
is simple_pos_param(:x(3)), 3, "positional param may be addressed by name (2)";
# 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)");
sub assign_based_on_named_positional ($x, :$y = $x) { $y }
is(assign_based_on_named_positional(5), 5, "When we don't explicitly specify, we get the original value");
is(assign_based_on_named_positional(5, y => 2), 2, "When we explicitly specify, we get our value");
is(assign_based_on_named_positional('y'=>2), ('y'=>2), "When we explicitly specify, we get our value");
my $var = "y";
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 'parsefail'
{
sub named_array(:@x) { +«@x }
is(eval('named_array(:x)'), (1), 'named array taking one named arg');
is(eval('named_array(:x, :!x)'), (1, 0), 'named array taking two named args');
is(eval('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 'parsefail'
{
sub named_array2(@x, :@y) { (+«@x, 42, +«@y) }
# +«(:x) is (0, 1)
is(eval('named_array2(:!x, :y)'), (0, 42, 1), 'named and unnamed args - two named');
is(eval('named_array2(:!x, y => 1)'), (0, 42, 1), 'named and unnamed args - two named - fatarrow');
is(eval('named_array2(:y, :!x)'), (0, 42, 1), 'named and unnamed args - two named - backwards');
is(eval('named_array2(:y, (:x))'), (0, 1, 42, 1), 'named and unnamed args - one named, one pair');
is(eval('named_array2(1, 2)'), (1, 42), 'named and unnamed args - two unnamed');
is(eval('named_array2(:!y, 1)'), (1, 42, 0), 'named and unnamed args - one named, one pos');
is(eval('named_array2(1, :!y)'), (1, 42, 0), 'named and unnamed args - one named, one pos - backwards');
is(eval('named_array2(:y, 1, :!y)'), (1, 42, 1, 0), 'named and unnamed args - two named, one pos');
ok(eval('named_array2(:y, :y)') ~~ undef, 'named and unnamed args - two named with same name');
is(eval('named_array2(:y, (:x))'), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair');
is(eval('named_array2(:y, (:y))'), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair of same name');
is(eval('named_array2(:y, :z)'), (0, 1, 42, 1), 'named and unnamed args - passing pair of unrelated name');
is(eval('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");
eval_dies_ok('mandatory()', "not specifying a mandatory parameter fails");
#?rakudo skip 'Cannot apply trait required to parameters yet'
{
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) returns List {
return($text,$case,$justify);
}
#?rakudo skip 'parsefail'
{
my ($text,$case,$justify) = formalize('title', case=>'upper');
is($text,'title', "text param was positional");
ok($justify ~~ undef, "justification param was not given");
is($case, 'upper', "case param was named, and in justification param's position");
}
#?rakudo skip 'parsefail'
{
my ($text,$case,$justify) = formalize('title', justify=>'left');
is($text,'title', "text param was positional");
is($justify, 'left', "justify param was named");
ok($case ~~ undef, "case was not given at all");
}
#?rakudo skip 'parsefail'
{
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");
ok(%fellowship<dwarf> ~~ undef, "dwarf arg was not given");
}
#?rakudo skip 'parsefail on lvalue'
{
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");
is(+%rest, 2, "exactly 2 arguments were slurped");
is(%rest<sky>, 'blue', "sky argument was slurped");
is(%rest<fire>, 'red', "fire argument was slurped");
ok(%rest<grass> ~~ undef, "grass argument was NOT slurped");
}
{
my $ref;
sub setref($refin) {
$ref = $refin;
}
my $aref = [0];
setref(refin => $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...');
dies_ok({ typed_named("BBQ") }, 'and the type check is enforced');
}
{
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<06/Parameters and arguments/"All parameters must either have a unique name">
#?rakudo todo 'RT #68086'
eval_dies_ok 'sub rt68086( $a, $a ) { }', 'two sub params with the same name';
#?rakudo 3 todo 'sub params with the same name'
eval_dies_ok 'sub svn28865( $a, :a($b) ) {}',
'sub params with the same name via renaming';
eval_dies_ok 'sub svn28865( $a, :a(@b) ) {}',
'sub params with same name via renaming and different types';
eval_dies_ok 'sub svn28865( :$a, :@a ) {}',
'sub params with the same name and different types';
# RT #68524
{
sub rt68524( :$a! ) {}
ok( &rt68524.signature.perl ~~ m/\!/,
'.signature.perl with required parameter includes requirement' );
}
# RT #69516
{
sub rt69516( :f($foo) ) { "You passed '$foo' as 'f'" }
ok( &rt69516.signature.perl ~~ m/ ':f(' \s* '$foo' \s* ')' /,
'parameter rename appears in .signature.perl' );
}
done_testing;
# vim: ft=perl6