#!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";