<commit_before>package LMU::Test::Tassilo::Funcs;

use 5.008001;

use strict;
#use warnings;

use Test::More;
use Test::LMU;
use List::MoreUtils ':tassilo';

use Config;

# Run all tests
sub run_tests {
    test_any();
    test_all();
    test_none();
    test_notall();
    test_true();
    test_false();
    test_firstidx();
    test_lastidx();
    test_insert_after();
    test_insert_after_string();
    test_apply();
    test_indexes();
    test_before();
    test_before_incl();
    test_after();
    test_after_incl();
    test_firstval();
    test_lastval();
    test_each_array();
    test_pairwise();
    test_natatime();
    test_zip();
    test_mesh();
    test_uniq();
    test_part();
    test_minmax();
    test_bsearch();

    done_testing();
}

######################################################################
# Test code intentionally ignorant of implementation (Pure Perl or XS)

# The any function should behave identically to 
# !! grep CODE LIST
sub test_any {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( any { $_ == 5000 } @list );
    is_true( any { $_ == 5000 } 1 .. 10000 );
    is_true( any { defined } @list );
    is_false( any { not defined } @list );
    is_true( any { not defined } undef );
    is_undef( any { } );

    leak_free_ok(any => sub {
        my $ok = any { $_ == 5000 } @list;
        my $ok2 = any { $_ == 5000 } 1 .. 10000;
    });
    leak_free_ok('any with a coderef that dies' => sub {
        # This test is from <NAME>; see RT#48669
        eval { my $ok = any { die } 1 };
    });
}

sub test_all {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( all { defined } @list );
    is_true( all { $_ > 0 } @list );
    is_false( all { $_ < 5000 } @list );
    is_undef( all { } );

    leak_free_ok(all => sub {
        my $ok  = all { $_ == 5000 } @list;
        my $ok2 = all { $_ == 5000 } 1 .. 10000;
    });
}

sub test_none {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( none { not defined } @list );
    is_true( none { $_ > 10000 } @list );
    is_false( none { defined } @list );
    is_undef( none { } );

    leak_free_ok(none => sub {
        my $ok  = none { $_ == 5000 } @list;
        my $ok2 = none { $_ == 5000 } 1 .. 10000;
    });
}

sub test_notall {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( notall { ! defined } @list );
    is_true( notall { $_ < 10000 } @list );
    is_false( notall { $_ <= 10000 } @list );
    is_undef( notall { } );

    leak_free_ok(notall => sub {
        my $ok  = notall { $_ == 5000 } @list;
        my $ok2 = notall { $_ == 5000 } 1 .. 10000;
    });
}

sub test_true {
    # The null set should return zero
    my $null_scalar = true { };
    my @null_list   = true { };
    is( $null_scalar, 0, 'true(null) returns undef' );
    is_deeply( \@null_list, [ 0 ], 'true(null) returns undef' );

    # Normal cases
    my @list = ( 1 .. 10000 );
    is( 10000, true { defined } @list );
    is( 0, true { not defined } @list );
    is( 1, true { $_ == 5000 } @list );

    leak_free_ok(true => sub {
        my $n  = true { $_ == 5000 } @list;
        my $n2 = true { $_ == 5000 } 1 .. 10000;
    });
}

sub test_false {
    # The null set should return zero
    my $null_scalar = false { };
    my @null_list   = false { };
    is( $null_scalar, 0, 'false(null) returns undef' );
    is_deeply( \@null_list, [ 0 ], 'false(null) returns undef' );

    # Normal cases
    my @list = ( 1 .. 10000 );
    is( 10000, false { not defined } @list );
    is( 0, false { defined } @list );
    is( 1, false { $_ > 1 } @list );

    leak_free_ok(false => sub {
        my $n  = false { $_ == 5000 } @list;
        my $n2 = false { $_ == 5000 } 1 .. 10000;
    });
}

