make/tests/jhelp.pl

#!/usr/bin/env perl
# -*-perl-*-
#
# This script helps us test jobserver/parallelism without a lot of unreliable
# (and slow) sleep calls.  Written in Perl to get portable sub-second sleep.
#
# It can run the following steps based on arguments:
#  -t <secs>  : maximum # of seconds the script can run; else we fail.
#               Default is 4 seconds.
#  -e <word>  : echo <word> to stdout
#  -f <word>  : echo <word> to stdout AND create an (empty) file named <word>
#  -w <word>  : wait for a file named <word> to exist

# Force flush
$| = 1;

my $timeout = 4;

sub op {
    my ($op, $nm) = @_;

    defined $nm or die "Missing value for $op\n";

    if ($op eq '-e') {
        print "$nm\n";
        return 1;
    }

    if ($op eq '-f') {
        print "$nm\n";
        open(my $fh, '>', $nm) or die "$nm: open: $!\n";
        close(my $fh);
        return 1;
    }

    if ($op eq '-w') {
        if (-f $nm) {
            return 1;
        }
        select(undef, undef, undef, 0.1);
        return 0;
    }

    if ($op eq '-t') {
        $timeout = $nm;
        return 1;
    }

    die("Invalid command: $op $nm\n");
}

my $start = time();
while (@ARGV) {
    if (op($ARGV[0], $ARGV[1])) {
        shift;
        shift;
    }
    if ($start + $timeout < time()) {
        die("Timeout after ".(time()-$start-1)." seconds\n");
    }
}

exit(0);