Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 246 lines (208 sloc) 5.261 kb
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
1 use v6;
2
3 use Test;
4
3a2c7f8 skids Add (fudged) test for RT#66820
skids authored
5 plan 30;
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
6
7
94226b4 t/spec more smartlink fixes
szabgab authored
8 # L<S04/The C<gather> statement prefix/>
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
9
10 # Standard gather
11 {
12 my @a;
13 my $i;
14
19c3c32 [t/spec] switch laziness tests to binding, since we know better that it ...
moritz authored
15 @a := gather {
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
16 $i = 1;
17 for (1 .. 5) -> $j {
18 take $j;
19 }
20 };
21
22 ok(!$i, "not yet gathered");
23 is(+@a, 5, "5 elements gathered");
24 ok($i, "gather code executed");
25 is(@a[0], 1, "first elem taken");
26 is(@a[*-1], 5, "last elem taken");
27 };
28
29 # Nested gathers, two levels
30 {
31 my @outer = gather {
32 for 1..3 -> $i {
33 my @inner = gather {
132a6b3 [t/spec]
tene authored
34 take $_ for 1..3;
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
35 };
36
132a6b3 [t/spec]
tene authored
37 take "$i:" ~ @inner.join(',');
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
38 }
39 };
40
132a6b3 [t/spec]
tene authored
41 is ~@outer, "1:1,2,3 2:1,2,3 3:1,2,3", "nested gather works (two levels)";
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
42 }
43
44 # Nested gathers, three levels
45 {
46 my @outer = gather {
47 for 1..2 -> $i {
48 my @inner = gather {
49 for 1..2 -> $j {
50 my @inner_inner = gather {
132a6b3 [t/spec]
tene authored
51 take $_ for 1..2;
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
52 };
132a6b3 [t/spec]
tene authored
53 take "$j:" ~ @inner_inner.join(',');
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
54 }
55 };
132a6b3 [t/spec]
tene authored
56 take "$i:" ~ @inner.join(';');
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
57 }
58 };
59
132a6b3 [t/spec]
tene authored
60 is ~@outer, "1:1:1,2;2:1,2 2:1:1,2;2:1,2", "nested gather works (three levels)";
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
61 }
62
63 # take on lists, multiple takes per loop
64 {
65 my @outer = gather {
66 my @l = (1, 2, 3);
67 take 5;
68 take @l;
69 take 5;
70 };
71
72 is ~@outer, "5 1 2 3 5", "take on lists and multiple takes work";
73 }
74
75 # gather scopes dynamiclly, not lexically
76 {
77 my $dynamic_take = sub { take 7 };
78 my @outer = gather {
79 $dynamic_take();
80 take 1;
81 };
82
83 is ~@outer, "7 1", "gather scopes dynamically, not lexically";
84 }
85
86 # take on array-ref
87 {
88 my @list = gather { take [1,2,3]; take [4,5,6];};
89 my @list2 = ([1,2,3],[4,5,6]);
90 is @list.perl, @list2.perl , "gather array-refs";
91 }
92
93 # gather statement prefix
94 {
95 my @out = gather for 1..5 {
96 take $_;
97 };
98
99 is ~@out, "1 2 3 4 5", "gather as a statement_prefix";
100 }
101
102 # lazy gather
103 {
104 my $count = 0;
19c3c32 [t/spec] switch laziness tests to binding, since we know better that it ...
moritz authored
105 my @list := gather {
b4f14e1 [gather.t] moved into t/spec/S04-statements
masak authored
106 for 1 .. 10 -> $a {
107 take $a;
108 $count++
109 }
110 };
111 my $result = @list[2];
112 is($count, 2, "gather is lazy");
113 }
af97463 [spec] added a test to mix gather with while loops
s1n authored
114
115 {
116 my @list = gather {
117 my $v = 1;
b687836 [gather.t] fix syntax error
lwall authored
118 while $v <= 10 {
af97463 [spec] added a test to mix gather with while loops
s1n authored
119 take $v if $v % 2 == 0;
120 $v++;
121 }
122 };
123 is ~@list, "2 4 6 8 10", "gather with nested while";
124 }
72e2da5 Added "todo" test for gather/take with loop.
colomon authored
125
126 {
127 my @list = gather {
128 loop (my $v = 1; $v <= 10; $v++)
129 {
130 take $v if $v % 2 == 0;
131 }
132 };
133 is ~@list, "2 4 6 8 10", "gather with nested loop";
134 }
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
135
2b18f14 [t/spec] test for RT #75794 - take() with multiple arguments
moritz authored
136 {
137 is (gather { take 1, 2, 3; take 4, 5, 6; }).elems, 2,
138 'take with multiple arguments produces one item each';
139
140 is (gather { take 1, 2, 3; take 4, 5, 6; }).flat.elems, 6,
141 'take with multiple arguments .flat tens out';
142 }
143
5a33f7d Will Coleda fudge for rakudo.parrot release
coke authored
144 #?rakudo.moar todo 'RT #117635 (infinite loop)'
09e8944 [t/spec] Add some tests for doubled gathers.
colomon authored
145 {
146 my sub grep-div(@a, $n) {
147 gather for @a {
148 take $_ if $_ %% $n;
149 }
150 }
151
152 my @evens := grep-div((1...*), 2);
d1bba41 Solomon Foster Fix test not to use .munch and unfudge it for Niecza.
colomon authored
153 is ~grep-div(@evens, 3)[^16], ~grep-div((1...100), 6), "Nested identical gathers";
09e8944 [t/spec] Add some tests for doubled gathers.
colomon authored
154 }
155
7681064 Moritz Lenz test for RT #77036
moritz authored
156 # RT #77036
157 {
158 class E {
159 has $.n is rw;
160 has $.v;
161 method Str() {~self.v }
162 };
163 my E $x .= new(:v(1));
164 $x.n = E.new(:v(2));
165 is (gather { my $i = $x; while $i.defined { take $i; $i = $i.n } }).join("|"), '1|2', 'Elements in gather/take stringify correctly';
166
167 }
168
7b2fd5a Moritz Lenz tests for RT #78026, RT #77302, gather/take value decontainerization
moritz authored
169 # RT #78026, RT #77302
170 {
171 sub foo {
172 my @a = (1,2,3,4,5);
173 gather {
174 my $val ;
175 while @a {
176 $val = @a.shift();
177 take $val;
178 }
179 }
180 };
181 is foo().join, '12345', 'decontainerization happens (1)';
182 is (<a b c d e> Zxx 0,1,0,1,0).Str, 'b d',
183 'decontainerization happens (2)';
184 }
185
fcd46f4 Jonathan Scott Duff Added a test that uses .take
perlpilot authored
186 # Method form of take
187 {
188 my @outer = gather {
189 my @l = (1, 2, 3);
190 5.take;
191 @l.take;
192 5.take;
193 };
194
195 is ~@outer, "5 1 2 3 5", "method form of take works.";
196 }
2b18f14 [t/spec] test for RT #75794 - take() with multiple arguments
moritz authored
197
f966c11 Will Coleda Add test for RT #115598
coke authored
198 # RT #115598
199 {
200 my $x;
201 my @a = gather { $x = take 3; };
202 is $x, 3, "return value of take"
203 }
204
948ffc3 timo tests for S04-control.pod (gather/take)
timo authored
205 # tests for the S04-control.pod document
148f92c Will Coleda rakudo.jvm fudge
coke authored
206 #?rakudo.jvm skip "unwind"
948ffc3 timo tests for S04-control.pod (gather/take)
timo authored
207 {
208 my @list = 1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5, 6, 6;
209 my @uniq = gather for @list {
210 state $previous = take $_;
211 next if $_ === $previous;
212 $previous = take $_;
213 }
214 is @uniq, (1, 2, 3, 4, 5, 6), "first example in S04-control.pod works";
215 }
216
a03dd1a Solomon Foster Fudge for Niecza.
colomon authored
217 #?niecza skip 'Cannot use bind operator with this LHS'
948ffc3 timo tests for S04-control.pod (gather/take)
timo authored
218 {
219 my @y;
220 my @x = gather for 1..2 { # flat context for list of parcels
221 my ($y) := \(take $_, $_ * 10); # binding forces item context
222 push @y, $y;
223 }
224 is @x, (1, 10, 2, 20), "take in flat context flattens";
225 is @y, ($(1, 10), $(2, 20)), "take in item context doesn't flatten";
226 }
227
a03dd1a Solomon Foster Fudge for Niecza.
colomon authored
228 #?niecza skip 'Cannot use bind operator with this LHS'
948ffc3 timo tests for S04-control.pod (gather/take)
timo authored
229 {
230 my ($c) := \(gather for 1..2 {
231 take $_, $_ * 10;
232 });
233 is $c.flat, (1,10,2,20), ".flat flattens fully into a list of Ints.";
234 is $c.lol, LoL.new($(1,10),$(2,20)), ".lol: list of Parcels.";
235 is $c.item, ($(1,10),$(2,20)).list.item, "a list of Parcels, as an item.";
236 }
237
b49fcef Will Coleda use RT #XXXX where possible
coke authored
238 #?rakudo skip 'RT #66820'
3a2c7f8 skids Add (fudged) test for RT#66820
skids authored
239 {
240 my $cat;
241 lives_ok { my @a := gather for 1..3 { take $_; $cat ~= ~@a }; +@a }, 'can access bound gather result while gathering';
242 is $cat, "11 21 2 3", 'bound gather result has up-to-date value while gathering';
243 }
948ffc3 timo tests for S04-control.pod (gather/take)
timo authored
244
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
245 # vim: ft=perl6
Something went wrong with that request. Please try again.