sub test_firstidx {
    my @list = ( 1 .. 10000 );
    is( 4999, firstidx { $_ >= 5000 } @list );
    is( -1, firstidx { not defined } @list );
    is( 0, firstidx { defined } @list );
    is( -1, firstidx { } );

    # Test the alias
    is( 4999, first_index { $_ >= 5000 } @list );
    is( -1, first_index { not defined } @list );
    is( 0, first_index { defined } @list );
    is( -1, first_index { } );

    leak_free_ok(firstidx => sub {
        my $i = firstidx { $_ >= 5000 } @list;
        my $i2 = firstidx { $_ >= 5000 } 1 .. 10000;
    });
}

sub test_lastidx {
    my @list = ( 1 .. 10000 );
    is( 9999, lastidx { $_ >= 5000 } @list );
    is( -1, lastidx { not defined } @list );
    is( 9999, lastidx { defined } @list );
    is( -1, lastidx { } );

    # Test aliases
    is( 9999, last_index { $_ >= 5000 } @list );
    is( -1, last_index { not defined } @list );
    is( 9999, last_index { defined } @list );
    is( -1, last_index { } );

    leak_free_ok(lastidx => sub {
        my $i = lastidx { $_ >= 5000 } @list;
        my $i2 = lastidx { $_ >= 5000 } 1 .. 10000;
    });
}

sub test_insert_after {
    my @list = qw{This is a list};
    insert_after { $_ eq "a" } "longer" => @list;
    is( join(' ', @list), "This is a longer list" );
    insert_after { 0 } "bla" => @list;
    is( join(' ', @list), "This is a longer list" );
    insert_after { $_ eq "list" } "!" => @list;
    is( join(' ', @list), "This is a longer list !" );
    @list = ( qw{This is}, undef, qw{list} );
    insert_after { not defined($_) } "longer" => @list;
    $list[2] = "a";
    is( join(' ', @list), "This is a longer list" );

    leak_free_ok(insert_after => sub {
        @list = qw{This is a list};
        insert_after { $_ eq 'a' } "longer" => @list;
    });
}

sub test_insert_after_string {
    my @list = qw{This is a list};
    insert_after_string "a", "longer" => @list;
    is( join(' ', @list), "This is a longer list" );
    @list = ( undef, qw{This is a list} );
    insert_after_string "a", "longer", @list;
    shift @list;
    is( join(' ', @list), "This is a longer list" );
    @list = ( "This\0", "is\0", "a\0", "list\0" );
    insert_after_string "a\0", "longer\0", @list;
    is( join(' ', @list), "This\0 is\0 a\0 longer\0 list\0" );

    leak_free_ok(insert_after_string => sub {
        @list = qw{This is a list};
        insert_after_string "a", "longer", @list;
    });
}

