tests/TESTrun - platform/external/tcpdump - Git at Google

 #!/usr/bin/env perl

 #
 # Were we told where to find tcpdump?
 #
 if (!($TCPDUMP = $ENV{TCPDUMP_BIN})) {
     #
     # No.  Use the appropriate path.
     #
     if ($^O eq 'MSWin32') {
         #
         # XXX - assume, for now, a Visual Studio debug build, so that
         # tcpdump is in the Debug subdirectory.
         #
         $TCPDUMP = "Debug\\tcpdump"
     } else {
         $TCPDUMP = "./tcpdump"
     }
 }

 use File::Basename;
 use POSIX qw( WEXITSTATUS WIFEXITED);
 use Cwd qw(abs_path getcwd);
 use File::Path qw(mkpath);   # mkpath works with ancient perl, as well as newer perl
 use File::Spec;
 use Data::Dumper;            # for debugging.

 # these are created in the directory where we are run, which might be
 # a build directory.
 my $newdir = "tests/NEW";
 my $diffdir= "tests/DIFF";
 mkpath($newdir);
 mkpath($diffdir);
 my $origdir = getcwd();
 my $srcdir  = $ENV{'srcdir'} || ".";

 #
 # Force UTC, so time stamps are printed in a standard time zone, and
 # tests don't have to be run in the time zone in which the output
 # file was generated.
 #
 $ENV{'TZ'}='GMT0';

 #
 # Get the tests directory from $0.
 #
 my $testsdir = dirname($0);

 #
 # Convert it to an absolute path, so it works even after we do a cd.
 #
 $testsdir = abs_path($testsdir);
 print "Running tests from ${testsdir}\n";

 unshift(@INC, $testsdir);

 $passedcount = 0;
 $failedcount = 0;
 #
 my $failureoutput=$origdir . "/tests/failure-outputs.txt";

 # truncate the output file
 open(FAILUREOUTPUT, ">" . $failureoutput);
 close(FAILUREOUTPUT);

 $confighhash = undef;

 sub showfile {
     local($path) = @_;

     #
     # XXX - just do this directly in Perl?
     #
     if ($^O eq 'MSWin32') {
         my $winpath = File::Spec->canonpath($path);
         system "type $winpath";
     } else {
         system "cat $path";
     }
 }

 sub runtest {
     local($name, $input, $output, $options) = @_;
     my $r;

     $outputbase = basename($output);
     my $coredump = false;
     my $status = 0;
     my $linecount = 0;
     my $rawstderrlog = "tests/NEW/${outputbase}.raw.stderr";
     my $stderrlog = "tests/NEW/${outputbase}.stderr";
     my $diffstat = 0;
     my $errdiffstat = 0;

     # we used to do this as a nice pipeline, but the problem is that $r fails to
     # to be set properly if the tcpdump core dumps.
     #
     # Furthermore, on Windows, fc can't read the standard input, so we
     # can't do it as a pipeline in any case.
     $r = system "$TCPDUMP -# -n -r $input $options >tests/NEW/${outputbase} 2>${rawstderrlog}";
     if($r == -1) {
         # failed to start due to error.
         $status = $!;
     }
     if($r != 0) {
         $coredump = false;
         $status = 0;
         #
         # Something other than "tcpdump opened the file, read it, and
         # dissected all the packets".  What happened?
         #
         # We write out an exit status after whatever the subprocess
         # wrote out, so it shows up when we diff the expected output
         # with it.
         #
         open(OUTPUT, ">>"."tests/NEW/$outputbase") || die "fail to open $outputbase\n";
         if( $r & 128 ) {
             $coredump = $r & 127;
         }
         if( WIFEXITED($r)) {
             $status = WEXITSTATUS($r);
         }

         if($coredump || $status) {
             printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
         } else {
             printf OUTPUT "EXIT CODE %08x\n", $r;
         }
         close(OUTPUT);
         $r = 0;
     }
     if($r == 0) {
         #
         # Compare tcpdump's output with what we think it should be.
         # If tcpdump failed to produce output, we've produced our own
         # "output" above, with the exit status.
         #
         if ($^O eq 'MSWin32') {
             my $winoutput = File::Spec->canonpath($output);
             $r = system "fc /lb1000 /t /1 $winoutput tests\\NEW\\$outputbase >tests\\DIFF\\$outputbase.diff";
         } else {
             $r = system "diff $output tests/NEW/$outputbase >tests/DIFF/$outputbase.diff";
         }
         $diffstat = WEXITSTATUS($r);
     }

     # process the standard error file, sanitize "reading from" line,
     # and count lines
     $linecount = 0;
     open(ERRORRAW, "<" . $rawstderrlog);
     open(ERROROUT, ">" . $stderrlog);
     while(<ERRORRAW>) {
         next if /^$/;  # blank lines are boring
         if(/^(reading from file )(.*)(,.*)$/) {
             my $filename = basename($2);
             print ERROROUT "${1}${filename}${3}\n";
             next;
         }
         print ERROROUT;
         $linecount++;
     }
     close(ERROROUT);
     close(ERRORRAW);

     if ( -f "$output.stderr" ) {
         #
         # Compare the standard error with what we think it should be.
         #
         if ($^O eq 'MSWin32') {
             my $winoutput = File::Spec->canonpath($output);
             my $canonstderrlog = File::Spec->canonpath($stderrlog);
             $nr = system "fc /lb1000 /t /1 $winoutput.stderr $canonstderrlog >tests\DIFF\$outputbase.stderr.diff";
         } else {
             $nr = system "diff $output.stderr $stderrlog >tests/DIFF/$outputbase.stderr.diff";
         }
         if($r == 0) {
             $r = $nr;
         }
         $errdiffstat = WEXITSTATUS($nr);
     }

     if($r == 0) {
         if($linecount == 0 && $status == 0) {
             unlink($stderrlog);
         } else {
             $errdiffstat = 1;
         }
     }

     #print sprintf("END: %08x\n", $r);

     if($r == 0) {
         if($linecount == 0) {
             printf "    %-40s: passed\n", $name;
         } else {
             printf "    %-40s: passed with error messages:\n", $name;
             showfile($stderrlog);
         }
         unlink "tests/DIFF/$outputbase.diff";
         return 0;
     }
     # must have failed!
     printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
     open FOUT, '>>tests/failure-outputs.txt';
     printf FOUT "\nFailed test: $name\n\n";
     close FOUT;
     if(-f "tests/DIFF/$outputbase.diff") {
         #
         # XXX - just do this directly in Perl?
         #
         if ($^O eq 'MSWin32') {
             system "type tests\\DIFF\\$outputbase.diff >> tests\\failure-outputs.txt";
         } else {
             system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt";
         }
     }

     if($r == -1) {
         print " (failed to execute: $!)\n";
         return(30);
     }

     # this is not working right, $r == 0x8b00 when there is a core dump.
     # clearly, we need some platform specific perl magic to take this apart, so look for "core"
     # too.
     # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
     # a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
     if($r & 127 || -f "core") {
         my $with = ($r & 128) ? 'with' : 'without';
         if(-f "core") {
             $with = "with";
         }
         printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
         if($linecount == 0) {
             print "\n";
         } else {
             print " with error messages:\n";
             showfile($stderrlog);
         }
         return(($r & 128) ? 10 : 20);
     }
     if($linecount == 0) {
         print "\n";
     } else {
         print " with error messages:\n";
         showfile($stderrlog);
     }
     return(5);
 }

 sub loadconfighash {
     if(defined($confighhash)) {
         return $confighhash;
     }

     $main::confighhash = {};

     # this could be loaded once perhaps.
     open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
     while(<CONFIG_H>) {
         chomp;
         if(/^\#define (.*) 1/) {
             #print "Setting $1\n";
             $main::confighhash->{$1} = 1;
         }
     }
     close(CONFIG_H);
     #print Dumper($main::confighhash);

     # also run tcpdump --fp-type to get the type of floating-point
     # arithmetic we're doing, setting a HAVE_{fptype} key based
     # on the value it prints
     open(FPTYPE_PIPE, "$TCPDUMP --fp-type |") or die("piping tcpdump --fp-type failed\n");
     my $fptype_val = <FPTYPE_PIPE>;
     close(FPTYPE_PIPE);
     my $have_fptype;
     if($fptype_val == "9877.895") {
         $have_fptype = "HAVE_FPTYPE1";
     } else {
         $have_fptype = "HAVE_FPTYPE2";
     }
     $main::confighhash->{$have_fptype} = 1;

     return $main::confighhash;
 }


 sub runOneComplexTest {
     local($testconfig) = @_;

     my $output = $testconfig->{output};
     my $input  = $testconfig->{input};
     my $name   = $testconfig->{name};
     my $options= $testconfig->{args};
     my $foundit = 1;
     my $unfoundit=1;

     my $configset = $testconfig->{config_set};
     my $configunset = $testconfig->{config_unset};
     my $ch = loadconfighash();
     #print Dumper($ch);

     if(defined($configset)) {
         $foundit = ($ch->{$configset} == 1);
     }
     if(defined($configunset)) {
         $unfoundit=($ch->{$configunset} != 1);
     }

     if(!$foundit) {
         printf "    %-40s: skipped (%s not set)\n", $name, $configset;
         return 0;
     }

     if(!$unfoundit) {
         printf "    %-40s: skipped (%s set)\n", $name, $configunset;
         return 0;
     }

     #use Data::Dumper;
     #print Dumper($testconfig);

     # EXPAND any occurances of @TESTDIR@ to $testsdir
     $options =~ s/\@TESTDIR\@/$testsdir/;

     my $result = runtest($name,
                          $testsdir . "/" . $input,
                          $testsdir . "/" . $output,
                          $options);

     if($result == 0) {
         $passedcount++;
     } else {
         $failedcount++;
     }
 }

 # *.tests files are PERL hash definitions.  They should create an array of hashes
 # one per test, and place it into the variable @testlist.
 sub runComplexTests {
     my @files = glob( $testsdir . '/*.tests' );
     foreach $file (@files) {
         my @testlist = undef;
         my $definitions;
         print "FILE: ${file}\n";
         open(FILE, "<".$file) || die "can not open $file: $!";
         {
             local $/ = undef;
             $definitions = <FILE>;
         }
         close(FILE);
         #print "STUFF: ${definitions}\n";
         eval $definitions;
         if(defined($testlist)) {
             #use Data::Dumper;
             #print Dumper($testlist);
             foreach $test (@$testlist) {
                 runOneComplexTest($test);
             }
         } else {
             warn "File: ${file} could not be loaded as PERL: $!";
         }
     }
 }

 sub runSimpleTests {

     local($only)=@_;

     open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
     while(<TESTLIST>) {
         next if /^\#/;
         next if /^$/;

         unlink("core");
         ($name, $input, $output, @options) = split;
         #print "processing ${only} vs ${name}\n";
         next if(defined($only) && $only ne $name);

         my $options = join(" ", @options);
         #print "@{options} becomes ${options}\n";

         my $hash = { name => $name,
                      input=> $input,
                      output=>$output,
                      args => $options };

         runOneComplexTest($hash);
     }
 }

 if(scalar(@ARGV) == 0) {
     runSimpleTests();
     runComplexTests();
 } else {
     runSimpleTests($ARGV[0]);
 }

 # exit with number of failing tests.
 print "------------------------------------------------\n";
 printf("%4u tests failed\n",$failedcount);
 printf("%4u tests passed\n",$passedcount);

 showfile(${failureoutput});
 exit $failedcount;
	#!/usr/bin/env perl

	#
	# Were we told where to find tcpdump?
	#
	if (!($TCPDUMP = $ENV{TCPDUMP_BIN})) {
	#
	# No. Use the appropriate path.
	#
	if ($^O eq 'MSWin32') {
	#
	# XXX - assume, for now, a Visual Studio debug build, so that
	# tcpdump is in the Debug subdirectory.
	#
	$TCPDUMP = "Debug\\tcpdump"
	} else {
	$TCPDUMP = "./tcpdump"
	}
	}

	use File::Basename;
	use POSIX qw( WEXITSTATUS WIFEXITED);
	use Cwd qw(abs_path getcwd);
	use File::Path qw(mkpath); # mkpath works with ancient perl, as well as newer perl
	use File::Spec;
	use Data::Dumper; # for debugging.

	# these are created in the directory where we are run, which might be
	# a build directory.
	my $newdir = "tests/NEW";
	my $diffdir= "tests/DIFF";
	mkpath($newdir);
	mkpath($diffdir);
	my $origdir = getcwd();
	my $srcdir = $ENV{'srcdir'} \|\| ".";

	#
	# Force UTC, so time stamps are printed in a standard time zone, and
	# tests don't have to be run in the time zone in which the output
	# file was generated.
	#
	$ENV{'TZ'}='GMT0';

	#
	# Get the tests directory from $0.
	#
	my $testsdir = dirname($0);

	#
	# Convert it to an absolute path, so it works even after we do a cd.
	#
	$testsdir = abs_path($testsdir);
	print "Running tests from ${testsdir}\n";

	unshift(@INC, $testsdir);

	$passedcount = 0;
	$failedcount = 0;
	#
	my $failureoutput=$origdir . "/tests/failure-outputs.txt";

	# truncate the output file
	open(FAILUREOUTPUT, ">" . $failureoutput);
	close(FAILUREOUTPUT);

	$confighhash = undef;

	sub showfile {
	local($path) = @_;

	#
	# XXX - just do this directly in Perl?
	#
	if ($^O eq 'MSWin32') {
	my $winpath = File::Spec->canonpath($path);
	system "type $winpath";
	} else {
	system "cat $path";
	}
	}

	sub runtest {
	local($name, $input, $output, $options) = @_;
	my $r;

	$outputbase = basename($output);
	my $coredump = false;
	my $status = 0;
	my $linecount = 0;
	my $rawstderrlog = "tests/NEW/${outputbase}.raw.stderr";
	my $stderrlog = "tests/NEW/${outputbase}.stderr";
	my $diffstat = 0;
	my $errdiffstat = 0;

	# we used to do this as a nice pipeline, but the problem is that $r fails to
	# to be set properly if the tcpdump core dumps.
	#
	# Furthermore, on Windows, fc can't read the standard input, so we
	# can't do it as a pipeline in any case.
	$r = system "$TCPDUMP -# -n -r $input $options >tests/NEW/${outputbase} 2>${rawstderrlog}";
	if($r == -1) {
	# failed to start due to error.
	$status = $!;
	}
	if($r != 0) {
	$coredump = false;
	$status = 0;
	#
	# Something other than "tcpdump opened the file, read it, and
	# dissected all the packets". What happened?
	#
	# We write out an exit status after whatever the subprocess
	# wrote out, so it shows up when we diff the expected output
	# with it.
	#
	open(OUTPUT, ">>"."tests/NEW/$outputbase") \|\| die "fail to open $outputbase\n";
	if( $r & 128 ) {
	$coredump = $r & 127;
	}
	if( WIFEXITED($r)) {
	$status = WEXITSTATUS($r);
	}

	if($coredump \|\| $status) {
	printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
	} else {
	printf OUTPUT "EXIT CODE %08x\n", $r;
	}
	close(OUTPUT);
	$r = 0;
	}
	if($r == 0) {
	#
	# Compare tcpdump's output with what we think it should be.
	# If tcpdump failed to produce output, we've produced our own
	# "output" above, with the exit status.
	#
	if ($^O eq 'MSWin32') {
	my $winoutput = File::Spec->canonpath($output);
	$r = system "fc /lb1000 /t /1 $winoutput tests\\NEW\\$outputbase >tests\\DIFF\\$outputbase.diff";
	} else {
	$r = system "diff $output tests/NEW/$outputbase >tests/DIFF/$outputbase.diff";
	}
	$diffstat = WEXITSTATUS($r);
	}

	# process the standard error file, sanitize "reading from" line,
	# and count lines
	$linecount = 0;
	open(ERRORRAW, "<" . $rawstderrlog);
	open(ERROROUT, ">" . $stderrlog);
	while(<ERRORRAW>) {
	next if /^$/; # blank lines are boring
	if(/^(reading from file )(.)(,.)$/) {
	my $filename = basename($2);
	print ERROROUT "${1}${filename}${3}\n";
	next;
	}
	print ERROROUT;
	$linecount++;
	}
	close(ERROROUT);
	close(ERRORRAW);

	if ( -f "$output.stderr" ) {
	#
	# Compare the standard error with what we think it should be.
	#
	if ($^O eq 'MSWin32') {
	my $winoutput = File::Spec->canonpath($output);
	my $canonstderrlog = File::Spec->canonpath($stderrlog);
	$nr = system "fc /lb1000 /t /1 $winoutput.stderr $canonstderrlog >tests\DIFF\$outputbase.stderr.diff";
	} else {
	$nr = system "diff $output.stderr $stderrlog >tests/DIFF/$outputbase.stderr.diff";
	}
	if($r == 0) {
	$r = $nr;
	}
	$errdiffstat = WEXITSTATUS($nr);
	}

	if($r == 0) {
	if($linecount == 0 && $status == 0) {
	unlink($stderrlog);
	} else {
	$errdiffstat = 1;
	}
	}

	#print sprintf("END: %08x\n", $r);

	if($r == 0) {
	if($linecount == 0) {
	printf " %-40s: passed\n", $name;
	} else {
	printf " %-40s: passed with error messages:\n", $name;
	showfile($stderrlog);
	}
	unlink "tests/DIFF/$outputbase.diff";
	return 0;
	}
	# must have failed!
	printf " %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
	open FOUT, '>>tests/failure-outputs.txt';
	printf FOUT "\nFailed test: $name\n\n";
	close FOUT;
	if(-f "tests/DIFF/$outputbase.diff") {
	#
	# XXX - just do this directly in Perl?
	#
	if ($^O eq 'MSWin32') {
	system "type tests\\DIFF\\$outputbase.diff >> tests\\failure-outputs.txt";
	} else {
	system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt";
	}
	}

	if($r == -1) {
	print " (failed to execute: $!)\n";
	return(30);
	}

	# this is not working right, $r == 0x8b00 when there is a core dump.
	# clearly, we need some platform specific perl magic to take this apart, so look for "core"
	# too.
	# In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
	# a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
	if($r & 127 \|\| -f "core") {
	my $with = ($r & 128) ? 'with' : 'without';
	if(-f "core") {
	$with = "with";
	}
	printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
	if($linecount == 0) {
	print "\n";
	} else {
	print " with error messages:\n";
	showfile($stderrlog);
	}
	return(($r & 128) ? 10 : 20);
	}
	if($linecount == 0) {
	print "\n";
	} else {
	print " with error messages:\n";
	showfile($stderrlog);
	}
	return(5);
	}

	sub loadconfighash {
	if(defined($confighhash)) {
	return $confighhash;
	}

	$main::confighhash = {};

	# this could be loaded once perhaps.
	open(CONFIG_H, "config.h") \|\| die "Can not open config.h: $!\n";
	while(<CONFIG_H>) {
	chomp;
	if(/^\#define (.*) 1/) {
	#print "Setting $1\n";
	$main::confighhash->{$1} = 1;
	}
	}
	close(CONFIG_H);
	#print Dumper($main::confighhash);

	# also run tcpdump --fp-type to get the type of floating-point
	# arithmetic we're doing, setting a HAVE_{fptype} key based
	# on the value it prints
	open(FPTYPE_PIPE, "$TCPDUMP --fp-type \|") or die("piping tcpdump --fp-type failed\n");
	my $fptype_val = <FPTYPE_PIPE>;
	close(FPTYPE_PIPE);
	my $have_fptype;
	if($fptype_val == "9877.895") {
	$have_fptype = "HAVE_FPTYPE1";
	} else {
	$have_fptype = "HAVE_FPTYPE2";
	}
	$main::confighhash->{$have_fptype} = 1;

	return $main::confighhash;
	}


	sub runOneComplexTest {
	local($testconfig) = @_;

	my $output = $testconfig->{output};
	my $input = $testconfig->{input};
	my $name = $testconfig->{name};
	my $options= $testconfig->{args};
	my $foundit = 1;
	my $unfoundit=1;

	my $configset = $testconfig->{config_set};
	my $configunset = $testconfig->{config_unset};
	my $ch = loadconfighash();
	#print Dumper($ch);

	if(defined($configset)) {
	$foundit = ($ch->{$configset} == 1);
	}
	if(defined($configunset)) {
	$unfoundit=($ch->{$configunset} != 1);
	}

	if(!$foundit) {
	printf " %-40s: skipped (%s not set)\n", $name, $configset;
	return 0;
	}

	if(!$unfoundit) {
	printf " %-40s: skipped (%s set)\n", $name, $configunset;
	return 0;
	}

	#use Data::Dumper;
	#print Dumper($testconfig);

	# EXPAND any occurances of @TESTDIR@ to $testsdir
	$options =~ s/\@TESTDIR\@/$testsdir/;

	my $result = runtest($name,
	$testsdir . "/" . $input,
	$testsdir . "/" . $output,
	$options);

	if($result == 0) {
	$passedcount++;
	} else {
	$failedcount++;
	}
	}

	# *.tests files are PERL hash definitions. They should create an array of hashes
	# one per test, and place it into the variable @testlist.
	sub runComplexTests {
	my @files = glob( $testsdir . '/*.tests' );
	foreach $file (@files) {
	my @testlist = undef;
	my $definitions;
	print "FILE: ${file}\n";
	open(FILE, "<".$file) \|\| die "can not open $file: $!";
	{
	local $/ = undef;
	$definitions = <FILE>;
	}
	close(FILE);
	#print "STUFF: ${definitions}\n";
	eval $definitions;
	if(defined($testlist)) {
	#use Data::Dumper;
	#print Dumper($testlist);
	foreach $test (@$testlist) {
	runOneComplexTest($test);
	}
	} else {
	warn "File: ${file} could not be loaded as PERL: $!";
	}
	}
	}

	sub runSimpleTests {

	local($only)=@_;

	open(TESTLIST, "<" . "${testsdir}/TESTLIST") \|\| die "no ${testsdir}/TESTFILE: $!\n";
	while(<TESTLIST>) {
	next if /^\#/;
	next if /^$/;

	unlink("core");
	($name, $input, $output, @options) = split;
	#print "processing ${only} vs ${name}\n";
	next if(defined($only) && $only ne $name);

	my $options = join(" ", @options);
	#print "@{options} becomes ${options}\n";

	my $hash = { name => $name,
	input=> $input,
	output=>$output,
	args => $options };

	runOneComplexTest($hash);
	}
	}

	if(scalar(@ARGV) == 0) {
	runSimpleTests();
	runComplexTests();
	} else {
	runSimpleTests($ARGV[0]);
	}

	# exit with number of failing tests.
	print "------------------------------------------------\n";
	printf("%4u tests failed\n",$failedcount);
	printf("%4u tests passed\n",$passedcount);

	showfile(${failureoutput});
	exit $failedcount;