The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
use warnings;
use vars '$forkres';

use Test::More tests => 13;

BEGIN { *CORE::GLOBAL::fork = sub { $forkres } }

BEGIN { use_ok( 'Proc::Fork' ); }

# basic functionality
{ local $forkres = 1; parent { ok( 1, 'parent code executes' )    };          }
{ local $forkres = 0; child  { ok( 1, 'child code executes'  )    };          }
{                     error  { ok( 1, 'error code executes'  )    };          }
{                     retry  { ok( 1, 'retry code executes'  ); 0 } error {}; }

# pid gets passed in?
{ local $forkres = 42; parent { is( shift, 42, 'pid is passed to parent block' ) }; }

# error catching attempts
eval { parent {} "oops" };
like( $@, qr/^Garbage in Proc::Fork setup \(after \w+ clause\)/, 'syntax error catcher fired' );

# test retry logic
my $expect_try;
retry {
	++$expect_try;
	is( $_[ 0 ], $expect_try, "retry attempt $expect_try signalled" );
	return $_[ 0 ] < 5; 
}
error {
	is( $expect_try, 5, 'abort after 5th attempt' );
};

# vim:ft=perl: