apache2/t/run-unit-tests.pl.in

   1 #!@PERL@
   2 #
   3 # Run unit tests.
   4 #
   5 # Syntax:
   6 #          All: run-tests.pl
   7 #     All in file: run-tests.pl file
   8 #     Nth in file: run-tests.pl file N
   9 #
  10 use strict;
  11 use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
  12 use File::Basename qw(basename dirname);
  13 use FileHandle;
  14 use IPC::Open2 qw(open2);
  15
  16 my @TYPES = qw(tfn op action);
  17 my $TEST = "./msc_test";
  18 my $SCRIPT = basename($0);
  19 my $SCRIPTDIR = dirname($0);
  20 my $PASSED = 0;
  21 my $TOTAL = 0;
  22 my $DEBUG = $ENV{MSC_TEST_DEBUG} || 0;
  23
  24 if (defined $ARGV[0]) {
  25     runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]);
  26     done();
  27 }
  28
  29 for my $type (sort @TYPES) {
  30     my $dir = "$SCRIPTDIR/$type";
  31     my @cfg = ();
  32
  33     # Get test names
  34     opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!");
  35     @cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR);
  36     closedir(DIR);
  37
  38     for my $cfg (sort @cfg) {
  39         runfile($dir, $cfg);
  40     }
  41
  42 }
  43 done();
  44
  45
  46 sub runfile {
  47     my($dir, $cfg, $testnum) = @_;
  48     my $fn = "$dir/$cfg";
  49     my @data = ();
  50     my $edata;
  51     my @C = ();
  52     my @test = ();
  53     my $teststr;
  54     my $n = 0;
  55     my $pass = 0;
  56
  57     open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!");
  58     @data = <CFG>;
  59
  60     $edata = q/@C = (/ . join("", @data) . q/)/;
  61     eval $edata;
  62     quit(1, "Failed to read test data \"$cfg\": $@") if ($@);
  63
  64     unless (@C) {
  65         msg("\nNo tests defined for $fn");
  66         return;
  67     }
  68
  69     msg("\nLoaded ".@C." tests from $fn");
  70     for my $t (@C) {
  71         $n++;
  72         next if (defined $testnum and $n != $testnum);
  73
  74         my %t = %{$t || {}};
  75         my $id = sprintf("%6d", $n);
  76         my $in = (exists($t{input}) and defined($t{input})) ? $t{input} : "";
  77         my $out;
  78         my $test_in = new FileHandle();
  79         my $test_out = new FileHandle();
  80         my $test_pid;
  81         my $rc = 0;
  82         my $param;
  83
  84         if ($t{type} eq "tfn") {
  85             $param = escape($t{output});
  86         }
  87         elsif ($t{type} eq "op") {
  88             $param = escape($t{param});
  89         }
  90         elsif ($t{type} eq "action") {
  91             $param = escape($t{param});
  92         }
  93         else {
  94             quit(1, "Unknown type \"$t{type}\" - should be one of: " . join(",",@TYPES));
  95         }
  96
  97         @test = ("-t", $t{type}, "-n", $t{name}, "-p", $param, "-D", "$DEBUG", (exists($t{ret}) ? ("-r", $t{ret}) : ()), (exists($t{iterations}) ? ("-I", $t{iterations}) : ()), (exists($t{prerun}) ? ("-P", $t{prerun}) : ()));
  98         $teststr = "$TEST " . join(" ", map { "\"$_\"" } @test);
  99         $test_pid = open2($test_out, $test_in, $TEST, @test) or quit(1, "Failed to execute test: $teststr\": $!");
 100         print $test_in "$in";
 101         close $test_in;
 102         $out = join("\\n", split(/\n/, <$test_out>));
 103         close $test_out;
 104         waitpid($test_pid, 0);
 105
 106         $rc = $?;
 107         if ( WIFEXITED($rc) ) {
 108             $rc = WEXITSTATUS($rc);
 109         }
 110         elsif( WIFSIGNALED($rc) ) {
 111             msg("Test exited with signal " . WTERMSIG($rc) . ".");
 112             msg("Executed: $teststr");
 113             $rc = -1;
 114         }
 115         else {
 116             msg("Test exited with unknown error.");
 117             $rc = -1;
 118         }
 119
 120         if ($rc == 0) {
 121             $pass++;
 122         }
 123
 124         msg(sprintf("%s) %s \"%s\"%s: %s%s", $id, $t{type}, $t{name}, (exists($t{comment}) ? " $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : "")));
 125
 126     }
 127
 128     $TOTAL += $testnum ? 1 : $n;
 129     $PASSED += $pass;
 130
 131     msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass)));
 132 }
 133
 134 sub escape {
 135     my @new = ();
 136     for my $c (split(//, $_[0])) {
 137         push @new, ((ord($c) >= 0x20 and ord($c) <= 0x7e) ? $c : sprintf("\\x%02x", ord($c)));
 138     }
 139     join('', @new);
 140 }
 141
 142 sub msg {
 143     print STDOUT "@_\n" if (@_);
 144 }
 145
 146 sub quit {
 147     my($ec,$msg) = @_;
 148     $ec = 0 unless (defined $_[0]);
 149
 150     msg("$msg") if (defined $msg);
 151
 152     exit $ec;
 153 }
 154
 155 sub done {
 156     if ($PASSED != $TOTAL) {
 157         quit(1, "\n$PASSED/$TOTAL tests passed.");
 158     }
 159
 160     quit(0, "\nAll tests passed ($TOTAL).");
 161 }