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     if ($^O eq 'MSWin32') {
  96         $r = system "$TCPDUMP -# -n -r $input $options 2>NUL | sed 's/\\r//' | tee tests/NEW/$outputbase | diff $output - >tests/DIFF/$outputbase.diff";
  97         # need to do same as below for Cygwin.
  98     }
  99     else {
 100         # we used to do this as a nice pipeline, but the problem is that $r fails to
 101         # to be set properly if the tcpdump core dumps.
 102         $r = system "$TCPDUMP 2>${rawstderrlog} -# -n -r $input $options >tests/NEW/${outputbase}";
 103         if($r == -1) {
 104             # failed to start due to error.
 105             $status = $!;
 106         }
 107         if($r != 0) {
 108             $coredump = false;
 109             $status = 0;
 110             # this means tcpdump failed.
 111             open(OUTPUT, ">>"."tests/NEW/$outputbase") || die "fail to open $outputbase\n";
 112             if( $r & 128 ) {
 113                 $coredump = $r & 127;
 114             }
 115             if( WIFEXITED($r)) {
 116                 $status = WEXITSTATUS($r);
 117             }
 118
 119             if($coredump || $status) {
 120                 printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
 121             } else {
 122                 printf OUTPUT "EXIT CODE %08x\n", $r;
 123             }
 124             close(OUTPUT);
 125             $r = 0;
 126         }
 127         if($r == 0) {
 128             #
 129             # Compare tcpdump's output with what we think it should be.
 130             # If tcpdump failed to produce output, we've produced our own
 131             # "output" above, with the exit status.
 132             #
 133             if ($^O eq 'MSWin32') {
 134                 my $winoutput = File::Spec->canonpath($output);
 135                 $r = system "fc/lb1000/t/1 $winoutput tests\\NEW\\$outputbase >tests\\DIFF\\$outputbase.diff";
 136             } else {
 137                 $r = system "diff $output tests/NEW/$outputbase >tests/DIFF/$outputbase.diff";
 138             }
 139             $diffstat = WEXITSTATUS($r);
 140         }
 141
 142         # process the file, sanitize "reading from" line, and count lines
 143         $linecount = 0;
 144         open(ERRORRAW, "<" . $rawstderrlog);
 145         open(ERROROUT, ">" . $stderrlog);
 146         while(<ERRORRAW>) {
 147             next if /^$/;  # blank lines are boring
 148             if(/^(reading from file )(.*)(,.*)$/) {
 149                 my $filename = basename($2);
 150                 print ERROROUT "${1}${filename}${3}\n";
 151                 next;
 152             }
 153             print ERROROUT;
 154             $linecount++;
 155         }
 156         close(ERROROUT);
 157         close(ERRORRAW);
 158
 159         if ( -f "$output.stderr" ) {
 160             #
 161             # Compare the standard error with what we think it should be.
 162             #
 163             if ($^O eq 'MSWin32') {
 164                 my $canonstderrlog = File::Spec->canonpath($stderrlog);
 165                 $nr = system "fc/lb1000/t/1 $output.stderr $canonstderrlog >tests/DIFF/$outputbase.stderr.diff";
 166             } else {
 167                 $nr = system "diff $output.stderr $stderrlog >tests/DIFF/$outputbase.stderr.diff";
 168             }
 169             if($r == 0) {
 170                 $r = $nr;
 171             }
 172             $errdiffstat = WEXITSTATUS($nr);
 173         }
 174
 175         if($r == 0) {
 176             if($linecount == 0 && $status == 0) {
 177                 unlink($stderrlog);
 178             } else {
 179                 $errdiffstat = 1;
 180             }
 181         }
 182
 183         #print sprintf("END: %08x\n", $r);
 184     }
 185
 186     if($r == 0) {
 187         if($linecount == 0) {
 188             printf "    %-40s: passed\n", $name;
 189         } else {
 190             printf "    %-40s: passed with error messages:\n", $name;
 191             showfile($stderrlog);
 192         }
 193         unlink "tests/DIFF/$outputbase.diff";
 194         return 0;
 195     }
 196     # must have failed!
 197     printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
 198     open FOUT, '>>tests/failure-outputs.txt';
 199     printf FOUT "\nFailed test: $name\n\n";
 200     close FOUT;
 201     if(-f "tests/DIFF/$outputbase.diff") {
 202         #
 203         # XXX - just do this directly in Perl?
 204         #
 205         if ($^O eq 'MSWin32') {
 206             system "type tests\\DIFF\\$outputbase.diff >> tests\\failure-outputs.txt";
 207         } else {
 208             system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt";
 209         }
 210     }
 211
 212     if($r == -1) {
 213         print " (failed to execute: $!)\n";
 214         return(30);
 215     }
 216
 217     # this is not working right, $r == 0x8b00 when there is a core dump.
 218     # clearly, we need some platform specific perl magic to take this apart, so look for "core"
 219     # too.
 220     # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
 221     # a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
 222     if($r & 127 || -f "core") {
 223         my $with = ($r & 128) ? 'with' : 'without';
 224         if(-f "core") {
 225             $with = "with";
 226         }
 227         printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
 228         if($linecount == 0) {
 229             print "\n";
 230         } else {
 231             print " with error messages:\n";
 232             showfile($stderrlog);
 233         }
 234         return(($r & 128) ? 10 : 20);
 235     }
 236     if($linecount == 0) {
 237         print "\n";
 238     } else {
 239         print " with error messages:\n";
 240         showfile($stderrlog);
 241     }
 242     return(5);
 243 }
 244
 245 sub loadconfighash {
 246     if(defined($confighhash)) {
 247         return $confighhash;
 248     }
 249
 250     $main::confighhash = {};
 251
 252     # this could be loaded once perhaps.
 253     open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
 254     while(<CONFIG_H>) {
 255         chomp;
 256         if(/^\#define (.*) 1/) {
 257             #print "Setting $1\n";
 258             $main::confighhash->{$1} = 1;
 259         }
 260     }
 261     close(CONFIG_H);
 262     #print Dumper($main::confighhash);
 263
 264     # also run tcpdump --fp-type to get the type of floating-point
 265     # arithmetic we're doing, setting a HAVE_{fptype} key based
 266     # on the value it prints
 267     open(FPTYPE_PIPE, "$TCPDUMP --fp-type |") or die("piping tcpdump --fp-type failed\n");
 268     my $fptype_val = <FPTYPE_PIPE>;
 269     close(FPTYPE_PIPE);
 270     my $have_fptype;
 271     if($fptype_val == "9877.895") {
 272         $have_fptype = "HAVE_FPTYPE1";
 273     } else {
 274         $have_fptype = "HAVE_FPTYPE2";
 275     }
 276     $main::confighhash->{$have_fptype} = 1;
 277
 278     return $main::confighhash;
 279 }
 280
 281
 282 sub runOneComplexTest {
 283     local($testconfig) = @_;
 284
 285     my $output = $testconfig->{output};
 286     my $input  = $testconfig->{input};
 287     my $name   = $testconfig->{name};
 288     my $options= $testconfig->{args};
 289     my $foundit = 1;
 290     my $unfoundit=1;
 291
 292     my $configset = $testconfig->{config_set};
 293     my $configunset = $testconfig->{config_unset};
 294     my $ch = loadconfighash();
 295     #print Dumper($ch);
 296
 297     if(defined($configset)) {
 298         $foundit = ($ch->{$configset} == 1);
 299     }
 300     if(defined($configunset)) {
 301         $unfoundit=($ch->{$configunset} != 1);
 302     }
 303
 304     if(!$foundit) {
 305         printf "    %-40s: skipped (%s not set)\n", $name, $configset;
 306         return 0;
 307     }
 308
 309     if(!$unfoundit) {
 310         printf "    %-40s: skipped (%s set)\n", $name, $configunset;
 311         return 0;
 312     }
 313
 314     #use Data::Dumper;
 315     #print Dumper($testconfig);
 316
 317     # EXPAND any occurances of @TESTDIR@ to $testsdir
 318     $options =~ s/\@TESTDIR\@/$testsdir/;
 319
 320     my $result = runtest($name,
 321                          $testsdir . "/" . $input,
 322                          $testsdir . "/" . $output,
 323                          $options);
 324
 325     if($result == 0) {
 326         $passedcount++;
 327     } else {
 328         $failedcount++;
 329     }
 330 }
 331
 332 # *.tests files are PERL hash definitions.  They should create an array of hashes
 333 # one per test, and place it into the variable @testlist.
 334 sub runComplexTests {
 335     my @files = glob( $testsdir . '/*.tests' );
 336     foreach $file (@files) {
 337         my @testlist = undef;
 338         my $definitions;
 339         print "FILE: ${file}\n";
 340         open(FILE, "<".$file) || die "can not open $file: $!";
 341         {
 342             local $/ = undef;
 343             $definitions = <FILE>;
 344         }
 345         close(FILE);
 346         #print "STUFF: ${definitions}\n";
 347         eval $definitions;
 348         if(defined($testlist)) {
 349             #use Data::Dumper;
 350             #print Dumper($testlist);
 351             foreach $test (@$testlist) {
 352                 runOneComplexTest($test);
 353             }
 354         } else {
 355             warn "File: ${file} could not be loaded as PERL: $!";
 356         }
 357     }
 358 }
 359
 360 sub runSimpleTests {
 361
 362     local($only)=@_;
 363
 364     open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
 365     while(<TESTLIST>) {
 366         next if /^\#/;
 367         next if /^$/;
 368
 369         unlink("core");
 370         ($name, $input, $output, @options) = split;
 371         #print "processing ${only} vs ${name}\n";
 372         next if(defined($only) && $only ne $name);
 373
 374         my $options = join(" ", @options);
 375         #print "@{options} becomes ${options}\n";
 376
 377         my $hash = { name => $name,
 378                      input=> $input,
 379                      output=>$output,
 380                      args => $options };
 381
 382         runOneComplexTest($hash);
 383     }
 384 }
 385
 386 if(scalar(@ARGV) == 0) {
 387     runSimpleTests();
 388     runComplexTests();
 389 } else {
 390     runSimpleTests($ARGV[0]);
 391 }
 392
 393 # exit with number of failing tests.
 394 print "------------------------------------------------\n";
 395 printf("%4u tests failed\n",$failedcount);
 396 printf("%4u tests passed\n",$passedcount);
 397
 398 showfile(${failureoutput});
 399 exit $failedcount;