From: Michael Richardson <mcr@sandelman.ca>
Date: Fri, 24 Jan 2020 22:07:51 +0000 (-0500)
Subject: translate TESTrun.sh to Perl, still using external routines for complex situations
X-Git-Tag: tcpdump-4.99-bp~585
X-Git-Url: https://git.tcpdump.org/tcpdump/commitdiff_plain/df841d9118bcbe14b3da53f73aec8b7135b3b63f

translate TESTrun.sh to Perl, still using external routines for complex situations
---

diff --git a/tests/TESTonce b/tests/TESTonce
index a4dff565..9d0eb288 100755
--- a/tests/TESTonce
+++ b/tests/TESTonce
@@ -4,151 +4,16 @@ $TCPDUMP = "../tcpdump" if (!($TCPDUMP = $ENV{TCPDUMP_BIN}));
 
 use File::Basename;
 use POSIX qw( WEXITSTATUS WIFEXITED);
+use lib '.';
+use testfuncs;
 
-system("mkdir -p NEW DIFF");
+system("mkdir -p tests/NEW tests/DIFF");
 
 if(@ARGV != 4) {
   print "Usage: TESTonce name input output options\n";
   exit 20;
 }
 
-sub runtest {
-    local($name, $input, $output, $options) = @_;
-    my $r;
-
-    $outputbase = basename($output);
-    my $coredump = false;
-    my $status = 0;
-    my $linecount = 0;
-    my $rawstderrlog = "NEW/${outputbase}.raw.stderr";
-    my $stderrlog = "NEW/${outputbase}.stderr";
-    my $diffstat = 0;
-    my $errdiffstat = 0;
-    
-    if ($^O eq 'MSWin32') {
-        $r = system "..\\windump -# -n -r $input $options 2>NUL | sed 's/\\r//' | tee NEW/$outputbase | diff $output - >DIFF/$outputbase.diff";
-        # need to do same as below for Cygwin.
-    }
-    else {
-        # 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.
-        $r = system "$TCPDUMP 2>${rawstderrlog} -# -n -r $input $options >NEW/${outputbase}";
-        if($r == -1) {
-            # failed to start due to error.
-            $status = $!;
-        }
-        if($r != 0) {
-            $coredump = false;
-            $status = 0;
-            # this means tcpdump failed.
-            open(OUTPUT, ">>"."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) {
-            $r = system "cat NEW/$outputbase | diff $output - >DIFF/$outputbase.diff";
-            $diffstat = WEXITSTATUS($r);
-        }
-        
-        # process the 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" ) {
-            $nr = system "cat $stderrlog | diff $output.stderr - >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;
-            system "cat $stderrlog";
-        }
-        unlink "DIFF/$outputbase.diff";
-        exit 0;
-    }
-    # must have failed!
-    printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
-    open FOUT, '>>failure-outputs.txt';
-    printf FOUT "\nFailed test: $name\n\n";
-    close FOUT;
-    if(-f "DIFF/$outputbase.diff") {
-        system "cat DIFF/$outputbase.diff >> failure-outputs.txt";
-    }
-    
-    if($r == -1) {
-        print " (failed to execute: $!)\n";
-        exit 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";
-            system "cat $stderrlog";
-        }
-        exit ($r & 128) ? 10 : 20;
-    }
-    if($linecount == 0) {
-        print "\n";
-    } else {
-        print " with error messages:\n";
-        system "cat $stderrlog";
-    }
-}
-
 $r = runtest($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3]);
 exit $r >> 8;
 
