"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "cpan/Scalar-List-Utils/t/reduce.t" between
perl-5.32.0-RC0.tar.xz and perl-5.32.0-RC1.tar.xz

About: Perl (Practical Extraction and Report Language) is a high-level, general-purpose, interpreted, dynamic programming language. Release candidate.

reduce.t  (perl-5.32.0-RC0.tar.xz):reduce.t  (perl-5.32.0-RC1.tar.xz)
#!./perl #!./perl
use strict; use strict;
use warnings; use warnings;
use List::Util qw(reduce min); use List::Util qw(reduce min);
use Test::More; use Test::More;
plan tests => 30 + ($::PERL_ONLY ? 0 : 2); plan tests => 33;
my $v = reduce {}; my $v = reduce {};
is( $v, undef, 'no args'); is( $v, undef, 'no args');
$v = reduce { $a / $b } 756,3,7,4; $v = reduce { $a / $b } 756,3,7,4;
is( $v, 9, '4-arg divide'); is( $v, 9, '4-arg divide');
$v = reduce { $a / $b } 6; $v = reduce { $a / $b } 6;
is( $v, 6, 'one arg'); is( $v, 6, 'one arg');
my @a = map { rand } 0 .. 20; my @a = map { rand } 0 .. 20;
$v = reduce { $a < $b ? $a : $b } @a; $v = reduce { $a < $b ? $a : $b } @a;
is( $v, min(@a), 'min'); is( $v, min(@a), 'min');
@a = map { pack("C", int(rand(256))) } 0 .. 20; @a = map { pack("C", int(rand(256))) } 0 .. 20;
$v = reduce { $a . $b } @a; $v = reduce { $a . $b } @a;
is( $v, join("",@a), 'concat'); is( $v, join("",@a), 'concat');
sub add { sub add {
my($aa, $bb) = @_; my($aa, $bb) = @_;
return $aa + $bb; return $aa + $bb;
} }
$v = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1; $v = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
is( $v, 6, 'call sub'); is( $v, 6, 'call sub');
# Check that eval{} inside the block works correctly # Check that eval{} inside the block works correctly
$v = reduce { eval { die }; $a + $b } 0,1,2,3,4; $v = reduce { eval { die }; $a + $b } 0,1,2,3,4;
is( $v, 10, 'use eval{}'); is( $v, 10, 'use eval{}');
$v = !defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 }; $v = !defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 };
ok($v, 'die'); ok($v, 'die');
sub foobar { reduce { (defined(wantarray) && !wantarray) ? $a+1 : 0 } 0,1,2,3 } sub foobar { reduce { (defined(wantarray) && !wantarray) ? $a+1 : 0 } 0,1,2,3 }
($v) = foobar(); ($v) = foobar();
is( $v, 3, 'scalar context'); is( $v, 3, 'scalar context');
sub add2 { $a + $b } sub add2 { $a + $b }
$v = reduce \&add2, 1,2,3; $v = reduce \&add2, 1,2,3;
is( $v, 6, 'sub reference'); is( $v, 6, 'sub reference');
$v = reduce { add2() } 3,4,5; $v = reduce { add2() } 3,4,5;
is( $v, 12, 'call sub'); is( $v, 12, 'call sub');
$v = reduce { eval "$a + $b" } 1,2,3; $v = reduce { eval "$a + $b" } 1,2,3;
is( $v, 6, 'eval string'); is( $v, 6, 'eval string');
$a = 8; $b = 9; $a = 8; $b = 9;
$v = reduce { $a * $b } 1,2,3; $v = reduce { $a * $b } 1,2,3;
is( $a, 8, 'restore $a'); is( $a, 8, 'restore $a');
is( $b, 9, 'restore $b'); is( $b, 9, 'restore $b');
# Can we leave the sub with 'return'? # Can we leave the sub with 'return'?
skipping to change at line 127 skipping to change at line 127
{ {
my $ok = 'failed'; my $ok = 'failed';
local $SIG{__DIE__} = sub { $ok = $_[0] =~ /Not a (subroutine|CODE) reference/ ? '' : $_[0] }; local $SIG{__DIE__} = sub { $ok = $_[0] =~ /Not a (subroutine|CODE) reference/ ? '' : $_[0] };
eval { &reduce('foo',1,2) }; eval { &reduce('foo',1,2) };
is($ok, '', 'Not a subroutine reference'); is($ok, '', 'Not a subroutine reference');
$ok = 'failed'; $ok = 'failed';
eval { &reduce({},1,2) }; eval { &reduce({},1,2) };
is($ok, '', 'Not a subroutine reference'); is($ok, '', 'Not a subroutine reference');
} }
# The remainder of the tests are only relevant for the XS # These tests are only relevant for the real multicall implementation. The
# implementation. The Perl-only implementation behaves differently # psuedo-multicall implementation behaves differently.
# (and more flexibly) in a way that we can't emulate from XS. SKIP: {
if (!$::PERL_ONLY) { SKIP: {
$List::Util::REAL_MULTICALL ||= 0; # Avoid use only once $List::Util::REAL_MULTICALL ||= 0; # Avoid use only once
skip("Poor man's MULTICALL can't cope", 2) skip("Poor man's MULTICALL can't cope", 2)
if !$List::Util::REAL_MULTICALL; if !$List::Util::REAL_MULTICALL;
# Can we goto a label from the reduction sub? # Can we goto a label from the reduction sub?
eval {()=reduce{goto foo} 1,2; foo: 1}; eval {()=reduce{goto foo} 1,2; foo: 1};
like($@, qr/^Can't "goto" out of a pseudo block/, "goto label"); like($@, qr/^Can't "goto" out of a pseudo block/, "goto label");
# Can we goto a subroutine? # Can we goto a subroutine?
eval {()=reduce{goto sub{}} 1,2;}; eval {()=reduce{goto sub{}} 1,2;};
like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub"); like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
}
} } {
my @ret = reduce { $a + $b } 1 .. 5;
is_deeply( \@ret, [ 15 ], 'reduce in list context yields only final answer' );
}
# XSUB callback # XSUB callback
use constant XSUBC => 42; use constant XSUBC => 42;
is reduce(\&XSUBC, 1, 2, 3), 42, "xsub callbacks"; is reduce(\&XSUBC, 1, 2, 3), 42, "xsub callbacks";
eval { &reduce(1) }; eval { &reduce(1) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce(1,2) }; eval { &reduce(1,2) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce(qw(a b)) }; eval { &reduce(qw(a b)) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce([],1,2,3) }; eval { &reduce([],1,2,3) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce(+{},1,2,3) }; eval { &reduce(+{},1,2,3) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
my @names = ("a\x{100}c", "d\x{101}efgh", 'ijk'); my @names = ("a\x{100}c", "d\x{101}efgh", 'ijk');
my $longest = reduce { length($a) > length($b) ? $a : $b } @names; my $longest = reduce { length($a) > length($b) ? $a : $b } @names;
is( length($longest), 6, 'missing SMG rt#121992'); is( length($longest), 6, 'missing SMG rt#121992');
 End of changes. 15 change blocks. 
17 lines changed or deleted 19 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)