Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 318 lines (253 sloc) 10.28 kb
dc30b33 [t/spec] add basic tests for slurpy parameters
moritz authored
1 use v6;
2 use Test;
3
0477942 some more smartlinks updated
szabgab authored
4 # L<S06/List parameters/Slurpy parameters>
5
edb878e [t/spec] Test for RT #65324
kyle authored
6 plan *;
dc30b33 [t/spec] add basic tests for slurpy parameters
moritz authored
7
8 sub xelems(*@args) { @args.elems }
9 sub xjoin(*@args) { @args.join('|') }
10
11 is xelems(1), 1, 'Basic slurpy params 1';
12 is xelems(1, 2, 5), 3, 'Basic slurpy params 2';
13
14 is xjoin(1), '1', 'Basic slurpy params 3';
15 is xjoin(1, 2, 5), '1|2|5', 'Basic slurpy params 4';
16
17 sub mixed($pos1, *@slurp) { "|$pos1|" ~ @slurp.join('!') }
18
19 is mixed(1), '|1|', 'Positional and slurp params';
20 is mixed(1, 2, 3), '|1|2!3', 'Positional and slurp params';
297e783 [t] and [t/spec]
moritz authored
21 dies_ok { mixed()}, 'at least one arg required';
dc30b33 [t/spec] add basic tests for slurpy parameters
moritz authored
22
7acf702 [t/spec] fudge slurpy-params.t for rakudo
moritz authored
23 #?rakudo skip 'types on slurpy params'
098b49a [t] merged blocks/splatty_with_type.t into spec/
moritz authored
24 {
25 sub x_typed_join(Int *@args){ @args.join('|') }
26 is x_typed_join(1), '1', 'Basic slurpy params with types 1';
27 is x_typed_join(1, 2, 5), '1|2|5', 'Basic slurpy params with types 2';
c2f8fec [t] and [t/spec] (two train travels worth of changes):
moritz authored
28 dies_ok { x_typed_join(3, 'x') }, 'Types on slurpy params are checked';
098b49a [t] merged blocks/splatty_with_type.t into spec/
moritz authored
29 }
30
297e783 [t] and [t/spec]
moritz authored
31 sub first_arg ( *@args ) { ~@args[0]; }
32 sub first_arg_rw ( *@args is rw ) { ~@args[0]; }
33 sub first_arg_copy ( *@args is copy ) { ~@args[0]; }
34
35 is first_arg(1, 2, 3), '1', 'can grab first item of a slurpy array';
36 is first_arg_rw(1, 2, 3), '1', 'can grab first item of a slurpy array (is rw)';
37 is first_arg_copy(1, 2, 3), '1', 'can grab first item of a slurpy array (is copy)';
38
798f791 [t/spec] merge shift-from-function-array-arg.t into slurpy-params.t
moritz authored
39 # test that shifting works
40 {
41 sub func(*@m) {
42 @m.shift;
43 return @m;
44 }
ba8e84a [t/spec] Change more Pugs todo flags to fudge commands
kyle authored
45 #?pugs todo 'bug'
46 is_deeply(func(5), [], "Shift from an array function argument works");
798f791 [t/spec] merge shift-from-function-array-arg.t into slurpy-params.t
moritz authored
47 }
48
49
4701aa5 [t/spec]: Unfudge a passing todo, add some implicit slurpy param tests.
pmichaud authored
50 sub whatever {
51 is(@_[3], 'd', 'implicit slurpy param flattens');
52 is(@_[2], 'c', 'implicit slurpy param flattens');
53 is(@_[1], 'b', 'implicit slurpy param flattens');
54 is(@_[0], 'a', 'implicit slurpy param flattens');
55 }
56
37590f7 [t/spec] p5=> is dead.
jnthn authored
57 whatever( 'a', 'b', 'c', 'd' );
4701aa5 [t/spec]: Unfudge a passing todo, add some implicit slurpy param tests.
pmichaud authored
58
331ffb3 [t/spec] merge slurpy-params{-2,}.t
moritz authored
59 # use to be t/spec/S06-signature/slurpy-params-2.t
60
61 # L<S06/List parameters/Slurpy parameters follow any required>
62
63 =begin pod
64
65 =head1 List parameter test
66
67 These tests are the testing for "List paameters" section of Synopsis 06
68
69 You might also be interested in the thread Calling positionals by name in
70 presence of a slurpy hash" on p6l started by Ingo
71 Blechschmidt L<http://www.nntp.perl.org/group/perl.perl6.language/22883>
72
73 =end pod
74
75
76 {
77 # Positional with slurpy *%h and slurpy *@a
78 my sub foo($n, *%h, *@a) { };
79 my sub foo1($n, *%h, *@a) { $n }
80 my sub foo2($n, *%h, *@a) { %h<x> + %h<y> + %h<n> }
81 my sub foo3($n, *%h, *@a) { [+] @a }
82
83 ## all pairs will be slurped into hash, except the key which has the same name
84 ## as positional parameter
85 diag('Testing with positional arguments');
86 lives_ok { foo 1, x => 20, y => 300, 4000 },
87 'Testing: `sub foo($n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
88 is (foo1 1, x => 20, y => 300, 4000), 1,
89 'Testing the value for positional';
90 is (foo2 1, x => 20, y => 300, 4000), 320,
91 'Testing the value for slurpy *%h';
92 is (foo3 1, x => 20, y => 300, 4000), 4000,
93 'Testing the value for slurpy *@a';
94
95 # XXX should this really die?
96 #?rakudo todo 'positional params can be accessed as named ones'
97 dies_ok { foo 1, n => 20, y => 300, 4000 },
98 'Testing: `sub foo($n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
99
100 ## We *can* pass positional arguments as a 'named' pair with slurpy *%h.
101 ## Only *remaining* pairs are slurped into the *%h
102 # Note: with slurpy *@a, you can pass positional params, But will be slurped into *@a
103 diag('Testing without positional arguments');
104 lives_ok { foo n => 20, y => 300, 4000 },
105 'Testing: `sub foo($n, *%h, *@a){ }; foo n => 20, y => 300, 4000`';
106 is (foo1 n => 20, y => 300, 4000), 20,
107 'Testing the value for positional';
108 is (foo2 n => 20, y => 300, 4000), 300,
109 'Testing the value for slurpy *%h';
110 is (foo3 n => 20, y => 300, 4000), 4000,
111 'Testing the value for slurpy *@a';
112 }
113
114
115 {
116 my sub foo ($n, *%h) { };
117 ## NOTE: *NOT* sub foo ($n, *%h, *@a)
118 #?pugs todo 'bug'
119 dies_ok { foo 1, n => 20, y => 300 },
120 'Testing: `sub foo($n, *%h) { }; foo 1, n => 20, y => 300`';
121 }
122
123 {
124 my sub foo ($n, *%h) { };
125 ## NOTE: *NOT* sub foo ($n, *%h, *@a)
126 dies_ok { foo 1, x => 20, y => 300, 4000 },
127 'Testing: `sub foo($n, *%h) { }; foo 1, x => 20, y => 300, 4000`';
128 }
129
130
131 # Named with slurpy *%h and slurpy *@a
132 # named arguments aren't required in tests below
133 {
134 my sub foo(:$n, *%h, *@a) { };
135 my sub foo1(:$n, *%h, *@a) { $n };
136 my sub foo2(:$n, *%h, *@a) { %h<x> + %h<y> + %h<n> };
137 my sub foo3(:$n, *%h, *@a) { [+] @a };
138
139 diag("Testing with named arguments (named param isn't required)");
140 lives_ok { foo 1, x => 20, y => 300, 4000 },
141 'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
142 ok (foo1 1, x => 20, y => 300, 4000).notdef,
331ffb3 [t/spec] merge slurpy-params{-2,}.t
moritz authored
143 'Testing value for named argument';
144 is (foo2 1, x => 20, y => 300, 4000), 320,
145 'Testing value for slurpy *%h';
146 is (foo3 1, x => 20, y => 300, 4000), 4001,
147 'Testing the value for slurpy *@a';
148
149 ### named parameter pair will always have a higher "priority" while passing
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
150 ### so %h<n> will always be undefined
331ffb3 [t/spec] merge slurpy-params{-2,}.t
moritz authored
151 lives_ok { foo1 1, n => 20, y => 300, 4000 },
152 'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
153 is (foo1 1, n => 20, y => 300, 4000), 20,
154 'Testing the named argument';
155 is (foo2 1, n => 20, y => 300, 4000), 300,
156 'Testing value for slurpy *%h';
157 is (foo3 1, n => 20, y => 300, 4000), 4001,
158 'Testing the value for slurpy *@a';
159 }
160
161
162 # named with slurpy *%h and slurpy *@a
163 ## Named arguments **ARE** required in tests below
164
165 #### ++ version
166 {
167 my sub foo(:$n!, *%h, *@a){ };
168 diag('Testing with named arguments (named param is required) (++ version)');
169 lives_ok { foo 1, n => 20, y => 300, 4000 },
170 'Testing: `my sub foo(+:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
171 #?pugs todo 'bug'
172 dies_ok { foo 1, x => 20, y => 300, 4000 };
173 }
174
175 #### "trait" version
176 {
177 my sub foo(:$n is required, *%h, *@a) { };
178 diag('Testing with named arguments (named param is required) (trait version)');
179 lives_ok { foo 1, n => 20, y => 300, 4000 },
180 'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
181 #?pugs todo 'bug'
182 #?rakudo todo ''
183 dies_ok { foo 1, x => 20, y => 300, 4000 },
184 'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000 }`';
185 }
186
187 ##### Now slurpy scalar tests here.
188 =begin desc
189
190 =head1 List parameter test
191
192 These tests are the testing for "List parameters" section of Synopsis 06
193
194
195 =end desc
196
eda6db1 [t/spec] move smartlinks from POD to ordinary comments
moritz authored
197 # L<S06/List parameters/Slurpy scalar parameters capture what would otherwise be the first elements of the variadic array:>
198
331ffb3 [t/spec] merge slurpy-params{-2,}.t
moritz authored
199 {
200 sub first(*$f, *$s, *@r){ return $f };
201 sub second(*$f, *$s, *@r){ return $s };
202 sub rest(*$f, *$s, *@r){ return [+] @r };
203 diag 'Testing with slurpy scalar';
204 is first(1, 2, 3, 4, 5), 1,
205 'Testing the first slurpy scalar...';
206 is second(1, 2, 3, 4, 5), 2,
207 'Testing the second slurpy scalar...';
208 is rest(1, 2, 3, 4, 5), 12,
209 'Testing the rest slurpy *@r';
210 }
211
4610f3d [t/spec] Test for RT #61772
kyle authored
212 # RT #61772
213 {
214 my @array_in = <a b c>;
215
216 sub no_copy( *@a ) { @a }
217 sub is_copy( *@a is copy ) { @a }
218
219 my @not_copied = no_copy( @array_in );
220 my @copied = is_copy( @array_in );
221
222 is @copied, @not_copied, 'slurpy array copy same as not copied';
223 }
4701aa5 [t/spec]: Unfudge a passing todo, add some implicit slurpy param tests.
pmichaud authored
224
45592a2 Test for #64814
kyle authored
225 # RT #64814
226 {
227 sub slurp_any( Any *@a ) { @a[0] }
228 is slurp_any( 'foo' ), 'foo', 'call to sub with (Any *@a) works';
229
230 sub slurp_int( Int *@a ) { @a[0] }
a7d53b3 [t/spec] Add reference to RT 69622
kyle authored
231 #?rakudo todo 'regression introduced by 41bc84f00d (RT 69622)'
45592a2 Test for #64814
kyle authored
232 dies_ok { slurp_int( 'foo' ) }, 'dies: call (Int *@a) sub with string';
e84b818 Kill off prefix:<int> (as per r25890)
moritz authored
233 is slurp_int( 27.Int ), 27, 'call to sub with (Int *@a) works';
45592a2 Test for #64814
kyle authored
234
235 sub slurp_of_int( *@a of Int ) { @a[0] }
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
236 #?rakudo todo 'RT #64814'
45592a2 Test for #64814
kyle authored
237 dies_ok { slurp_of_int( 'foo' ) }, 'dies: call (*@a of Int) with string';
e84b818 Kill off prefix:<int> (as per r25890)
moritz authored
238 is slurp_of_int( 99.Int ), 99, 'call to (*@a of Int) sub works';
45592a2 Test for #64814
kyle authored
239
240 class X64814 {}
241 class Y64814 {
242 method x_slurp ( X64814 *@a ) { 2 }
243 method of_x ( *@a of X64814 ) { 3 }
244 method x_array ( X64814 @a ) { 4 }
245 }
246
247 my $x = X64814.new;
248 my $y = Y64814.new;
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
249 #?rakudo skip 'RT #64814'
250 is $y.x_array( $x ), 4, 'call to method with typed array sig works';
251 is $y.of_x( $x ), 3, 'call to method with "slurp of" sig works';
252 is $y.x_slurp( $x ), 2, 'call to method with typed slurpy sig works';
45592a2 Test for #64814
kyle authored
253 dies_ok { $y.x_array( 23 ) }, 'die calling method with typed array sig';
254 #?rakudo todo 'RT #64814'
255 dies_ok { $y.of_x( 17 ) }, 'dies calling method with "slurp of" sig';
a7d53b3 [t/spec] Add reference to RT 69622
kyle authored
256 #?rakudo todo 'regression introduced by 41bc84f00d (RT 69622)'
45592a2 Test for #64814
kyle authored
257 dies_ok { $y.x_slurp( 35 ) }, 'dies calling method with typed slurpy sig';
258 }
259
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
260 {
261 my $count = 0;
262 sub slurp_obj_thread(*@a) { $count++; }
263 multi sub slurp_obj_multi(*@a) { $count++; }
264
265 $count = 0;
266 slurp_obj_thread(3|4|5);
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
267 is $count, 1, 'Mu slurpy param doesnt autothread';
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
268 $count = 0;
269 slurp_obj_multi(3|4|5);
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
270 is $count, 1, 'Mu slurpy param doesnt autothread';
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
271 }
272
273 ## Note: I've listed these as though they succeed, but it's possible
274 ## that the parameter binding should fail outright. --pmichaud
275 {
0fdffa3 [t/spec] random bug suppression
lwall authored
276 my $count = 0;
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
277 sub slurp_any_thread(Any *@a) { $count++; }
278 multi sub slurp_any_multi(Any *@a) { $count++; }
279
280 slurp_any_thread(3|4|5);
281 is $count, 1, 'Any slurpy param doesnt autothread';
282 $count = 0;
283 slurp_any_multi(3|4|5);
284 is $count, 1, 'Any slurpy param doesnt autothread';
285 }
286
edb878e [t/spec] Test for RT #65324
kyle authored
287 eval_dies_ok 'sub rt65324(*@x, $oops) { say $oops }',
288 "Can't put required parameter after variadic parameters";
289
eecfbf6 [t/spec] test for RT #69424, typed slurpy params should accept typed arr...
moritz authored
290 # used to be RT #69424
291 {
292 sub typed-slurpy(Int *@a) { 5 }
293 my Int @b;
294 is typed-slurpy(@b), 5, 'can fill typed slurpy with typed array';
295 }
296
297
e6bf7e1 [t/spec] test for RT #74344, call slurpy params by name
moritz authored
298 # RT #74344
299 #?rakudo skip 'RT 74344'
300 {
301 sub slurpy-by-name(*@var) { @var.join('|') }
302 is slurpy-by-name(:var<a v g>), 'a|v|g', 'Can call slurpy param by name';
303 }
304
c8ed2cc [t/spec] test for RT #61772, *@a is copy messed up in Rakudo
moritz authored
305 # RT #61772
306 {
307 sub array_slurpy_copy(*@a is copy) {
308 return @a;
309 }
310 my @array = <a b c>;
311 my @c = array_slurpy_copy(@array);
312 is @c[0], 'a', 'slurpy is copy-array works fine, thank you';
313 }
314
edb878e [t/spec] Test for RT #65324
kyle authored
315 done_testing;
316
dc30b33 [t/spec] add basic tests for slurpy parameters
moritz authored
317 # vim: ft=perl6
Something went wrong with that request. Please try again.