sub test_apply {
    # Test the null case
    my $null_scalar = apply { };
    is( $null_scalar, undef, 'apply(null) returns undef' );

    my @null_list   = apply { };
    is_deeply( \@null_list, [ ], 'apply(null) returns null list' );

    # Normal cases
    my @list  = ( 0 .. 9 );
    my @list1  = ( 0 .. 9 );
    my @list1 = apply { $_++ } @list;
    ok( is_deeply( \@list,  [ 0 .. 9  ] ) );
    ok( is_deeply( \@list1, [ 1 .. 10 ] ) );
    @list  = ( " foo ", " bar ", "     ", "foobar" );
    @list1 = apply { s/^\s+|\s+$//g } @list;
    ok( is_deeply( \@list,  [ " foo ", " bar ", "     ", "foobar" ] ) );
    ok( is_deeply( \@list1, [ "foo", "bar", "", "foobar" ] ) );
    my $item = apply { s/^\s+|\s+$//g } @list;
    is( $item, "foobar" );

    # RT 38630
    SCOPE: {
        # wrong results from apply() [XS]
        @list = ( 1 .. 4 );
        @list1 = apply {
            grow_stack();
            $_ = 5;
        } @list;
        ok( is_deeply( \@list, [ 1 .. 4 ] ) );
        ok( is_deeply( \@list1, [ ( 5 ) x 4 ] ) );
    }

    leak_free_ok(apply => sub {
        @list = ( 1 .. 4 );
        @list1 = apply {
            grow_stack();
            $_ = 5;
        } @list;
    });
}

sub test_indexes {
    my @x = indexes { $_ > 5 } ( 4 .. 9 );
    ok( is_deeply( \@x, [ 2..5 ] ) );
    @x = indexes { $_ > 5 } ( 1 .. 4 );
    is_deeply( \@x, [ ], 'Got the null list' );

    leak_free_ok(indexes => sub {
        @x = indexes { $_ > 5 } ( 4 .. 9 );
        @x = indexes { $_ > 5 } ( 1 .. 4 );
    });
}

# In the following, the @dummy variable is needed to circumvent
# a parser glitch in the 5.6.x series.
sub test_before {
    my @x = before { $_ % 5 == 0 } 1 .. 9;    
    ok( is_deeply( \@x, [ 1, 2, 3, 4 ] ) );
    @x = before { /b/ } my @dummy = qw{ bar baz };<commit_msg>add test for RT##41494: memory leak in indexes()<commit_after>package LMU::Test::Tassilo::Funcs;

use 5.008001;

use strict;
#use warnings;

use Test::More;
use Test::LMU;
use List::MoreUtils ':tassilo';

use Config;

my $have_scalar_util;
eval { use Scalar::Util; $have_scalar_util = 1; };

# Run all tests
sub run_tests {
    test_any();
    test_all();
    test_none();
    test_notall();
    test_true();
    test_false();
    test_firstidx();
    test_lastidx();
    test_insert_after();
    test_insert_after_string();
    test_apply();
    test_indexes();
    test_before();
    test_before_incl();
    test_after();
    test_after_incl();
    test_firstval();
    test_lastval();
    test_each_array();
    test_pairwise();
    test_natatime();
    test_zip();
    test_mesh();
    test_uniq();
    test_part();
    test_minmax();
    test_bsearch();

    done_testing();
}

######################################################################
# Test code intentionally ignorant of implementation (Pure Perl or XS)

# The any function should behave identically to 
# !! grep CODE LIST
sub test_any {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( any { $_ == 5000 } @list );
    is_true( any { $_ == 5000 } 1 .. 10000 );
    is_true( any { defined } @list );
    is_false( any { not defined } @list );
    is_true( any { not defined } undef );
    is_undef( any { } );

    leak_free_ok(any => sub {
        my $ok = any { $_ == 5000 } @list;
        my $ok2 = any { $_ == 5000 } 1 .. 10000;
    });
    leak_free_ok('any with a coderef that dies' => sub {
        # This test is from <NAME>; see RT#48669
        eval { my $ok = any { die } 1 };
    });
}

sub test_all {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( all { defined } @list );
    is_true( all { $_ > 0 } @list );
    is_false( all { $_ < 5000 } @list );
    is_undef( all { } );

    leak_free_ok(all => sub {
        my $ok  = all { $_ == 5000 } @list;
        my $ok2 = all { $_ == 5000 } 1 .. 10000;
    });
}

sub test_none {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( none { not defined } @list );
    is_true( none { $_ > 10000 } @list );
    is_false( none { defined } @list );
    is_undef( none { } );

    leak_free_ok(none => sub {
        my $ok  = none { $_ == 5000 } @list;
        my $ok2 = none { $_ == 5000 } 1 .. 10000;
    });
}

sub test_notall {
    # Normal cases
    my @list = ( 1 .. 10000 );
    is_true( notall { ! defined } @list );
    is_true( notall { $_ < 10000 } @list );
    is_false( notall { $_ <= 10000 } @list );
    is_undef( notall { } );

    leak_free_ok(notall => sub {
        my $ok  = notall { $_ == 5000 } @list;
        my $ok2 = notall { $_ == 5000 } 1 .. 10000;
    });
}

sub test_true {
    # The null set should return zero
    my $null_scalar = true { };
    my @null_list   = true { };
    is( $null_scalar, 0, 'true(null) returns undef' );
    is_deeply( \@null_list, [ 0 ], 'true(null) returns undef' );

    # Normal cases
    my @list = ( 1 .. 10000 );
    is( 10000, true { defined } @list );
    is( 0, true { not defined } @list );
    is( 1, true { $_ == 5000 } @list );

    leak_free_ok(true => sub {
        my $n  = true { $_ == 5000 } @list;
        my $n2 = true { $_ == 5000 } 1 .. 10000;
    });
}

sub test_false {
    # The null set should return zero
    my $null_scalar = false { };
    my @null_list   = false { };
    is( $null_scalar, 0, 'false(null) returns undef' );
    is_deeply( \@null_list, [ 0 ], 'false(null) returns undef' );

    # Normal cases
    my @list = ( 1 .. 10000 );
    is( 10000, false { not defined } @list );
    is( 0, false { defined } @list );
    is( 1, false { $_ > 1 } @list );

    leak_free_ok(false => sub {
        my $n  = false { $_ == 5000 } @list;
        my $n2 = false { $_ == 5000 } 1 .. 10000;
    });
}

sub test_firstidx {
    my @list = ( 1 .. 10000 );
    is( 4999, firstidx { $_ >= 5000 } @list );
    is( -1, firstidx { not defined } @list );
    is( 0, firstidx { defined } @list );
    is( -1, firstidx { } );

    # Test the alias
    is( 4999, first_index { $_ >= 5000 } @list );
    is( -1, first_index { not defined } @list );
    is( 0, first_index { defined } @list );
    is( -1, first_index { } );

    leak_free_ok(firstidx => sub {
        my $i = firstidx { $_ >= 5000 } @list;
        my $i2 = firstidx { $_ >= 5000 } 1 .. 10000;
    });
}

sub test_lastidx {
    my @list = ( 1 .. 10000 );
    is( 9999, lastidx { $_ >= 5000 } @list );
    is( -1, lastidx { not defined } @list );
    is( 9999, lastidx { defined } @list );
    is( -1, lastidx { } );

    # Test aliases
    is( 9999, last_index { $_ >= 5000 } @list );
    is( -1, last_index { not defined } @list );
    is( 9999, last_index { defined } @list );
    is( -1, last_index { } );

    leak_free_ok(lastidx => sub {
        my $i = lastidx { $_ >= 5000 } @list;
        my $i2 = lastidx { $_ >= 5000 } 1 .. 10000;
    });
}

sub test_insert_after {
    my @list = qw{This is a list};
    insert_after { $_ eq "a" } "longer" => @list;
    is( join(' ', @list), "This is a longer list" );
    insert_after { 0 } "bla" => @list;
    is( join(' ', @list), "This is a longer list" );
    insert_after { $_ eq "list" } "!" => @list;
    is( join(' ', @list), "This is a longer list !" );
    @list = ( qw{This is}, undef, qw{list} );
    insert_after { not defined($_) } "longer" => @list;
    $list[2] = "a";
    is( join(' ', @list), "This is a longer list" );

    leak_free_ok(insert_after => sub {
        @list = qw{This is a list};
        insert_after { $_ eq 'a' } "longer" => @list;
    });
}

sub test_insert_after_string {
    my @list = qw{This is a list};
    insert_after_string "a", "longer" => @list;
    is( join(' ', @list), "This is a longer list" );
    @list = ( undef, qw{This is a list} );
    insert_after_string "a", "longer", @list;
    shift @list;
    is( join(' ', @list), "This is a longer list" );
    @list = ( "This\0", "is\0", "a\0", "list\0" );
    insert_after_string "a\0", "longer\0", @list;
    is( join(' ', @list), "This\0 is\0 a\0 longer\0 list\0" );

    leak_free_ok(insert_after_string => sub {
        @list = qw{This is a list};
        insert_after_string "a", "longer", @list;
    });
}

sub test_apply {
    # Test the null case
    my $null_scalar = apply { };
    is( $null_scalar, undef, 'apply(null) returns undef' );

    my @null_list   = apply { };
    is_deeply( \@null_list, [ ], 'apply(null) returns null list' );

    # Normal cases
    my @list  = ( 0 .. 9 );
    my @list1  = ( 0 .. 9 );
    my @list1 = apply { $_++ } @list;
    ok( is_deeply( \@list,  [ 0 .. 9  ] ) );
    ok( is_deeply( \@list1, [ 1 .. 10 ] ) );
    @list  = ( " foo ", " bar ", "     ", "foobar" );
    @list1 = apply { s/^\s+|\s+$//g } @list;
    ok( is_deeply( \@list,  [ " foo ", " bar ", "     ", "foobar" ] ) );
    ok( is_deeply( \@list1, [ "foo", "bar", "", "foobar" ] ) );
    my $item = apply { s/^\s+|\s+$//g } @list;
    is( $item, "foobar" );

    # RT 38630
    SCOPE: {
        # wrong results from apply() [XS]
        @list = ( 1 .. 4 );
        @list1 = apply {
            grow_stack();
            $_ = 5;
        } @list;
        ok( is_deeply( \@list, [ 1 .. 4 ] ) );
        ok( is_deeply( \@list1, [ ( 5 ) x 4 ] ) );
    }

    leak_free_ok(apply => sub {
        @list = ( 1 .. 4 );
        @list1 = apply {
            grow_stack();
            $_ = 5;
        } @list;
    });
}

sub test_indexes {
    my @x = indexes { $_ > 5 } ( 4 .. 9 );
    ok( is_deeply( \@x, [ 2..5 ] ) );
    @x = indexes { $_ > 5 } ( 1 .. 4 );
    is_deeply( \@x, [ ], 'Got the null list' );

    my (@s,@n,@o,@e);
    leak_free_ok(indexes => sub {
        @s = indexes { $_ > 5 } ( 4 .. 9 );
        @n = indexes { $_ > 5 } ( 1 .. 5 );
	@o = indexes { $_ & 1 } ( 10 .. 15 );
	@e = indexes { !($_ & 1) } ( 10 .. 15 );
    });
    is_deeply(\@s, [2..5], "indexes/leak: some");
    is_deeply(\@n, [], "indexes/leak: none");
    is_deeply(\@o, [1,3,5], "indexes/leak: odd");
    is_deeply(\@e, [0,2,4], "indexes/leak: even");

    leak_free_ok(indexes => sub {
        @s = indexes { grow_stack; $_ > 5 } ( 4 .. 9 );
        @n = indexes { grow_stack; $_ > 5 } ( 1 .. 4 );
	@o = indexes { grow_stack; $_ & 1 } ( 10 .. 15 );
	@e = indexes { grow_stack; !($_ & 1) } ( 10 .. 15 );
    });

    is_deeply(\@s, [2..5], "indexes/leak: some");
    is_deeply(\@n, [], "indexes/leak: none");
    is_deeply(\@o, [1,3,5], "indexes/leak: odd");
    is_deeply(\@e, [0,2,4], "indexes/leak: even");

    if($have_scalar_util) {
	my $ref = \(indexes(sub{1}, 123));
	Scalar::Util::weaken($ref);
	is($ref, undef, "weakened away");
    }
}

# In the following, the @dummy variable is needed to circumvent
# a parser glitch in the 5.6.x series.
sub test_before {
    my @x = before { $_ % 5 == 0 } 1 .. 9;    
    ok( is_deeply( \@x, [ 1, 2, 3, 4 ] ) );
    @x = before { /b/ } my @dummy = qw{ bar baz };
{'fraction_non_alphanumeric': 0.19380625296068213, 'fraction_numerical': 0.04535765040265277, 'mean_word_length': 2.1415550595238093, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 76, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3807570', 'n_tokens_mistral': 6967, 'n_tokens_neox': 6224, 'n_words': 1726}