The Tcpdump Group git mirrors - tcpdump/blob - tests/TESTrun

   1 #!/usr/bin/env perl
   2
   3 $TCPDUMP = "./tcpdump" if (!($TCPDUMP = $ENV{TCPDUMP_BIN}));
   4
   5 use File::Basename;
   6 use POSIX qw( WEXITSTATUS WIFEXITED);
   7 use Cwd qw(abs_path getcwd);
   8 use File::Path qw(mkpath);   # mkpath works with ancient perl, as well as newer perl
   9 use Data::Dumper;            # for debugging.
  10
  11 # these are created in the directory where we are run, which might be
  12 # a build directory.
  13 my $newdir = "tests/NEW";
  14 my $diffdir= "tests/DIFF";
  15 mkpath($newdir);
  16 mkpath($diffdir);
  17 my $origdir = getcwd();
  18 my $srcdir  = $ENV{'srcdir'} || ".";
  19
  20 #
  21 # Force UTC, so time stamps are printed in a standard time zone, and
  22 # tests don't have to be run in the time zone in which the output
  23 # file was generated.
  24 #
  25 $ENV{'TZ'}='GMT0';
  26
  27 #
  28 # Get the tests directory from $0.
  29 #
  30 my $testsdir = dirname($0);
  31
  32 #
  33 # Convert it to an absolute path, so it works even after we do a cd.
  34 #
  35 $testsdir = abs_path($testsdir);
  36 print "Running tests from ${testsdir}\n";
  37
  38 unshift(@INC, $testsdir);
  39 require 'testfuncs.pm';
  40
  41 $passedcount = 0;
  42 $failedcount = 0;
  43 #
  44 # XXX - create files used by shell scripts; we can remove this once we
  45 # no longer use shell scripts in tests.
  46 #
  47 open(PASSEDCOUNT, ">", "tests/.passed");
  48 print PASSEDCOUNT "${passedcount}\n";
  49 close(PASSEDCOUNT);
  50 open(FAILEDCOUNT, ">", "tests/.failed");
  51 print FAILEDCOUNT "${failedcount}\n";
  52 close(FAILEDCOUNT);
  53 my $failureoutput=$origdir . "/tests/failure-outputs.txt";
  54
  55 # truncate the output file
  56 open(FAILUREOUTPUT, ">" . $failureoutput);
  57 close(FAILUREOUTPUT);
  58
  59 sub runShellTests {
  60
  61     my @files = glob( $testsdir . '/*.sh' );
  62     foreach $file (@files) {
  63         if($file =~ /TEST.*\.sh/) {
  64             print "File $file, skipped\n";
  65             next;
  66         }
  67
  68         print "Running $file\n";
  69         system("cd tests && sh $file ${srcdir}")
  70     }
  71
  72     # have to update passed/failed here
  73 }
  74
  75 $confighhash = undef;
  76
  77 sub loadconfighash {
  78     if(defined($confighhash)) {
  79         return $confighhash;
  80     }
  81
  82     $main::confighhash = {};
  83
  84     # this could be loaded once perhaps.
  85     open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
  86     while(<CONFIG_H>) {
  87         chomp;
  88         if(/^\#define (.*) 1/) {
  89             #print "Setting $1\n";
  90             $main::confighhash->{$1} = 1;
  91         }
  92     }
  93     close(CONFIG_H);
  94     #print Dumper($main::confighhash);
  95
  96     # also grovel Makefile for some things and pretend they are config options.
  97     open(MAKEFILE, "Makefile") || die "can not open Makefile: $!\n";
  98     while(<MAKEFILE>) {
  99         chomp;
 100         #print "Processing $_\n";
 101         if(/^CC\s*=.*gcc.*/) {
 102             #print "GCC FOUND\n";
 103             $main::confighhash->{'USING_GCC'} = 1;
 104         }
 105     }
 106     close(MAKEFILE);
 107
 108     return $main::confighhash;
 109 }
 110
 111
 112 sub runOneComplexTest {
 113     local($testconfig) = @_;
 114
 115     my $output = $testconfig->{output};
 116     my $input  = $testconfig->{input};
 117     my $name   = $testconfig->{name};
 118     my $options= $testconfig->{args};
 119     my $foundit = 1;
 120     my $unfoundit=1;
 121
 122     my $configset = $testconfig->{config_set};
 123     my $configunset = $testconfig->{config_unset};
 124     my $ch = loadconfighash();
 125     #print Dumper($ch);
 126
 127     if(defined($configset)) {
 128         $foundit = ($ch->{$configset} == 1);
 129     }
 130     if(defined($configunset)) {
 131         $unfoundit=($ch->{$configunset} != 1);
 132     }
 133
 134     if(!$foundit) {
 135         print "${name} ... skipped, no ${configset}\n";
 136         return 0;
 137     }
 138
 139     if(!$unfoundit) {
 140         print "${name} ... skipped, ${configunset} is set\n";
 141         return 0;
 142     }
 143
 144     #use Data::Dumper;
 145     #print Dumper($testconfig);
 146
 147     # EXPAND any occurances of @TESTDIR@ to $testsdir
 148     $options =~ s/\@TESTDIR\@/$testsdir/;
 149
 150     my $result = runtest($name,
 151                          $testsdir . "/" . $input,
 152                          $testsdir . "/" . $output,
 153                          $options);
 154
 155     if($result == 0) {
 156         $passedcount++;
 157     } else {
 158         $failedcount++;
 159     }
 160 }
 161
 162 # *.tests files are PERL hash definitions.  They should create an array of hashes
 163 # one per test, and place it into the variable @testlist.
 164 sub runComplexTests {
 165     my @files = glob( $testsdir . '/*.tests' );
 166     foreach $file (@files) {
 167         my @testlist = undef;
 168         my $definitions;
 169         print "FILE: ${file}\n";
 170         open(FILE, "<".$file) || die "can not open $file: $!";
 171         {
 172             local $/ = undef;
 173             $definitions = <FILE>;
 174         }
 175         close(FILE);
 176         #print "STUFF: ${definitions}\n";
 177         eval $definitions;
 178         if(defined($testlist)) {
 179             #use Data::Dumper;
 180             #print Dumper($testlist);
 181             foreach $test (@$testlist) {
 182                 runOneComplexTest($test);
 183             }
 184         } else {
 185             warn "File: ${file} could not be loaded as PERL: $!";
 186         }
 187     }
 188 }
 189
 190 sub runSimpleTests {
 191
 192     local($only)=@_;
 193
 194     open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
 195     while(<TESTLIST>) {
 196         next if /^\#/;
 197         next if /^$/;
 198
 199         unlink("core");
 200         ($name, $input, $output, @options) = split;
 201         #print "processing ${only} vs ${name}\n";
 202         next if(defined($only) && $only ne $name);
 203
 204         my $options = join(" ", @options);
 205         #print "@{options} becomes ${options}\n";
 206
 207         my $hash = { name => $name,
 208                      input=> $input,
 209                      output=>$output,
 210                      args => $options };
 211
 212         runOneComplexTest($hash);
 213     }
 214 }
 215
 216 if(scalar(@ARGV) == 0) {
 217     #runShellTests();
 218     #runSimpleTests();
 219     runComplexTests();
 220 } else {
 221     runSimpleTests($ARGV[0]);
 222 }
 223
 224 #
 225 # XXX - read files used by shell scripts, and add the passed and failed
 226 # counts reported therein to our own passed and failed counts; we can
 227 # remove this once we no longer use shell scripts in tests.
 228 #
 229 open(PASSEDCOUNT, "<", "tests/.passed");
 230 $passedcount += <PASSEDCOUNT>;
 231 close(PASSEDCOUNT);
 232 open(FAILEDCOUNT, ">", "tests/.failed");
 233 $failedcount += <FAILEDCOUNT>;
 234 close(FAILEDCOUNT);
 235
 236 # exit with number of failing tests.
 237 print "------------------------------------------------\n";
 238 printf("%4u tests failed\n",$failedcount);
 239 printf("%4u tests passed\n",$passedcount);
 240
 241 system("cat ${failureoutput}");
 242 exit $failedcount;