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

   1 #!/usr/bin/env perl
   2
   3 #
   4 # Were we told where to find tcpdump?
   5 #
   6 if (!($TCPDUMP = $ENV{TCPDUMP_BIN})) {
   7     #
   8     # No.  Use the appropriate path.
   9     #
  10     if ($^O eq 'MSWin32') {
  11         #
  12         # XXX - assume, for now, a Visual Studio debug build, so that
  13         # tcpdump is in the Debug subdirectory.
  14         #
  15         $TCPDUMP = "Debug\\tcpdump"
  16     } else {
  17         $TCPDUMP = "./tcpdump"
  18     }
  19 }
  20
  21 use File::Basename;
  22 use POSIX qw( WEXITSTATUS WIFEXITED);
  23 use Cwd qw(abs_path getcwd);
  24 use File::Path qw(mkpath);   # mkpath works with ancient perl, as well as newer perl
  25 use File::Spec;
  26 use Data::Dumper;            # for debugging.
  27
  28 # these are created in the directory where we are run, which might be
  29 # a build directory.
  30 my $newdir = "tests/NEW";
  31 my $diffdir= "tests/DIFF";
  32 mkpath($newdir);
  33 mkpath($diffdir);
  34 my $origdir = getcwd();
  35 my $srcdir  = $ENV{'srcdir'} || ".";
  36
  37 #
  38 # Force UTC, so time stamps are printed in a standard time zone, and
  39 # tests don't have to be run in the time zone in which the output
  40 # file was generated.
  41 #
  42 $ENV{'TZ'}='GMT0';
  43
  44 #
  45 # Get the tests directory from $0.
  46 #
  47 my $testsdir = dirname($0);
  48
  49 #
  50 # Convert it to an absolute path, so it works even after we do a cd.
  51 #
  52 $testsdir = abs_path($testsdir);
  53 print "Running tests from ${testsdir}\n";
  54
  55 unshift(@INC, $testsdir);
  56
  57 $passedcount = 0;
  58 $failedcount = 0;
  59 #
  60 my $failureoutput=$origdir . "/tests/failure-outputs.txt";
  61
  62 # truncate the output file
  63 open(FAILUREOUTPUT, ">" . $failureoutput);
  64 close(FAILUREOUTPUT);
  65
  66 $confighhash = undef;
  67
  68 sub showfile {
  69     local($path) = @_;
  70
  71     #
  72     # XXX - just do this directly in Perl?
  73     #
  74     if ($^O eq 'MSWin32') {
  75         my $winpath = File::Spec->canonpath($path);
  76         system "type $winpath";
  77     } else {
  78         system "cat $path";
  79     }
  80 }
  81
  82 sub runtest {
  83     local($name, $input, $output, $options) = @_;
  84     my $r;
  85
  86     $outputbase = basename($output);
  87     my $coredump = false;
  88     my $status = 0;
  89     my $linecount = 0;
  90     my $rawstderrlog = "tests/NEW/${outputbase}.raw.stderr";
  91     my $stderrlog = "tests/NEW/${outputbase}.stderr";
  92     my $diffstat = 0;
  93     my $errdiffstat = 0;
  94
  95     # we used to do this as a nice pipeline, but the problem is that $r fails to
  96     # to be set properly if the tcpdump core dumps.
  97     #
  98     # Furthermore, on Windows, fc can't read the standard input, so we
  99     # can't do it as a pipeline in any case.
 100     $r = system "$TCPDUMP -# -n -r $input $options >tests/NEW/${outputbase} 2>${rawstderrlog}";
 101     if($r == -1) {
 102         # failed to start due to error.
 103         $status = $!;
 104     }
 105     if($r != 0) {
 106         $coredump = false;
 107         $status = 0;
 108         #
 109         # Something other than "tcpdump opened the file, read it, and
 110         # dissected all the packets".  What happened?
 111         #
 112         # We write out an exit status after whatever the subprocess
 113         # wrote out, so it shows up when we diff the expected output
 114         # with it.
 115         #
 116         open(OUTPUT, ">>"."tests/NEW/$outputbase") || die "fail to open $outputbase\n";
 117         if( $r & 128 ) {
 118             $coredump = $r & 127;
 119         }
 120         if( WIFEXITED($r)) {
 121             $status = WEXITSTATUS($r);
 122         }
 123
 124         if($coredump || $status) {
 125             printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
 126         } else {
 127             printf OUTPUT "EXIT CODE %08x\n", $r;
 128         }
 129         close(OUTPUT);
 130         $r = 0;
 131     }
 132     if($r == 0) {
 133         #
 134         # Compare tcpdump's output with what we think it should be.
 135         # If tcpdump failed to produce output, we've produced our own
 136         # "output" above, with the exit status.
 137         #
 138         if ($^O eq 'MSWin32') {
 139             my $winoutput = File::Spec->canonpath($output);
 140             $r = system "fc /lb1000 /t /1 $winoutput tests\\NEW\\$outputbase >tests\\DIFF\\$outputbase.diff";
 141         } else {
 142             $r = system "diff $output tests/NEW/$outputbase >tests/DIFF/$outputbase.diff";
 143         }
 144         $diffstat = WEXITSTATUS($r);
 145     }
 146
 147     # process the standard error file, sanitize "reading from" line,
 148     # and count lines
 149     $linecount = 0;
 150     open(ERRORRAW, "<" . $rawstderrlog);
 151     open(ERROROUT, ">" . $stderrlog);
 152     while(<ERRORRAW>) {
 153         next if /^$/;  # blank lines are boring
 154         if(/^(reading from file )(.*)(,.*)$/) {
 155             my $filename = basename($2);
 156             print ERROROUT "${1}${filename}${3}\n";
 157             next;
 158         }
 159         print ERROROUT;
 160         $linecount++;
 161     }
 162     close(ERROROUT);
 163     close(ERRORRAW);
 164
 165     if ( -f "$output.stderr" ) {
 166         #
 167         # Compare the standard error with what we think it should be.
 168         #
 169         if ($^O eq 'MSWin32') {
 170             my $winoutput = File::Spec->canonpath($output);
 171             my $canonstderrlog = File::Spec->canonpath($stderrlog);
 172             $nr = system "fc /lb1000 /t /1 $winoutput.stderr $canonstderrlog >tests\DIFF\$outputbase.stderr.diff";
 173         } else {
 174             $nr = system "diff $output.stderr $stderrlog >tests/DIFF/$outputbase.stderr.diff";
 175         }
 176         if($r == 0) {
 177             $r = $nr;
 178         }
 179         $errdiffstat = WEXITSTATUS($nr);
 180     }
 181
 182     if($r == 0) {
 183         if($linecount == 0 && $status == 0) {
 184             unlink($stderrlog);
 185         } else {
 186             $errdiffstat = 1;
 187         }
 188     }
 189
 190     #print sprintf("END: %08x\n", $r);
 191
 192     if($r == 0) {
 193         if($linecount == 0) {
 194             printf "    %-40s: passed\n", $name;
 195         } else {
 196             printf "    %-40s: passed with error messages:\n", $name;
 197             showfile($stderrlog);
 198         }
 199         unlink "tests/DIFF/$outputbase.diff";
 200         return 0;
 201     }
 202     # must have failed!
 203     printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
 204     open FOUT, '>>tests/failure-outputs.txt';
 205     printf FOUT "\nFailed test: $name\n\n";
 206     close FOUT;
 207     if(-f "tests/DIFF/$outputbase.diff") {
 208         #
 209         # XXX - just do this directly in Perl?
 210         #
 211         if ($^O eq 'MSWin32') {
 212             system "type tests\\DIFF\\$outputbase.diff >> tests\\failure-outputs.txt";
 213         } else {
 214             system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt";
 215         }
 216     }
 217
 218     if($r == -1) {
 219         print " (failed to execute: $!)\n";
 220         return(30);
 221     }
 222
 223     # this is not working right, $r == 0x8b00 when there is a core dump.
 224     # clearly, we need some platform specific perl magic to take this apart, so look for "core"
 225     # too.
 226     # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
 227     # a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
 228     if($r & 127 || -f "core") {
 229         my $with = ($r & 128) ? 'with' : 'without';
 230         if(-f "core") {
 231             $with = "with";
 232         }
 233         printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
 234         if($linecount == 0) {
 235             print "\n";
 236         } else {
 237             print " with error messages:\n";
 238             showfile($stderrlog);
 239         }
 240         return(($r & 128) ? 10 : 20);
 241     }
 242     if($linecount == 0) {
 243         print "\n";
 244     } else {
 245         print " with error messages:\n";
 246         showfile($stderrlog);
 247     }
 248     return(5);
 249 }
 250
 251 sub loadconfighash {
 252     if(defined($confighhash)) {
 253         return $confighhash;
 254     }
 255
 256     $main::confighhash = {};
 257
 258     # this could be loaded once perhaps.
 259     open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
 260     while(<CONFIG_H>) {
 261         chomp;
 262         if(/^\#define (.*) 1/) {
 263             #print "Setting $1\n";
 264             $main::confighhash->{$1} = 1;
 265         }
 266     }
 267     close(CONFIG_H);
 268     #print Dumper($main::confighhash);
 269
 270     # also run tcpdump --fp-type to get the type of floating-point
 271     # arithmetic we're doing, setting a HAVE_{fptype} key based
 272     # on the value it prints
 273     open(FPTYPE_PIPE, "$TCPDUMP --fp-type |") or die("piping tcpdump --fp-type failed\n");
 274     my $fptype_val = <FPTYPE_PIPE>;
 275     close(FPTYPE_PIPE);
 276     my $have_fptype;
 277     if($fptype_val == "9877.895") {
 278         $have_fptype = "HAVE_FPTYPE1";
 279     } else {
 280         $have_fptype = "HAVE_FPTYPE2";
 281     }
 282     $main::confighhash->{$have_fptype} = 1;
 283
 284     return $main::confighhash;
 285 }
 286
 287
 288 sub runOneComplexTest {
 289     local($testconfig) = @_;
 290
 291     my $output = $testconfig->{output};
 292     my $input  = $testconfig->{input};
 293     my $name   = $testconfig->{name};
 294     my $options= $testconfig->{args};
 295     my $foundit = 1;
 296     my $unfoundit=1;
 297
 298     my $configset = $testconfig->{config_set};
 299     my $configunset = $testconfig->{config_unset};
 300     my $ch = loadconfighash();
 301     #print Dumper($ch);
 302
 303     if(defined($configset)) {
 304         $foundit = ($ch->{$configset} == 1);
 305     }
 306     if(defined($configunset)) {
 307         $unfoundit=($ch->{$configunset} != 1);
 308     }
 309
 310     if(!$foundit) {
 311         printf "    %-40s: skipped (%s not set)\n", $name, $configset;
 312         return 0;
 313     }
 314
 315     if(!$unfoundit) {
 316         printf "    %-40s: skipped (%s set)\n", $name, $configunset;
 317         return 0;
 318     }
 319
 320     #use Data::Dumper;
 321     #print Dumper($testconfig);
 322
 323     # EXPAND any occurances of @TESTDIR@ to $testsdir
 324     $options =~ s/\@TESTDIR\@/$testsdir/;
 325
 326     my $result = runtest($name,
 327                          $testsdir . "/" . $input,
 328                          $testsdir . "/" . $output,
 329                          $options);
 330
 331     if($result == 0) {
 332         $passedcount++;
 333     } else {
 334         $failedcount++;
 335     }
 336 }
 337
 338 # *.tests files are PERL hash definitions.  They should create an array of hashes
 339 # one per test, and place it into the variable @testlist.
 340 sub runComplexTests {
 341     my @files = glob( $testsdir . '/*.tests' );
 342     foreach $file (@files) {
 343         my @testlist = undef;
 344         my $definitions;
 345         print "FILE: ${file}\n";
 346         open(FILE, "<".$file) || die "can not open $file: $!";
 347         {
 348             local $/ = undef;
 349             $definitions = <FILE>;
 350         }
 351         close(FILE);
 352         #print "STUFF: ${definitions}\n";
 353         eval $definitions;
 354         if(defined($testlist)) {
 355             #use Data::Dumper;
 356             #print Dumper($testlist);
 357             foreach $test (@$testlist) {
 358                 runOneComplexTest($test);
 359             }
 360         } else {
 361             warn "File: ${file} could not be loaded as PERL: $!";
 362         }
 363     }
 364 }
 365
 366 sub runSimpleTests {
 367
 368     local($only)=@_;
 369
 370     open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
 371     while(<TESTLIST>) {
 372         next if /^\#/;
 373         next if /^$/;
 374
 375         unlink("core");
 376         ($name, $input, $output, @options) = split;
 377         #print "processing ${only} vs ${name}\n";
 378         next if(defined($only) && $only ne $name);
 379
 380         my $options = join(" ", @options);
 381         #print "@{options} becomes ${options}\n";
 382
 383         my $hash = { name => $name,
 384                      input=> $input,
 385                      output=>$output,
 386                      args => $options };
 387
 388         runOneComplexTest($hash);
 389     }
 390 }
 391
 392 if(scalar(@ARGV) == 0) {
 393     runSimpleTests();
 394     runComplexTests();
 395 } else {
 396     runSimpleTests($ARGV[0]);
 397 }
 398
 399 # exit with number of failing tests.
 400 print "------------------------------------------------\n";
 401 printf("%4u tests failed\n",$failedcount);
 402 printf("%4u tests passed\n",$passedcount);
 403
 404 showfile(${failureoutput});
 405 exit $failedcount;