|
| 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