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
  12 #  file <word>  : echo <word> to stdout AND create the file <word>
  13 #  dir <word>   : echo <word> to stdout AND create the directory <word>
  14 #  rm <word>    : echo <word> to stdout AND delete the file/directory <word>
  15 #  wait <word>  : wait for a file named <word> to exist
  16 #  tmout <secs> : Change the timeout for waiting.  Default is 4 seconds.
  17 #  sleep <secs> : Sleep for <secs> seconds then echo <secs>
  18 #  fail <err>   : echo <err> to stdout then exit with error code err
  19 #
  20 # If given -q only the "out" command generates output.
  21
  22 # Force flush
  23 $| = 1;
  24
  25 my $quiet = 0;
  26 my $timeout = 4;
  27
  28 sub op {
  29     my ($op, $nm) = @_;
  30
  31     defined $nm or die "Missing value for $op\n";
  32
  33     if ($op eq 'out') {
  34         print "$nm\n";
  35         return 1;
  36     }
  37
  38     # Show the output before creating the file
  39     if ($op eq 'file') {
  40         print "file $nm\n" unless $quiet;
  41         open(my $fh, '>', $nm) or die "$nm: open: $!\n";
  42         close(my $fh);
  43         return 1;
  44     }
  45
  46     # Show the output before creating the directory
  47     if ($op eq 'dir') {
  48         print "dir $nm\n" unless $quiet;
  49         mkdir($nm) or die "$nm: mkdir: $!\n";
  50         return 1;
  51     }
  52
  53     # Show the output after removing the file
  54     if ($op eq 'rm') {
  55         if (-f $nm) {
  56             unlink($nm) or die "$nm: unlink: $!\n";
  57         } elsif (-d $nm) {
  58             rmdir($nm) or die "$nm: rmdir: $!\n";
  59         } else {
  60             die "$nm: not file or directory: $!\n";
  61         }
  62         print "rm $nm\n" unless $quiet;
  63         return 1;
  64     }
  65
  66     if ($op eq 'tmout') {
  67         $timeout = $nm;
  68         print "tmout $nm\n" unless $quiet;
  69         return 1;
  70     }
  71
  72     # Show the output after the file exists
  73     if ($op eq 'wait') {
  74         my $start = time();
  75         my $end = $start + $timeout;
  76         while (time() <= $end) {
  77             if (-f $nm) {
  78                 print "wait $nm\n" unless $quiet;
  79                 return 1;
  80             }
  81             select(undef, undef, undef, 0.1);
  82         }
  83         die "wait $nm: timeout after ".(time()-$start-1)." seconds\n";
  84     }
  85
  86     # Show the output after sleeping
  87     if ($op eq 'sleep') {
  88         sleep($nm);
  89         print "sleep $nm\n" unless $quiet;
  90         return 1;
  91     }
  92
  93     if ($op eq 'fail') {
  94         print "fail $nm\n";
  95         exit($nm);
  96     }
  97
  98     die("Invalid command: $op $nm\n");
  99 }
 100
 101 if (@ARGV && $ARGV[0] eq '-q') {
 102     $quiet = 1;
 103     shift;
 104 }
 105
 106 while (@ARGV) {
 107     if (op($ARGV[0], $ARGV[1])) {
 108         shift;
 109         shift;
 110     }
 111 }
 112
 113 exit(0);