The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!./perl

use Config;

use List::Util < qw(reduce min);
use Test::More;
plan tests => 19;

my $v = reduce {};

is( $v,	undef,	'no args');

$v = reduce { $a / $b }, 756,3,7,4;
is( $v,	9,	'4-arg divide');

$v = reduce { $a / $b }, 6;
is( $v,	6,	'one arg');

my @a = map { rand }, 0 .. 20;
$v = reduce { $a +< $b ?? $a !! $b }, < @a;
is( $v,	min(< @a),	'min');

@a = map { pack("C", int(rand(256))) }, 0 .. 20;
$v = reduce { $a . $b }, < @a;
is( $v,	join("", @a),	'concat');

sub add($aa, $bb) {
  return $aa + $bb;
}

$v = reduce { my $t="$a $b\n"; 0+add($a, $b) }, 3, 2, 1;
is( $v,	6,	'call sub');

# Check that try{} inside the block works correctly
$v = reduce { try { die }; $a + $b }, 0,1,2,3,4;
is( $v,	10,	'use eval{}');

$v = !defined try { reduce { die if $b +> 2; $a + $b }, 0,1,2,3,4 };
ok($v, 'die');

sub add2 { $a + $b }

$v = reduce \&add2, 1,2,3;
is( $v,	6,	'sub reference');

$v = reduce { add2() }, 3,4,5;
is( $v, 12,	'call sub');


$v = reduce { eval "$a + $b" }, 1,2,3;
is( $v, 6, 'eval string');

$a = 8; $b = 9;
$v = reduce { $a * $b }, 1,2,3;
is( $a, 8, 'restore $a');
is( $b, 9, 'restore $b');

# Can we leave the sub with 'return'?
$v = reduce {return $a+$b}, 2,4,6;
is($v, 12, 'return');

# ... even in a loop?
$v = reduce {while(1) {return $a+$b} }, 2,4,6;
is($v, 12, 'return from loop');

# Does it work from another package?
do { package Foo;
  $a = $b;
  main::is((List::Util::reduce {$a*$b}, ( <1..4)), 24, 'other package');
};

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

sub self_updating { local $^WARNING = undef; *self_updating = sub{1} ;1 }
try { $v = reduce \&self_updating, 1,2; };
is($^EVAL_ERROR, '', 'redefine self');

do { my $failed = 0;

    sub rec { my $n = shift;
        if (!defined($n)) {  # No arg means we're being called by reduce()
            return 1; }
        if ($n+<5) { rec($n+1); }
        else { $v = reduce \&rec, 1,2; }
        $failed = 1 if !defined $n;
    }

    rec(1);
    ok(!$failed, 'from active sub');
};

# Calling a sub from reduce should leave its refcount unchanged.
SKIP: do {
    skip("No Internals::SvREFCNT", 1) if !defined &Internals::SvREFCNT;
    sub mult {$a*$b}
    my $refcnt = &Internals::SvREFCNT(\&mult);
    $v = reduce \&mult, < 1..6;
    is(&Internals::SvREFCNT(\&mult), $refcnt, "Refcount unchanged");
};