use strict;
use warnings;

use Test::More;

my @tests = ( { a1    => [ 23 ],      # 1
                a2    => [ 42 ],
                call1 => 1,
                call2 => 0,
                want  =>   23,  },
              { a1    => [  0 ],      # 2
                a2    => [ 42 ],
                call1 => 1,
                call2 => 0,
                want  =>    0,  },
              { a1    => [],          # 3
                a2    => [ 42 ],
                call1 => 1,
                call2 => 1,
                want  =>   42,  },
              { a1    => [ 23, 17 ],  # 4
                a2    => [ 42 ],
                call1 => 1,
                call2 => 1,
                want  =>   42,  },
              { a1    => [],          # 5
                a2    => [ 0 ],
                call1 => 1,
                call2 => 1,
                want  =>   0,   },
              { a1    => [ 23, 17 ],  # 6
                a2    => [ 0 ],
                call1 => 1,
                call2 => 1,
                want  =>   0,   },
              { a1    => [],          # 7
                a2    => [],
                call1 => 1,
                call2 => 1,
                want  => undef, },
              );

my @solutions = ( [ \&orig,    'original' ],
                  [ \&ikegami, 'ikegami'  ],
                  [ \&tye,     'tye'      ],
                  [ \&kyle,    'kyle'     ],
                  [ \&anon,    'anon'     ],
                  );

plan 'tests' => 3 * scalar @solutions * scalar @tests;

foreach my $s ( @solutions ) {
    try_one( @{ $s } );
}

sub try_one {
    my ( $solution, $name ) = @_;

    my $tn = 1;
    foreach my $t ( @tests ) {
        my $code1_called = 0;
        my $code2_called = 0;
        my $code1 = sub { $code1_called = 1; return @{ $t->{a1} } };
        my $code2 = sub { $code2_called = 1; return @{ $t->{a2} } };

        is( $solution->( $code1, $code2 ), $t->{want}, "$name $tn" );
        my $not;
        $not = $t->{call1} ? '' : ' not';
        is( !!$code1_called, !!$t->{call1}, "$name did$not call code1"
+ );
        $not = $t->{call1} ? '' : ' not';
        is( !!$code2_called, !!$t->{call2}, "$name did$not call code2"
+ );

        $tn++;
    }

    return;
}

sub orig {
    my ( $code1, $code2 ) = @_;

    my @f;
    if ((@f = $code1->()) == 1 || (@f = $code2->()) == 1) {
        return $f[0];
    }

    return undef;
}

sub ikegami {
    my ( $code1, $code2 ) = @_;

    if (
        sub {
            our @f; local *f = $_[0];
            (@f = $code1->()) == 1 || (@f = $code2->()) == 1
            }->(\my @f)
        ) {
        return $f[0];
    }

    return undef;
}

sub tye {
    my ( $code1, $code2 ) = @_;

    if( my @f= do { my @g; 1 == ( @g= $code1->() ) || 1 == ( @g= $code
+2->() ) ; @g } ) {
        return $f[0];
    }

    return undef;
}

use List::Util qw( first );

sub kyle {
    my ( $code1, $code2 ) = @_;

# fails the call/not call tests
#    if ( my @f = @{ (grep { @{$_}==1 } [$code1->()], [$code2->()] )[0
+]||[] } ) {
    if ( my @f = @{(first { @{$_=[$_->()]}==1 } $code1, $code2)[0]||[]
+} ) {
        return $f[0];
    }

    return undef;
}

sub anon {
    my ( $code1, $code2 ) = @_;

    if ( 1 == (my @f = $code1->() || $code2->()) ) {
        return $f[0];
    }

    return undef;
}
[download]