1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
use blib;
use strict;
use warnings;
use autobox::List::Util;
use Test::More tests => 13;
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.
{
local $SIG{__WARN__} = sub {}; #trap warnings;
sub self_updating { local $^W; *self_updating = sub{1} ;1}
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');
}
|
