Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 293 lines (234 sloc) 9.828 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
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
6 plan 60;
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
57 whatever( 'a' p5=> 'b', 'c' p5=> 'd' );
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 #?rakudo 3 todo 'positional params can be passed as named ones'
107 is (foo1 n => 20, y => 300, 4000), 20,
108 'Testing the value for positional';
109 is (foo2 n => 20, y => 300, 4000), 300,
110 'Testing the value for slurpy *%h';
111 is (foo3 n => 20, y => 300, 4000), 4000,
112 'Testing the value for slurpy *@a';
113 }
114
115
116 {
117 my sub foo ($n, *%h) { };
118 ## NOTE: *NOT* sub foo ($n, *%h, *@a)
119 #?pugs todo 'bug'
120 #?rakudo todo ''
121 dies_ok { foo 1, n => 20, y => 300 },
122 'Testing: `sub foo($n, *%h) { }; foo 1, n => 20, y => 300`';
123 }
124
125 {
126 my sub foo ($n, *%h) { };
127 ## NOTE: *NOT* sub foo ($n, *%h, *@a)
128 dies_ok { foo 1, x => 20, y => 300, 4000 },
129 'Testing: `sub foo($n, *%h) { }; foo 1, x => 20, y => 300, 4000`';
130 }
131
132
133 # Named with slurpy *%h and slurpy *@a
134 # named arguments aren't required in tests below
135 {
136 my sub foo(:$n, *%h, *@a) { };
137 my sub foo1(:$n, *%h, *@a) { $n };
138 my sub foo2(:$n, *%h, *@a) { %h<x> + %h<y> + %h<n> };
139 my sub foo3(:$n, *%h, *@a) { [+] @a };
140
141 diag("Testing with named arguments (named param isn't required)");
142 lives_ok { foo 1, x => 20, y => 300, 4000 },
143 'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
144 ok (foo1 1, x => 20, y => 300, 4000) ~~ undef,
145 'Testing value for named argument';
146 is (foo2 1, x => 20, y => 300, 4000), 320,
147 'Testing value for slurpy *%h';
148 is (foo3 1, x => 20, y => 300, 4000), 4001,
149 'Testing the value for slurpy *@a';
150
151 ### named parameter pair will always have a higher "priority" while passing
152 ### so %h<n> will always be undef
153 lives_ok { foo1 1, n => 20, y => 300, 4000 },
154 'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
155 is (foo1 1, n => 20, y => 300, 4000), 20,
156 'Testing the named argument';
157 is (foo2 1, n => 20, y => 300, 4000), 300,
158 'Testing value for slurpy *%h';
159 is (foo3 1, n => 20, y => 300, 4000), 4001,
160 'Testing the value for slurpy *@a';
161 }
162
163
164 # named with slurpy *%h and slurpy *@a
165 ## Named arguments **ARE** required in tests below
166
167 #### ++ version
168 {
169 my sub foo(:$n!, *%h, *@a){ };
170 diag('Testing with named arguments (named param is required) (++ version)');
171 lives_ok { foo 1, n => 20, y => 300, 4000 },
172 'Testing: `my sub foo(+:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
173 #?pugs todo 'bug'
174 dies_ok { foo 1, x => 20, y => 300, 4000 };
175 }
176
177 #### "trait" version
178 {
179 my sub foo(:$n is required, *%h, *@a) { };
180 diag('Testing with named arguments (named param is required) (trait version)');
181 lives_ok { foo 1, n => 20, y => 300, 4000 },
182 'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
183 #?pugs todo 'bug'
184 #?rakudo todo ''
185 dies_ok { foo 1, x => 20, y => 300, 4000 },
186 'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000 }`';
187 }
188
189 ##### Now slurpy scalar tests here.
190 =begin desc
191
192 =head1 List parameter test
193
194 These tests are the testing for "List parameters" section of Synopsis 06
195
196
197 =end desc
198
eda6db1 [t/spec] move smartlinks from POD to ordinary comments
moritz authored
199 # L<S06/List parameters/Slurpy scalar parameters capture what would otherwise be the first elements of the variadic array:>
200
331ffb3 [t/spec] merge slurpy-params{-2,}.t
moritz authored
201 {
202 sub first(*$f, *$s, *@r){ return $f };
203 sub second(*$f, *$s, *@r){ return $s };
204 sub rest(*$f, *$s, *@r){ return [+] @r };
205 diag 'Testing with slurpy scalar';
206 is first(1, 2, 3, 4, 5), 1,
207 'Testing the first slurpy scalar...';
208 is second(1, 2, 3, 4, 5), 2,
209 'Testing the second slurpy scalar...';
210 is rest(1, 2, 3, 4, 5), 12,
211 'Testing the rest slurpy *@r';
212 }
213
4610f3d [t/spec] Test for RT #61772
kyle authored
214 # RT #61772
215 {
216 my @array_in = <a b c>;
217
218 sub no_copy( *@a ) { @a }
219 sub is_copy( *@a is copy ) { @a }
220
221 my @not_copied = no_copy( @array_in );
222 my @copied = is_copy( @array_in );
223
224 is @copied, @not_copied, 'slurpy array copy same as not copied';
225 }
4701aa5 [t/spec]: Unfudge a passing todo, add some implicit slurpy param tests.
pmichaud authored
226
45592a2 Test for #64814
kyle authored
227 # RT #64814
228 {
229 sub slurp_any( Any *@a ) { @a[0] }
230 is slurp_any( 'foo' ), 'foo', 'call to sub with (Any *@a) works';
231
232 sub slurp_int( Int *@a ) { @a[0] }
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
233 #?rakudo todo 'regression between d91717dff and cf8884db'
45592a2 Test for #64814
kyle authored
234 dies_ok { slurp_int( 'foo' ) }, 'dies: call (Int *@a) sub with string';
235 #?rakudo skip 'RT #64814'
e84b818 Kill off prefix:<int> (as per r25890)
moritz authored
236 is slurp_int( 27.Int ), 27, 'call to sub with (Int *@a) works';
45592a2 Test for #64814
kyle authored
237
238 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
239 #?rakudo todo 'RT #64814'
45592a2 Test for #64814
kyle authored
240 dies_ok { slurp_of_int( 'foo' ) }, 'dies: call (*@a of Int) with string';
e84b818 Kill off prefix:<int> (as per r25890)
moritz authored
241 is slurp_of_int( 99.Int ), 99, 'call to (*@a of Int) sub works';
45592a2 Test for #64814
kyle authored
242
243 class X64814 {}
244 class Y64814 {
245 method x_slurp ( X64814 *@a ) { 2 }
246 method of_x ( *@a of X64814 ) { 3 }
247 method x_array ( X64814 @a ) { 4 }
248 }
249
250 my $x = X64814.new;
251 my $y = Y64814.new;
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
252 #?rakudo skip 'RT #64814'
253 is $y.x_array( $x ), 4, 'call to method with typed array sig works';
254 is $y.of_x( $x ), 3, 'call to method with "slurp of" sig works';
255 #?rakudo skip 'RT #64814'
256 is $y.x_slurp( $x ), 2, 'call to method with typed slurpy sig works';
45592a2 Test for #64814
kyle authored
257 dies_ok { $y.x_array( 23 ) }, 'die calling method with typed array sig';
258 #?rakudo todo 'RT #64814'
259 dies_ok { $y.of_x( 17 ) }, 'dies calling method with "slurp of" sig';
defbbe0 [t/spec] turn some todo lives_ok tests to skipped tests and fudge regres...
kyle authored
260 #?rakudo todo 'regression between d91717dff and cf8884db'
45592a2 Test for #64814
kyle authored
261 dies_ok { $y.x_slurp( 35 ) }, 'dies calling method with typed slurpy sig';
262 }
263
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
264 {
265 my $count = 0;
266 sub slurp_obj_thread(*@a) { $count++; }
267 multi sub slurp_obj_multi(*@a) { $count++; }
268
269 $count = 0;
270 slurp_obj_thread(3|4|5);
271 is $count, 1, 'Object slurpy param doesnt autothread';
272 $count = 0;
273 slurp_obj_multi(3|4|5);
274 is $count, 1, 'Object slurpy param doesnt autothread';
275 }
276
277 #?rakudo skip 'Typed slurpy, junctions, and autothreading (RT 68142)'
278 ## Note: I've listed these as though they succeed, but it's possible
279 ## that the parameter binding should fail outright. --pmichaud
280 {
0fdffa3 [t/spec] random bug suppression
lwall authored
281 my $count = 0;
bb5a588 [t/spec]: Add some tests for slurpy params and autothreading (RT #68142...
pmichaud authored
282 sub slurp_any_thread(Any *@a) { $count++; }
283 multi sub slurp_any_multi(Any *@a) { $count++; }
284
285 slurp_any_thread(3|4|5);
286 is $count, 1, 'Any slurpy param doesnt autothread';
287 $count = 0;
288 slurp_any_multi(3|4|5);
289 is $count, 1, 'Any slurpy param doesnt autothread';
290 }
291
dc30b33 [t/spec] add basic tests for slurpy parameters
moritz authored
292 # vim: ft=perl6
Something went wrong with that request. Please try again.