The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict ("subs", "vars", "refs");
use warnings ("all");
BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; }
END { delete $ENV{LIST_MOREUTILS_PP} } # for VMS
use lib ("t/lib");
use List::MoreUtils (":all");


use Test::More;
use Test::LMU;

SCOPE:
{
    my @a  = (7, 3, 'a', undef, 'r');
    my @b  = qw{ a 2 -1 x };
    my $it = each_array @a, @b;
    my (@r, @idx);
    while (my ($a, $b) = $it->())
    {
        push @r, $a, $b;
        push @idx, $it->('index');
    }

    # Do I segfault? I shouldn't.
    $it->();

    is_deeply(\@r, [7, 'a', 3, 2, 'a', -1, undef, 'x', 'r', undef]);
    is_deeply(\@idx, [0 .. 4]);

    # Testing two iterators on the same arrays in parallel
    @a = (1, 3, 5);
    @b = (2, 4, 6);
    my $i1 = each_array @a, @b;
    my $i2 = each_array @a, @b;
    @r = ();
    while (my ($a, $b) = $i1->() and my ($c, $d) = $i2->())
    {
        push @r, $a, $b, $c, $d;
    }
    is_deeply(\@r, [1, 2, 1, 2, 3, 4, 3, 4, 5, 6, 5, 6]);

    # Input arrays must not be modified
    is_deeply(\@a, [1, 3, 5]);
    is_deeply(\@b, [2, 4, 6]);

    # This used to give "semi-panic: attempt to dup freed string"
    # See: <news:1140827861.481475.111380@z34g2000cwc.googlegroups.com>
    my $ea = each_arrayref([1 .. 26], ['A' .. 'Z']);
    (@a, @b) = ();
    while (my ($a, $b) = $ea->())
    {
        push @a, $a;
        push @b, $b;
    }
    is_deeply(\@a, [1 .. 26]);
    is_deeply(\@b, ['A' .. 'Z']);

    # And this even used to dump core
    my @nums = 1 .. 26;
    $ea = each_arrayref(\@nums, ['A' .. 'Z']);
    (@a, @b) = ();
    while (my ($a, $b) = $ea->())
    {
        push @a, $a;
        push @b, $b;
    }
    is_deeply(\@a, [1 .. 26]);
    is_deeply(\@a, \@nums);
    is_deeply(\@b, ['A' .. 'Z']);
}

SCOPE:
{
    my @a = (7, 3, 'a', undef, 'r');
    my @b = qw/a 2 -1 x/;

    my $it = each_arrayref \@a, \@b;
    my (@r, @idx);
    while (my ($a, $b) = $it->())
    {
        push @r, $a, $b;
        push @idx, $it->('index');
    }

    # Do I segfault? I shouldn't.
    $it->();

    is_deeply(\@r, [7, 'a', 3, 2, 'a', -1, undef, 'x', 'r', undef]);
    is_deeply(\@idx, [0 .. 4]);

    # Testing two iterators on the same arrays in parallel
    @a = (1, 3, 5);
    @b = (2, 4, 6);
    my $i1 = each_array @a, @b;
    my $i2 = each_array @a, @b;
    @r = ();
    while (my ($a, $b) = $i1->() and my ($c, $d) = $i2->())
    {
        push @r, $a, $b, $c, $d;
    }
    is_deeply(\@r, [1, 2, 1, 2, 3, 4, 3, 4, 5, 6, 5, 6]);

    # Input arrays must not be modified
    is_deeply(\@a, [1, 3, 5]);
    is_deeply(\@b, [2, 4, 6]);
}

# Note that the leak_free_ok tests for each_array and each_arrayref
# should not be run until either of them has been called at least once
# in the current perl.  That's because calling them the first time
# causes the runtime to allocate some memory used for the OO structures
# that their implementation uses internally.
leak_free_ok(
    each_array => sub {
        my @a  = (1);
        my $it = each_array @a;
        while (my ($a) = $it->())
        {
        }
    }
);
leak_free_ok(
    each_arrayref => sub {
        my @a  = (1);
        my $it = each_arrayref \@a;
        while (my ($a) = $it->())
        {
        }
    }
);
is_dying('each_array without sub' => sub { &each_array(42, 4711); });
is_dying('each_arrayref without sub' => sub { &each_arrayref(42, 4711); });

done_testing;