1#!./perl
2
3use strict;
4use warnings;
5
6use List::Util qw(first);
7use Test::More;
8plan tests => 24;
9my $v;
10
11ok(defined &first, 'defined');
12
13$v = first { 8 == ($_ - 1) } 9,4,5,6;
14is($v, 9, 'one more than 8');
15
16$v = first { 0 } 1,2,3,4;
17is($v, undef, 'none match');
18
19$v = first { 0 };
20is($v, undef, 'no args');
21
22$v = first { $_->[1] le "e" and "e" le $_->[2] }
23    [qw(a b c)], [qw(d e f)], [qw(g h i)];
24is_deeply($v, [qw(d e f)], 'reference args');
25
26# Check that eval{} inside the block works correctly
27my $i = 0;
28$v = first { eval { die }; ($i == 5, $i = $_)[0] } 0,1,2,3,4,5,5;
29is($v, 5, 'use of eval');
30
31$v = eval { first { die if $_ } 0,0,1 };
32is($v, undef, 'use of die');
33
34sub foobar {  first { !defined(wantarray) || wantarray } "not ","not ","not " }
35
36($v) = foobar();
37is($v, undef, 'wantarray');
38
39# Can we leave the sub with 'return'?
40$v = first {return ($_>6)} 2,4,6,12;
41is($v, 12, 'return');
42
43# ... even in a loop?
44$v = first {while(1) {return ($_>6)} } 2,4,6,12;
45is($v, 12, 'return from loop');
46
47# Does it work from another package?
48{ package Foo;
49  ::is(List::Util::first(sub{$_>4},(1..4,24)), 24, 'other package');
50}
51
52# Can we undefine a first sub while it's running?
53sub self_immolate {undef &self_immolate; 1}
54eval { $v = first \&self_immolate, 1,2; };
55like($@, qr/^Can't undef active subroutine/, "undef active sub");
56
57# Redefining an active sub should not fail, but whether the
58# redefinition takes effect immediately depends on whether we're
59# running the Perl or XS implementation.
60
61sub self_updating {
62  no warnings 'redefine';
63  *self_updating = sub{1};
64  1
65}
66eval { $v = first \&self_updating, 1,2; };
67is($@, '', 'redefine self');
68
69{ my $failed = 0;
70
71    sub rec { my $n = shift;
72        if (!defined($n)) {  # No arg means we're being called by first()
73            return 1; }
74        if ($n<5) { rec($n+1); }
75        else { $v = first \&rec, 1,2; }
76        $failed = 1 if !defined $n;
77    }
78
79    rec(1);
80    ok(!$failed, 'from active sub');
81}
82
83# Calling a sub from first should leave its refcount unchanged.
84SKIP: {
85    skip("No Internals::SvREFCNT", 1) if !defined &Internals::SvREFCNT;
86    sub huge {$_>1E6}
87    my $refcnt = &Internals::SvREFCNT(\&huge);
88    $v = first \&huge, 1..6;
89    is(&Internals::SvREFCNT(\&huge), $refcnt, "Refcount unchanged");
90}
91
92# These tests are only relevant for the real multicall implementation. The
93# psuedo-multicall implementation behaves differently.
94SKIP: {
95    $List::Util::REAL_MULTICALL ||= 0; # Avoid use only once
96    skip("Poor man's MULTICALL can't cope", 2)
97      if !$List::Util::REAL_MULTICALL;
98
99    # Can we goto a label from the 'first' sub?
100    eval {()=first{goto foo} 1,2; foo: 1};
101    like($@, qr/^Can't "goto" out of a pseudo block/, "goto label");
102
103    # Can we goto a subroutine?
104    eval {()=first{goto sub{}} 1,2;};
105    like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
106}
107
108use constant XSUBC_TRUE  => 1;
109use constant XSUBC_FALSE => 0;
110
111is first(\&XSUBC_TRUE,  42, 1, 2, 3), 42,    'XSUB callbacks';
112is first(\&XSUBC_FALSE, 42, 1, 2, 3), undef, 'XSUB callbacks';
113
114
115eval { &first(1) };
116ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
117eval { &first(1,2) };
118ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
119eval { &first(qw(a b)) };
120ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
121eval { &first([],1,2,3) };
122ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
123eval { &first(+{},1,2,3) };
124ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
125
126