#!perl

use strict ("subs", "vars", "refs");
use warnings ("all");
$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;
use Tie::Array ();

SCOPE:
{
    my @s = (1001 .. 1200);
    my @d = map { (1 .. 1000) } 0 .. 1;
    my @a = (@d, @s);
    my @u = singleton @a;
    is_deeply(\@u, [@s]);
    my $u = singleton @a;
    is(200, $u);
}

# Test strings
SCOPE:
{
    my @s = ("AA" .. "ZZ");
    my @d = map { ("aa" .. "zz") } 0 .. 1;
    my @a = (@d, @s);
    my @u = singleton @a;
    is_deeply(\@u, [@s]);
    my $u = singleton @a;
    is(scalar @s, $u);
}

# Test mixing strings and numbers
SCOPE:
{
    my @s  = (1001 .. 1200, "AA" .. "ZZ");
    my $fs = freeze(\@s);
    my @d  = map { (1 .. 1000, "aa" .. "zz") } 0 .. 1;
    my @a  = (@d, @s);
    my $fa = freeze(\@a);
    my @u  = singleton map { $_ } @a;
    my $fu = freeze(\@u);
    is_deeply(\@u, [@s]);
    is($fs, freeze(\@s));
    is($fa, freeze(\@a));
    is($fu, $fs);
    my $u = singleton @a;
    is(scalar @s, $u);
}

SCOPE:
{
    my @a;
    tie @a, "Tie::StdArray";
    my @s = (1001 .. 1200, "AA" .. "ZZ");
    my @d = map { (1 .. 1000, "aa" .. "zz") } 0 .. 1;
    @a = (@d, @s);
    my @u = singleton map { $_ } @a;
    is_deeply(\@u, [@s]);
    @a = (@d, @s);
    my $u = singleton @a;
    is(scalar @s, $u);
}

SCOPE:
{
    my @foo = ('a', 'b', '', undef, 'b', 'c', '');
    my @sfoo = ('a', undef, 'c');
    is_deeply([singleton @foo], \@sfoo, 'one undef is supported correctly by singleton');
    @foo = ('a', 'b', '', undef, 'b', 'c', undef);
    @sfoo = ('a', '', 'c');
    is_deeply([singleton @foo], \@sfoo, 'twice undef is supported correctly by singleton');
    is((scalar singleton @foo), scalar @sfoo, 'scalar twice undef is supported correctly by singleton');
}

leak_free_ok(
    singleton => sub {
        my @s = (1001 .. 1200, "AA" .. "ZZ");
        my @d = map { (1 .. 1000, "aa" .. "zz") } 0 .. 1;
        my @a = (@d, @s);
        my @u = singleton @a;
        scalar singleton @a;
    }
);

# This test (and the associated fix) are from Kevin Ryde; see RT#49796
leak_free_ok(
    'singleton with exception in overloading stringify',
    sub {
        eval {
            my $obj = DieOnStringify->new;
            my @u = singleton $obj, $obj;
        };
        eval {
            my $obj = DieOnStringify->new;
            my $u = singleton $obj, $obj;
        };
    }
);

done_testing;