view release on metacpan or  search on metacpan

examples/forked_harness.pl  view on Meta::CPAN

# [-h] [-c] [-v] [-I lib [-I lib [...]]] [-p xxx [-p xxx [...]]] [-s]
# [-t nnn] [-r nnn] [-x nnn] [-m nnn] [-q] [-a]
# abcdefghijklmnopqrstuvwxyz
# x s @  x@   i x@xixi x i x
my $result = GetOptions(
    'h|harness'   => \$use_harness,
    'C|color'     => \$use_color,
    'verbose'     => \$test_verbose,
    'I|include=s' => \@use_libs,
    'p|popts=s'   => \@perl_opts,
    'env=s'       => \@env,
    's|shuffle'   => \$shuffle,
    't|timeout=i' => \$timeout,
    'r|repeat=i'  => \$repeat,
    'xrepeat=i'   => \$xrepeat,
    'm|maxproc=i'   => \$maxproc,
    'q|quiet'     => \$quiet,
    'qq|really-quiet' => \$really_quiet,
    'debug'       => \$debug,
    'z|socket'    => \$use_socket,
    'abort-on-fail' => \$abort_on_first_error,
    'pause=s'     => \$pause,
    'O|order'    => \$inorder,
    'help'       => \$help,
    );

if ($help) {
    &print_usage;
    exit;
}

my %fail = ();
if ($ENV{TAINT_CHECK} || ${^TAINT}) {
    @perl_opts = map { /(.*)/ } @perl_opts;
    push @perl_opts, '-T';
}

$use_color &&= -t STDOUT &&
    eval 'use Term::ANSIColor 3.00; 1';

$test_verbose ||= 0;
$repeat = 1 if $repeat < 1;
$xrepeat = 1 if $xrepeat < 1;
$quiet ||= $really_quiet;
$Forks::Super::MAX_PROC = $maxproc if $maxproc;
$Forks::Super::ON_BUSY = 'block' if $ENV{BLOCK} || $pause > 0;
sub color_print;

# these colors are appropriate when your terminal has a dark background.
# XXX-How can this program determine when your terminal
#     has a dark background?
my %colors = (ITERATION => 'bold white',
	      GOOD_STATUS => 'bold green',
	      BAD_STATUS => 'bold red',
	      'STDERR' => 'yellow bold',
	      DEBUG => 'cyan bold',
	      NORMAL => '');

if ($debug) {
    color_print('DEBUG', "MAX_PROC is $Forks::Super::MAX_PROC, ",
		"on busy is $Forks::Super::ON_BUSY\n");
}

#####################################################3
#
# determine the set of test scripts to run
#

my $glob_required = 0;
if (@ARGV == 0) {
    # read ${TEST_FILES} from %ENV
    @ARGV = split /\s+/, $ENV{TEST_FILES} || '';

    if (@ARGV == 0) {
	# read  $(TEST_FILES) from Makefile
	my $mfile;
	open($mfile, '<', 'Makefile')
	    or open($mfile, '<', '../Makefile')
	    or die 'No test files specified, ',
	    	   "can't read defaults from Makefile!\n";
	my ($test_files) = grep { /^TEST_FILES\s*=/ } <$mfile>;
	close $mfile;
	$test_files =~ s/\s+=/= /;
	my @test_files = split /\s+/, $test_files;
	shift @test_files;

	@ARGV = @test_files;
    }
    $glob_required = 1;
}

if ($^O eq 'MSWin32' || $glob_required) {
    # might need to glob the command line arg ourselves ...
    my @to_glob = grep { /[*?]/ } @ARGV;
    if (@to_glob > 0) {
	@ARGV = grep { !/[*?]/ } @ARGV;
	push @ARGV, glob($_) foreach @to_glob;
    }
}

my @test_files = (@ARGV) x $xrepeat;
my @result = ();
my $total_status = 0;
my $total_fail = 0;
my $iteration;
my $ntests = scalar @test_files;
if ($debug) {
    # running too many tests simultaneously will use up all your filehandles ...
    color_print(DEBUG => "There are $ntests tests to run (",
		scalar @ARGV, " x $xrepeat)\n");
}
my (%j,$jcount,@j);

&main;
&summarize;
&check_endgame if $check_endgame;
exit ($total_fail > 254 ? 254 : $total_fail);

# exit ($total_status > 254 << 8 ? 254 : $total_status >> 8);

##################################################################