diff --git a/tests/TESTrun b/tests/TESTrun
new file mode 100755
index 00000000..6a4f7537
--- /dev/null
+++ b/tests/TESTrun
@@ -0,0 +1,107 @@
+#!/usr/bin/perl
+
+$TCPDUMP = "./tcpdump" if (!($TCPDUMP = $ENV{TCPDUMP_BIN}));
+
+use File::Basename;
+use POSIX qw( WEXITSTATUS WIFEXITED);
+use Cwd qw(abs_path getcwd);
+use File::Path qw(make_path remove_tree);
+
+# these are created in the directory where we are run, which might be
+# a build directory.
+my $newdir = "tests/NEW";
+my $diffdir= "tests/DIFF";
+make_path($newdir);
+make_path($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);
+require 'testfuncs.pm';
+
+$passedcount = 0;
+$failedcount = 0;
+my $failureoutput=$origdir . "/tests/failure-outputs.txt";
+
+# truncate the output file
+open(FAILUREOUTPUT, ">" . $failureoutput);
+close(FAILUREOUTPUT);
+
+sub runComplexTests {
+
+    my @files = glob( $testsdir . '/*.sh' );
+    foreach $file (@files) {
+        if($file =~ /TEST.*\.sh/) {
+            print "File $file, skipped\n";
+            next;
+        }
+
+        print "Running $file\n";
+        system("cd tests && sh $file ${srcdir}")
+    }
+
+    # have to update passed/failed here
+}
+
+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 $result =runtest($name, "${testsdir}/$input", "${testsdir}/${output}",$options);
+        if($result == 0) {
+            $passedcount++;
+        } else {
+            $failedcount++;
+        }
+
+        return if(defined($only));
+    }
+}
+
+if(scalar(@ARGV) == 0) {
+    runComplexTests();
+    runSimpleTests();
+} else {
+    runSimpleTests($ARGV[0]);
+}
+
+# exit with number of failing tests.
+print "------------------------------------------------\n";
+printf("%4u tests failed\n",$failedcount);
+printf("%4u tests passed\n",$passedcount);
+
+system("cat ${failureoutput}");
+exit $failedcount;
+
+    
diff --git a/tests/TESTrun.sh b/tests/TESTrun.sh
deleted file mode 100755
index 12b2298f..00000000
--- a/tests/TESTrun.sh
+++ /dev/null
@@ -1,98 +0,0 @@
-#!/bin/sh
-
-#
-# 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.
-#
-TZ=GMT0; export TZ
-
-#
-# Get the tests directory from $0.
-#
-testsdir=`dirname "$0"`
-
-#
-# Convert it to an absolute path, so it works even after we do a cd.
-#
-testsdir=`cd ${testsdir}; pwd`
-
-echo Running tests from ${testsdir}
-
-passedfile=`pwd`/tests/.passed
-failedfile=`pwd`/tests/.failed
-failureoutput=`pwd`/tests/failure-outputs.txt
-mkdir -p tests/NEW
-mkdir -p tests/DIFF
-cat /dev/null > ${failureoutput}
-
-runComplexTests()
-{
-  for i in ${testsdir}/*.sh
-  do
-    case $i in
-        ${testsdir}/TEST*.sh) continue;;
-        ${testsdir}/\*.sh) continue;;
-    esac
-    echo Running $i
-    (cd tests && sh $i ${srcdir})
-  done
-  passed=`cat ${passedfile}`
-  failed=`cat ${failedfile}`
-}
-
-runSimpleTests()
-{
-  only=$1
-  cat ${testsdir}/TESTLIST | while read name input output options
-  do
-    case $name in
-      \#*) continue;;
-      '') continue;;
-    esac
-    rm -f core
-    [ "$only" != "" -a "$name" != "$only" ] && continue
-    # I hate shells with their stupid, useless subshells.
-    passed=`cat ${passedfile}`
-    failed=`cat ${failedfile}`
-    (cd tests  # run TESTonce in tests directory
-    if ${testsdir}/TESTonce $name ${testsdir}/$input ${testsdir}/$output "$options"
-    then
-      passed=`expr $passed + 1`
-      echo $passed >${passedfile}
-    else
-      failed=`expr $failed + 1`
-      echo $failed >${failedfile}
-    fi)
-    [ "$only" != "" -a "$name" = "$only" ] && break
-  done
-  # I hate shells with their stupid, useless subshells.
-  passed=`cat ${passedfile}`
-  failed=`cat ${failedfile}`
-}
-
-passed=0
-failed=0
-echo $passed >${passedfile}
-echo $failed >${failedfile}
-if [ $# -eq 0 ]
-then
-  runComplexTests
-  runSimpleTests
-elif [ $# -eq 1 ]
-then
-  runSimpleTests $1
-else
-  echo "Usage: $0 [test_name]"
-  exit 30
-fi
-
-# exit with number of failing tests.
-echo '------------------------------------------------'
-printf "%4u tests failed\n" $failed
-printf "%4u tests passed\n" $passed
-echo
-cat ${failureoutput}
-echo
-echo
-exit $failed
diff --git a/tests/testfuncs.pm b/tests/testfuncs.pm
new file mode 100644
index 00000000..bed0d04d
--- /dev/null
+++ b/tests/testfuncs.pm
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+
+# expects to be run from the top directory, with "tests" subdirectory.
+
+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;
+    
+    if ($^O eq 'MSWin32') {
+        $r = system "..\\windump -# -n -r $input $options 2>NUL | sed 's/\\r//' | tee tests/NEW/$outputbase | diff $output - >tests/DIFF/$outputbase.diff";
+        # need to do same as below for Cygwin.
+    }
+    else {
+        # 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.
+        $r = system "$TCPDUMP 2>${rawstderrlog} -# -n -r $input $options >tests/NEW/${outputbase}";
+        if($r == -1) {
+            # failed to start due to error.
+            $status = $!;
+        }
+        if($r != 0) {
+            $coredump = false;
+            $status = 0;
+            # this means tcpdump failed.
+            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) {
+            $r = system "cat tests/NEW/$outputbase | diff $output - >tests/DIFF/$outputbase.diff";
+            $diffstat = WEXITSTATUS($r);
+        }
+        
+        # process the 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" ) {
+            $nr = system "cat $stderrlog | diff $output.stderr - >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;
+            system "cat $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") {
+        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";
+            system "cat $stderrlog";
+        }
+        return(($r & 128) ? 10 : 20);
+    }
+    if($linecount == 0) {
+        print "\n";
+    } else {
+        print " with error messages:\n";
+        system "cat $stderrlog";
+    }
+}
+
+1;