#!/usr/bin/env perl # -*-perl-*- # # This script helps us write tests in a portable way, without relying on a lot # of shell features. Since we already have Perl to run the tests, use that. # # The arguments represent a set of steps that will be run one at a time. # Each step consists of an operator and argument. # # It supports the following operators: # out : echo to stdout with a newline # raw : echo to stdout without adding anything # env : echo the value of the env.var. , or "" # file : echo to stdout AND create the file # dir : echo to stdout AND create the directory # rm : echo to stdout AND delete the file/directory # wait : wait for a file named to exist # exist : echo AND fail if a file named doesn't exist # noexist : echo AND fail if a file named exists # tmout : Change the timeout for waiting. Default is 4 seconds. # sleep : Sleep for seconds then echo # term : send SIGTERM to PID # fail : echo to stdout then exit with error code err # # If given -q only the "out", "raw", and "env" commands generate output. # Force flush $| = 1; my $quiet = 0; my $timeout = 10; sub op { my ($op, $nm) = @_; defined $nm or die "Missing value for $op\n"; if ($op eq 'out') { print "$nm\n"; return 1; } if ($op eq 'raw') { print "$nm"; return 1; } if ($op eq 'env') { print "$nm=" unless $quiet; if (exists $ENV{$nm}) { print "$ENV{$nm}\n"; } else { print "\n"; } return 1; } # Show the output before creating the file if ($op eq 'file') { print "file $nm\n" unless $quiet; open(my $fh, '>', $nm) or die "$nm: open: $!\n"; close(my $fh); return 1; } if ($op eq 'exist') { -f "$nm" || die "$nm: file should exist: $!\n"; print "exist $nm\n" unless $quiet; return 1 } if ($op eq 'noexist') { -f "$nm" && die "$nm: file exists\n"; print "noexist $nm\n" unless $quiet; return 1 } # Show the output before creating the directory if ($op eq 'dir') { print "dir $nm\n" unless $quiet; mkdir($nm) or die "$nm: mkdir: $!\n"; return 1; } # Show the output after removing the file if ($op eq 'rm') { if (-f $nm) { unlink($nm) or die "$nm: unlink: $!\n"; } elsif (-d $nm) { rmdir($nm) or die "$nm: rmdir: $!\n"; } else { die "$nm: not file or directory: $!\n"; } print "rm $nm\n" unless $quiet; return 1; } if ($op eq 'tmout') { $timeout = $nm; print "tmout $nm\n" unless $quiet; return 1; } # Show the output after the file exists if ($op eq 'wait') { my $start = time(); my $end = $start + $timeout; while (time() <= $end) { if (-f $nm) { print "wait $nm\n" unless $quiet; return 1; } select(undef, undef, undef, 0.1); } die "wait $nm: timeout after ".(time()-$start-1)." seconds\n"; } # Show the output after sleeping if ($op eq 'sleep') { sleep($nm); print "sleep $nm\n" unless $quiet; return 1; } if ($op eq 'term') { print "term $nm\n" unless $quiet; kill('TERM', $nm); return 1; } if ($op eq 'fail') { print "fail $nm\n" unless $quiet; exit($nm); } die("Invalid command: $op $nm\n"); } if (@ARGV && $ARGV[0] eq '-q') { $quiet = 1; shift; } while (@ARGV) { if (op($ARGV[0], $ARGV[1])) { shift; shift; } } exit(0);