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} = 0; }
END { delete $ENV{LIST_MOREUTILS_PP} } # for VMS
use List::MoreUtils (":all");
use lib ("t/lib");


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

my @a = (1, 2, 3, 4, 5);
my @b = (2, 4, 6, 8, 10);
my @c = pairwise { $a + $b } @a, @b;
is_deeply(\@c, [3, 6, 9, 12, 15], "pw1");

@c = pairwise { $a * $b } @a, @b;    # returns (2, 8, 18)
is_deeply(\@c, [2, 8, 18, 32, 50], "pw2");

# Did we modify the input arrays?
is_deeply(\@a, [1, 2, 3, 4, 5],  "pw3");
is_deeply(\@b, [2, 4, 6, 8, 10], "pw4");

# $a and $b should be aliases: test
@b = @a = (1, 2, 3);
@c = pairwise { $a++; $b *= 2 } @a, @b;
is_deeply(\@a, [2, 3, 4], "pw5");
is_deeply(\@b, [2, 4, 6], "pw6");
is_deeply(\@c, [2, 4, 6], "pw7");

# sub returns more than two items
@a = (1, 1, 2, 3, 5);
@b = (2, 3, 5, 7, 11, 13);
@c = pairwise { ($a) x $b } @a, @b;
is_deeply(\@c, [(1) x 2, (1) x 3, (2) x 5, (3) x 7, (5) x 11, (undef) x 13], "pw8");
is_deeply(\@a, [1, 1, 2, 3, 5], "pw9");
is_deeply(\@b, [2, 3, 5, 7, 11, 13], "pwX");

(@a, @b) = ();
push @a, int rand(1000) for 0 .. rand(1000);
push @b, int rand(1000) for 0 .. rand(1000);
SCOPE:
{
    local $SIG{__WARN__} = sub { };    # XXX
    my @res1 = pairwise { $a + $b } @a, @b;
    # Test this one more thoroughly: the XS code looks flakey
    # correctness of pairwise_perl proved by human auditing. :-)
    my $limit = $#a > $#b ? $#a : $#b;
    my @res2 = map { $a[$_] + $b[$_] } 0 .. $limit;
    is_deeply(\@res1, \@res2);
}

@a = qw/a b c/;
@b = qw/1 2 3/;
@c = pairwise { ($a, $b) } @a, @b;
is_deeply(\@c, [qw/a 1 b 2 c 3/], "pw map");

SKIP:
{
    $ENV{PERL5OPT} and skip 'A defined PERL5OPT may inject extra deps crashing this test', 1;
    # Test that a die inside the code-reference will not be trapped
    eval {
        pairwise { die "I died\n" } @a, @b;
    };
    is($@, "I died\n");
}

leak_free_ok(
    pairwise => sub {
        @a = (1);
        @b = (2);
        @c = pairwise { $a + $b } @a, @b;
    }
);

leak_free_ok(
    'exceptional block' => sub {
        @a = qw/a b c/;
        @b = qw/1 2 3/;
        eval {
            @c = pairwise { $b == 3 and die "Primes suck!"; "$a:$b" } @a, @b;
        };
    }
);

SKIP:
{
    $INC{'List/MoreUtils/XS.pm'} or skip "PurePerl will warn here ...", 1;
    my ($a, $b, @t);
    eval {
        my @l1 = (1 .. 10);
        @t = pairwise { $a + $b } @l1, @l1;
    };
    my $err = $@;
    like($err, qr/Can't use lexical \$a or \$b in pairwise code block/, "pairwise die's on broken caller");
}

SKIP:
{
    $INC{'List/MoreUtils/XS.pm'} and skip "XS will die on purpose here ...", 1;
    my @warns = ();
    local $SIG{__WARN__} = sub { push @warns, @_ };
    my ($a, $b, @t);
    my @l1 = (1 .. 10);
    @t = pairwise { $a + $b } @l1, @l1;
    like(join("", @warns[0, 1]), qr/Use of uninitialized value.*? in addition/, "warning on broken caller");
}

is_dying('pairwise without sub' => sub { &pairwise(42, \@a, \@b); });
SKIP:
{
    $INC{'List/MoreUtils/XS.pm'} or skip "PurePerl will not core here ...", 2;
    is_dying(
        'pairwise without first ARRAY' => sub {
            @c = &pairwise(sub { }, 1, \@b);
        }
    );
    is_dying(
        'pairwise without second ARRAY' => sub {
            @c = &pairwise(sub { }, \@a, 2);
        }
    );
}

done_testing;