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
  40 $passedcount = 0;
  41 $failedcount = 0;
  42 #
  43 my $failureoutput=$origdir . "/tests/failure-outputs.txt";
  44
  45 # truncate the output file
  46 open(FAILUREOUTPUT, ">" . $failureoutput);
  47 close(FAILUREOUTPUT);
  48
  49 $confighhash = undef;
  50
  51 sub runtest {
  52     local($name, $input, $output, $options) = @_;
  53     my $r;
  54
  55     $outputbase = basename($output);
  56     my $coredump = false;
  57     my $status = 0;
  58     my $linecount = 0;
  59     my $rawstderrlog = "tests/NEW/${outputbase}.raw.stderr";
  60     my $stderrlog = "tests/NEW/${outputbase}.stderr";
  61     my $diffstat = 0;
  62     my $errdiffstat = 0;
  63
  64     if ($^O eq 'MSWin32') {
  65         $r = system "..\\windump -# -n -r $input $options 2>NUL | sed 's/\\r//' | tee tests/NEW/$outputbase | diff $output - >tests/DIFF/$outputbase.diff";
  66         # need to do same as below for Cygwin.
  67     }
  68     else {
  69         # we used to do this as a nice pipeline, but the problem is that $r fails to
  70         # to be set properly if the tcpdump core dumps.
  71         $r = system "$TCPDUMP 2>${rawstderrlog} -# -n -r $input $options >tests/NEW/${outputbase}";
  72         if($r == -1) {
  73             # failed to start due to error.
  74             $status = $!;
  75         }
  76         if($r != 0) {
  77             $coredump = false;
  78             $status = 0;
  79             # this means tcpdump failed.
  80             open(OUTPUT, ">>"."tests/NEW/$outputbase") || die "fail to open $outputbase\n";
  81             if( $r & 128 ) {
  82                 $coredump = $r & 127;
  83             }
  84             if( WIFEXITED($r)) {
  85                 $status = WEXITSTATUS($r);
  86             }
  87
  88             if($coredump || $status) {
  89                 printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
  90             } else {
  91                 printf OUTPUT "EXIT CODE %08x\n", $r;
  92             }
  93             close(OUTPUT);
  94             $r = 0;
  95         }
  96         if($r == 0) {
  97             $r = system "cat tests/NEW/$outputbase | diff $output - >tests/DIFF/$outputbase.diff";
  98             $diffstat = WEXITSTATUS($r);
  99         }
 100
 101         # process the file, sanitize "reading from" line, and count lines
 102         $linecount = 0;
 103         open(ERRORRAW, "<" . $rawstderrlog);
 104         open(ERROROUT, ">" . $stderrlog);
 105         while(<ERRORRAW>) {
 106             next if /^$/;  # blank lines are boring
 107             if(/^(reading from file )(.*)(,.*)$/) {
 108                 my $filename = basename($2);
 109                 print ERROROUT "${1}${filename}${3}\n";
 110                 next;
 111             }
 112             print ERROROUT;
 113             $linecount++;
 114         }
 115         close(ERROROUT);
 116         close(ERRORRAW);
 117
 118         if ( -f "$output.stderr" ) {
 119             $nr = system "cat $stderrlog | diff $output.stderr - >tests/DIFF/$outputbase.stderr.diff";
 120             if($r == 0) {
 121                 $r = $nr;
 122             }
 123             $errdiffstat = WEXITSTATUS($nr);
 124         }
 125
 126         if($r == 0) {
 127             if($linecount == 0 && $status == 0) {
 128                 unlink($stderrlog);
 129             } else {
 130                 $errdiffstat = 1;
 131             }
 132         }
 133
 134         #print sprintf("END: %08x\n", $r);
 135     }
 136
 137     if($r == 0) {
 138         if($linecount == 0) {
 139             printf "    %-40s: passed\n", $name;
 140         } else {
 141             printf "    %-40s: passed with error messages:\n", $name;
 142             system "cat $stderrlog";
 143         }
 144         unlink "tests/DIFF/$outputbase.diff";
 145         return 0;
 146     }
 147     # must have failed!
 148     printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
 149     open FOUT, '>>tests/failure-outputs.txt';
 150     printf FOUT "\nFailed test: $name\n\n";
 151     close FOUT;
 152     if(-f "tests/DIFF/$outputbase.diff") {
 153         system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt";
 154     }
 155
 156     if($r == -1) {
 157         print " (failed to execute: $!)\n";
 158         return(30);
 159     }
 160
 161     # this is not working right, $r == 0x8b00 when there is a core dump.
 162     # clearly, we need some platform specific perl magic to take this apart, so look for "core"
 163     # too.
 164     # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
 165     # a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
 166     if($r & 127 || -f "core") {
 167         my $with = ($r & 128) ? 'with' : 'without';
 168         if(-f "core") {
 169             $with = "with";
 170         }
 171         printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
 172         if($linecount == 0) {
 173             print "\n";
 174         } else {
 175             print " with error messages:\n";
 176             system "cat $stderrlog";
 177         }
 178         return(($r & 128) ? 10 : 20);
 179     }
 180     if($linecount == 0) {
 181         print "\n";
 182     } else {
 183         print " with error messages:\n";
 184         system "cat $stderrlog";
 185     }
 186 }
 187
 188 sub loadconfighash {
 189     if(defined($confighhash)) {
 190         return $confighhash;
 191     }
 192
 193     $main::confighhash = {};
 194
 195     # this could be loaded once perhaps.
 196     open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
 197     while(<CONFIG_H>) {
 198         chomp;
 199         if(/^\#define (.*) 1/) {
 200             #print "Setting $1\n";
 201             $main::confighhash->{$1} = 1;
 202         }
 203     }
 204     close(CONFIG_H);
 205     #print Dumper($main::confighhash);
 206
 207     # also run tcpdump --fp-type to get the type of floating-point
 208     # arithmetic we're doing, setting a HAVE_{fptype} key based
 209     # on the value it prints
 210     open(FPTYPE_PIPE, "./tcpdump --fp-type |") or die("piping tcpdump --fp-type failed\n");
 211     my $fptype_val = <FPTYPE_PIPE>;
 212     close(FPTYPE_PIPE);
 213     my $have_fptype;
 214     if($fptype_val == "9877.895") {
 215         $have_fptype = "HAVE_FPTYPE1";
 216     } else {
 217         $have_fptype = "HAVE_FPTYPE2";
 218     }
 219     $main::confighhash->{$have_fptype} = 1;
 220
 221     return $main::confighhash;
 222 }
 223
 224
 225 sub runOneComplexTest {
 226     local($testconfig) = @_;
 227
 228     my $output = $testconfig->{output};
 229     my $input  = $testconfig->{input};
 230     my $name   = $testconfig->{name};
 231     my $options= $testconfig->{args};
 232     my $foundit = 1;
 233     my $unfoundit=1;
 234
 235     my $configset = $testconfig->{config_set};
 236     my $configunset = $testconfig->{config_unset};
 237     my $ch = loadconfighash();
 238     #print Dumper($ch);
 239
 240     if(defined($configset)) {
 241         $foundit = ($ch->{$configset} == 1);
 242     }
 243     if(defined($configunset)) {
 244         $unfoundit=($ch->{$configunset} != 1);
 245     }
 246
 247     if(!$foundit) {
 248         printf "    %-40s: skipped (%s not set)\n", $name, $configset;
 249         return 0;
 250     }
 251
 252     if(!$unfoundit) {
 253         printf "    %-40s: skipped (%s set)\n", $name, $configunset;
 254         return 0;
 255     }
 256
 257     #use Data::Dumper;
 258     #print Dumper($testconfig);
 259
 260     # EXPAND any occurances of @TESTDIR@ to $testsdir
 261     $options =~ s/\@TESTDIR\@/$testsdir/;
 262
 263     my $result = runtest($name,
 264                          $testsdir . "/" . $input,
 265                          $testsdir . "/" . $output,
 266                          $options);
 267
 268     if($result == 0) {
 269         $passedcount++;
 270     } else {
 271         $failedcount++;
 272     }
 273 }
 274
 275 # *.tests files are PERL hash definitions.  They should create an array of hashes
 276 # one per test, and place it into the variable @testlist.
 277 sub runComplexTests {
 278     my @files = glob( $testsdir . '/*.tests' );
 279     foreach $file (@files) {
 280         my @testlist = undef;
 281         my $definitions;
 282         print "FILE: ${file}\n";
 283         open(FILE, "<".$file) || die "can not open $file: $!";
 284         {
 285             local $/ = undef;
 286             $definitions = <FILE>;
 287         }
 288         close(FILE);
 289         #print "STUFF: ${definitions}\n";
 290         eval $definitions;
 291         if(defined($testlist)) {
 292             #use Data::Dumper;
 293             #print Dumper($testlist);
 294             foreach $test (@$testlist) {
 295                 runOneComplexTest($test);
 296             }
 297         } else {
 298             warn "File: ${file} could not be loaded as PERL: $!";
 299         }
 300     }
 301 }
 302
 303 sub runSimpleTests {
 304
 305     local($only)=@_;
 306
 307     open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
 308     while(<TESTLIST>) {
 309         next if /^\#/;
 310         next if /^$/;
 311
 312         unlink("core");
 313         ($name, $input, $output, @options) = split;
 314         #print "processing ${only} vs ${name}\n";
 315         next if(defined($only) && $only ne $name);
 316
 317         my $options = join(" ", @options);
 318         #print "@{options} becomes ${options}\n";
 319
 320         my $hash = { name => $name,
 321                      input=> $input,
 322                      output=>$output,
 323                      args => $options };
 324
 325         runOneComplexTest($hash);
 326     }
 327 }
 328
 329 if(scalar(@ARGV) == 0) {
 330     runSimpleTests();
 331     runComplexTests();
 332 } else {
 333     runSimpleTests($ARGV[0]);
 334 }
 335
 336 # exit with number of failing tests.
 337 print "------------------------------------------------\n";
 338 printf("%4u tests failed\n",$failedcount);
 339 printf("%4u tests passed\n",$passedcount);
 340
 341 system("cat ${failureoutput}");
 342 exit $failedcount;