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

use perl5i::latest;

use Test::More tests => 14;

my $v = [ 9, 4, 5, 6 ]->first( sub { 8 == ( $_ - 1 ) } );

is( $v, 9, 'one more than 8' );

$v = [ 1, 2, 3, 4 ]->first( sub { 0 } );
is( $v, undef, 'none match' );

$v = []->first( sub { 0 } );
is( $v, undef, 'no args' );

$v = [ [qw(a b c)], [qw(d e f)], [qw(g h i)] ]->first( sub { $_->[1] le "e" and "e" le $_->[2] } );
is_deeply( $v, [qw(d e f)], 'reference args' );

# Check that eval{} inside the block works correctly
my $i = 0;
$v = [ 0, 1, 2, 3, 4, 5, 5 ]->first(
    sub {
        eval { die };
        ( $i == 5, $i = $_ )[0];
    }
);
is( $v, 5, 'use of eval' );

$v = eval {
    [ 0, 0, 1 ]->first( sub { die if $_ } );
};
is( $v, undef, 'use of die' );

sub foobar {
    [ "not ", "not ", "not " ]->first( sub { !defined(wantarray) || wantarray } );
}

($v) = foobar();
is( $v, undef, 'wantarray' );

# Can we leave the sub with 'return'?
$v = [ 2, 4, 6, 12 ]->first( sub { return( $_ > 6 ) } );
is( $v, 12, 'return' );

# ... even in a loop?
$v = [ 2, 4, 6, 12 ]->first(
    sub {
        while(1) { return( $_ > 6 ) }
    }
);
is( $v, 12, 'return from loop' );

# Does it work from another package?
{

    package Foo;
    use autobox::List::Util;
    ::is( [ 1 .. 4, 24 ]->first( sub { $_ > 4 } ), 24, 'other package' );
}

# Can we undefine a first sub while it's running?
sub self_immolate { undef &self_immolate; 1 }
eval { $v = [ 1, 2 ]->first( \&self_immolate ) };
like( $@, qr/^Can't undef active subroutine/, "undef active sub" );

# Redefining an active sub should not fail, but whether the
# redefinition takes effect immediately depends on whether we're
# running the Perl or XS implementation.

{

    sub self_updating {
        no warnings 'redefine';
        *self_updating = sub { 1 };
        return;
    }
    eval { $v = [ 1, 2 ]->first( \&self_updating ) };
    is( $@, '', 'redefine self' );
}

{
    my $failed = 0;

    sub rec {
        my $n = shift;
        if( !defined($n) ) {    # No arg means we're being called by first()
            return 1;
        }
        if( $n < 5 ) { rec( $n + 1 ); }
        else { $v = [ 1, 2 ]->first( \&rec ) }
        $failed = 1 if !defined $n;
    }

    rec(1);
    ok( !$failed, 'from active sub' );
}

# Works with Regexp

is [ qw(foo bar baz) ]->first(qr/^ba/), 'bar', "Works with Regexp";