tests/thelp.pl

   1 #!/usr/bin/env perl
   2 # -*-perl-*-
   3 #
   4 # This script helps us write tests in a portable way, without relying on a lot
   5 # of shell features.  Since we already have Perl to run the tests, use that.
   6 #
   7 # The arguments represent a set of steps that will be run one at a time.
   8 # Each step consists of an operator and argument.
   9 #
  10 # It supports the following operators:
  11 #  out <word>   : echo <word> to stdout with a newline
  12 #  raw <word>   : echo <word> to stdout without adding anything
  13 #  file <word>  : echo <word> to stdout AND create the file <word>
  14 #  dir <word>   : echo <word> to stdout AND create the directory <word>
  15 #  rm <word>    : echo <word> to stdout AND delete the file/directory <word>
  16 #  wait <word>  : wait for a file named <word> to exist
  17 #  tmout <secs> : Change the timeout for waiting.  Default is 4 seconds.
  18 #  sleep <secs> : Sleep for <secs> seconds then echo <secs>
  19 #  fail <err>   : echo <err> to stdout then exit with error code err
  20 #
  21 # If given -q only the "out" command generates output.
  22
  23 # Force flush
  24 $| = 1;
  25
  26 my $quiet = 0;
  27 my $timeout = 10;
  28
  29 sub op {
  30     my ($op, $nm) = @_;
  31
  32     defined $nm or die "Missing value for $op\n";
  33
  34     if ($op eq 'out') {
  35         print "$nm\n";
  36         return 1;
  37     }
  38     if ($op eq 'raw') {
  39         print "$nm";
  40         return 1;
  41     }
  42
  43     # Show the output before creating the file
  44     if ($op eq 'file') {
  45         print "file $nm\n" unless $quiet;
  46         open(my $fh, '>', $nm) or die "$nm: open: $!\n";
  47         close(my $fh);
  48         return 1;
  49     }
  50
  51     # Show the output before creating the directory
  52     if ($op eq 'dir') {
  53         print "dir $nm\n" unless $quiet;
  54         mkdir($nm) or die "$nm: mkdir: $!\n";
  55         return 1;
  56     }
  57
  58     # Show the output after removing the file
  59     if ($op eq 'rm') {
  60         if (-f $nm) {
  61             unlink($nm) or die "$nm: unlink: $!\n";
  62         } elsif (-d $nm) {
  63             rmdir($nm) or die "$nm: rmdir: $!\n";
  64         } else {
  65             die "$nm: not file or directory: $!\n";
  66         }
  67         print "rm $nm\n" unless $quiet;
  68         return 1;
  69     }
  70
  71     if ($op eq 'tmout') {
  72         $timeout = $nm;
  73         print "tmout $nm\n" unless $quiet;
  74         return 1;
  75     }
  76
  77     # Show the output after the file exists
  78     if ($op eq 'wait') {
  79         my $start = time();
  80         my $end = $start + $timeout;
  81         while (time() <= $end) {
  82             if (-f $nm) {
  83                 print "wait $nm\n" unless $quiet;
  84                 return 1;
  85             }
  86             select(undef, undef, undef, 0.1);
  87         }
  88         die "wait $nm: timeout after ".(time()-$start-1)." seconds\n";
  89     }
  90
  91     # Show the output after sleeping
  92     if ($op eq 'sleep') {
  93         sleep($nm);
  94         print "sleep $nm\n" unless $quiet;
  95         return 1;
  96     }
  97
  98     if ($op eq 'fail') {
  99         print "fail $nm\n";
 100         exit($nm);
 101     }
 102
 103     die("Invalid command: $op $nm\n");
 104 }
 105
 106 if (@ARGV && $ARGV[0] eq '-q') {
 107     $quiet = 1;
 108     shift;
 109 }
 110
 111 while (@ARGV) {
 112     if (op($ARGV[0], $ARGV[1])) {
 113         shift;
 114         shift;
 115     }
 116 }
 117
 118 exit(0);