Permalink
Fetching contributors…
Cannot retrieve contributors at this time
297 lines (255 sloc) 6.7 KB
use v6;
use Test;
plan 38;
# L<S04/The C<gather> statement prefix/>
# Standard gather
{
my $i;
my @a := gather {
$i = 1;
for (1 .. 5) -> $j {
take $j;
}
}.values;
ok(!$i, "not yet gathered");
is(+@a, 5, "5 elements gathered");
ok($i, "gather code executed");
is(@a[0], 1, "first elem taken");
is(@a[*-1], 5, "last elem taken");
};
# Nested gathers, two levels
{
my @outer = gather {
for 1..3 -> $i {
my @inner = gather {
take $_ for 1..3;
};
take "$i:" ~ @inner.join(',');
}
};
is ~@outer, "1:1,2,3 2:1,2,3 3:1,2,3", "nested gather works (two levels)";
}
# Nested gathers, three levels
{
my @outer = gather {
for 1..2 -> $i {
my @inner = gather {
for 1..2 -> $j {
my @inner_inner = gather {
take $_ for 1..2;
};
take "$j:" ~ @inner_inner.join(',');
}
};
take "$i:" ~ @inner.join(';');
}
};
is ~@outer, "1:1:1,2;2:1,2 2:1:1,2;2:1,2", "nested gather works (three levels)";
}
# take on lists, multiple takes per loop
{
my @outer = gather {
my @l = (1, 2, 3);
take 5;
take @l;
take 5;
};
is ~@outer, "5 1 2 3 5", "take on lists and multiple takes work";
}
# gather scopes dynamiclly, not lexically
{
my $dynamic_take = sub { take 7 };
my @outer = gather {
$dynamic_take();
take 1;
};
is ~@outer, "7 1", "gather scopes dynamically, not lexically";
}
# take on array-ref
{
my @list = gather { take [1,2,3]; take [4,5,6];};
my @list2 = ([1,2,3],[4,5,6]);
is @list.perl, @list2.perl , "gather array-refs";
}
# gather statement prefix
{
my @out = gather for 1..5 {
take $_;
};
is ~@out, "1 2 3 4 5", "gather as a statement_prefix";
}
# lazy gather
{
my $count = 0;
my @list := gather {
for 1 .. 10 -> $a {
take $a;
$count++
}
}.List;
my $result = @list[2];
is($count, 2, "gather is lazy");
}
{
my @list = gather {
my $v = 1;
while $v <= 10 {
take $v if $v % 2 == 0;
$v++;
}
};
is ~@list, "2 4 6 8 10", "gather with nested while";
}
{
my \list := gather {
loop (my $v = 1; $v <= 10; $v++)
{
take $v if $v % 2 == 0;
}
};
is ~list, "2 4 6 8 10", "gather with nested loop";
}
{
is (gather { take 1, 2, 3; take 4, 5, 6; }).elems, 2,
'take with multiple arguments produces one item each';
is (gather { take 1, 2, 3; take 4, 5, 6; }).flat.elems, 6,
'take with multiple arguments .flat tens out';
}
# RT #117635
{
my sub grep-div(@a, $n) {
gather for @a {
take $_ if $_ %% $n;
}
}
my \evens = grep-div((1...*), 2);
is ~grep-div(evens, 3)[^16], ~grep-div((1...100), 6), "Nested identical gathers";
}
# RT #77036
{
class E {
has $.n is rw;
has $.v;
method Str() {~self.v }
};
my E $x .= new(:v(1));
$x.n = E.new(:v(2));
is (gather { my $i = $x; while $i.defined { take $i; $i = $i.n } }).join("|"), '1|2', 'Elements in gather/take stringify correctly';
}
# RT #78026, RT #77302
{
sub foo {
my @a = (1,2,3,4,5);
gather {
my $val ;
while @a {
$val = @a.shift();
take $val;
}
}
};
is foo().join, '12345', 'decontainerization happens (1)';
is (<a b c d e> Zxx 0,1,0,1,0).flat.Str, 'b d',
'decontainerization happens (2)';
}
# Method form of take
{
my @outer = gather {
my @l = (1, 2, 3);
5.take;
@l.take;
5.take;
};
is ~@outer, "5 1 2 3 5", "method form of take works.";
}
# RT #115598
{
my $x;
my @a = gather { $x = take 3; };
is $x, 3, "return value of take"
}
# tests for the S04-control.pod document
#?rakudo.jvm skip 'UnwindException RT #124279'
{
my @list = 1, 2, 2, 3, 3, 3, 4, 4, 4, 4, 5, 6, 6;
my @uniq = gather for @list {
state $previous = take $_;
next if $_ === $previous;
$previous = take $_;
}
is @uniq, (1, 2, 3, 4, 5, 6), "first example in S04-control.pod works";
}
{
my @y;
my @x = gather for 1..2 { # flat context for list of lists
my ($y) := \(take $_, $_ * 10); # binding forces item context
push @y, $y;
}
is @x, (1, 10, 2, 20), "take in flat context flattens";
is @y, ($(1, 10), $(2, 20)), "take in item context doesn't flatten";
}
{
my \c := (gather for 1..2 {
take $_, $_ * 10;
}).list;
is c.flat, (1,10,2,20), ".flat flattens fully into a list of Ints.";
is c.elems, 2, 'gather/take does not flatten out sublists';
is c.item, $($(1,10),$(2,20)), "a list of Lists, as an item.";
}
# XXX GLR
#?rakudo skip 'RT #66820, and hangs under GLR'
{
my $cat;
lives-ok { my @a := gather for 1..3 { take $_; $cat ~= ~@a }.list; +@a }, 'can access bound gather result while gathering';
is $cat, "11 21 2 3", 'bound gather result has up-to-date value while gathering';
}
# RT #111962
{
my @grid = [ $++ xx 5 ] xx 5;
my @neigh = [ ] xx 5;
for ^5 X ^5 -> ($i, $j) {
@neigh[$i][$j] = gather take-rw @grid[$i + .[0]][$j + .[1]]
if 0 <= $i + .[0] < 5 and 0 <= $j + .[1] < 5
for [-1,-1],[+0,-1],[+1,-1],
[-1,+0], [+1,+0],
[-1,+1],[+0,+1],[+1,+1];
}
ok @grid[1][1] === @neigh[2][2][0], "Neighbor is same object as in grid";
ok @neigh[1][1].elems == 8, "There are eight neighbors";
}
# RT #122114
{
throws-like 'say (gather for 1..3 { INIT take "OH HAI"; take $_ })',
X::ControlFlow,
illegal => "take",
enclosing => "gather",
'"INIT take" inside of a "gather for" fails with X::ControlFlow';
}
# RT #125401
{
my @result = flat gather { take "foo=bar".split("=") };
is @result, <foo bar>,
'take on a listy expression takes each element of that list';
}
# RT #126424
{
my $l = gather { take-rw my $ = 1 };
lives-ok { $l.AT-POS(0) = 42 }, 'AT-POS on gather Seq with take-rw value lives';
is $l.AT-POS(0), 42, 'AT-POS on gather Seq with take-rw value works';
}
{
my @spot = [rand xx 10] xx 10;
my @neighbors;
for ^10 X ^10 -> ($i, $j) {
@neighbors[$i][$j] = eager gather for
[-1,-1],[+0,-1],[+1,-1],
[-1,+0], [+1,+0],
[-1,+1],[+0,+1],[+1,+1]
{
take-rw @spot[$i + .[0]][$j + .[1]] // next;
}
}
ok @neighbors[1][1][0] === @spot[0][0], 'Got the value equality expected from take-rw';
ok @neighbors[1][1][0] =:= @spot[0][0], 'Got the reference equality expected from take-rw';
}
# vim: ft=perl6