Skip to content

Commit 973e8b2

Browse files
committed
Remember to capture t/op/any_all.t
1 parent e645f40 commit 973e8b2

File tree

2 files changed

+83
-0
lines changed

2 files changed

+83
-0
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6255,6 +6255,7 @@ t/op/aassign.t test list assign
62556255
t/op/alarm.t See if alarm works
62566256
t/op/anonconst.t See if :const works
62576257
t/op/anonsub.t See if anonymous subroutines work
6258+
t/op/any_all.t See if feature 'any_all' works
62586259
t/op/append.t See if . works
62596260
t/op/args.t See if operations on @_ work
62606261
t/op/arith2.t See if arithmetic works

t/op/any_all.t

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
#!./perl
2+
3+
BEGIN {
4+
chdir 't' if -d 't';
5+
require './test.pl';
6+
set_up_inc('../lib');
7+
}
8+
9+
use feature 'any_all';
10+
no warnings 'experimental::any_all';
11+
12+
# Basic true/false testing
13+
ok( (any { $_ > 10 } 1 .. 20), 'list contains a value above ten' );
14+
ok( !(any { $_ > 10 } 1 .. 9), 'list does not contain a value above ten' );
15+
ok( !(all { $_ < 10 } 1 .. 20), 'not all list values below ten' );
16+
ok( (all { $_ < 10 } 1 .. 9), 'all list values below ten' );
17+
18+
# any empty list is false
19+
{
20+
my $invoked;
21+
my $ret = any { $invoked++ } ();
22+
ok( defined $ret, 'any on empty list is defined' );
23+
ok( !$ret, 'any on empty list is false' );
24+
ok( !$invoked, 'any on empty list did not invoke block' );
25+
}
26+
27+
# all empty list is true
28+
{
29+
my $invoked;
30+
ok( (all { $invoked } ()), 'all on empty list is true' );
31+
ok( !$invoked, 'all on empty list did not invoke block' );
32+
}
33+
34+
# any failure yields false in list context
35+
{
36+
my @ret;
37+
@ret = any { $_ > 10 } 1 .. 9;
38+
ok( @ret == 1, 'any nothing yielded a value in list context' );
39+
ok( !$ret[0], 'any nothing yielded false in list context' );
40+
41+
@ret = any { $_ > 10 } ();
42+
ok( @ret == 1, 'any nothing yielded a value in list context on empty input' );
43+
ok( !$ret[0], 'any nothing yielded false in list context on empty input' );
44+
}
45+
46+
# all failure yields true in list context
47+
{
48+
my @ret;
49+
@ret = all { $_ > 10 } 1 .. 9;
50+
ok( @ret == 1, 'all nothing yielded a value in list context' );
51+
ok( !$ret[0], 'all nothing yielded false in list context' );
52+
53+
@ret = all { $_ > 10 } ();
54+
ok( @ret == 1, 'all nothing yielded a value in list context on empty input' );
55+
ok( $ret[0], 'all nothing yielded true in list context on empty input' );
56+
}
57+
58+
# short-circuiting
59+
{
60+
my @seen;
61+
any { push @seen, $_; $_ > 10 } 10, 20, 30, 40;
62+
ok( eq_array( \@seen, [ 10, 20 ] ), 'any short-circuits after first true result' );
63+
64+
undef @seen;
65+
all { push @seen, $_; $_ < 20 } 10, 20, 30, 40;
66+
ok( eq_array( \@seen, [ 10, 20 ] ), 'all short-circuits after first false result' );
67+
}
68+
69+
# stack discipline
70+
{
71+
ok( eq_array(
72+
[ 1, 2, (any { $_ eq "x" } "x", "y"), 3, 4 ],
73+
[ 1, 2, 1, 3, 4 ] ),
74+
'any() preserves stack discipline' );
75+
76+
ok( eq_array(
77+
[ 1, 2, (all { $_ eq "x" } "x", "x"), 3, 4 ],
78+
[ 1, 2, 1, 3, 4 ] ),
79+
'all() preserves stack discipline' );
80+
}
81+
82+
done_testing;

0 commit comments

Comments
 (0)