159612Sjasone#!/usr/bin/perl -w 259612Sjasone#-*-mode:perl-*- 359612Sjasone############################################################################# 459612Sjasone# 576912Sjasone# Copyright (C) 1999-2001 Jason Evans <jasone@freebsd.org>. 659612Sjasone# All rights reserved. 759612Sjasone# 859612Sjasone# Redistribution and use in source and binary forms, with or without 959612Sjasone# modification, are permitted provided that the following conditions 1059612Sjasone# are met: 1159612Sjasone# 1. Redistributions of source code must retain the above copyright 1259612Sjasone# notice(s), this list of conditions and the following disclaimer as 1359612Sjasone# the first lines of this file unmodified other than the possible 1459612Sjasone# addition of one or more copyright notices. 1559612Sjasone# 2. Redistributions in binary form must reproduce the above copyright 1659612Sjasone# notice(s), this list of conditions and the following disclaimer in 1759612Sjasone# the documentation and/or other materials provided with the 1859612Sjasone# distribution. 1959612Sjasone# 2059612Sjasone# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S) ``AS IS'' AND ANY 2159612Sjasone# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 2259612Sjasone# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 2359612Sjasone# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER(S) BE 2459612Sjasone# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 2559612Sjasone# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 2659612Sjasone# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 2759612Sjasone# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 2859612Sjasone# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 2959612Sjasone# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 3059612Sjasone# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 3159612Sjasone# 3259612Sjasone############################################################################# 3359612Sjasone# 3459612Sjasone# Test harness. 3559612Sjasone# 3659612Sjasone# $FreeBSD$ 3759612Sjasone# 3859612Sjasone############################################################################# 3959612Sjasone 4059612Sjasone# Shut off buffering. 4159612Sjasoneselect(STDOUT); 4259612Sjasone$| = 1; 4359612Sjasone 4459612Sjasone# 4559612Sjasone# Parse command-line arguments. 4659612Sjasone# 4759612Sjasoneuse Getopt::Long; 4859612SjasoneGetopt::Long::config("bundling"); # Allow -hv rather than forcing -h -v. 4959612Sjasone 5059612Sjasone# Set option defaults for optional arguments. 5159612Sjasone$opt_help = 0; 5259612Sjasone$opt_verbose = 0; 5359612Sjasone$opt_quiet = 0; 5459612Sjasone$opt_srcdir = "."; 5576912Sjasone$opt_objdir = "."; 5659612Sjasone$opt_ustats = 0; 5759612Sjasone$opt_zero = 0; 5859612Sjasone 5959612Sjasone$opt_retval = 6059612Sjasone&GetOptions("h|help" => \$opt_help, 6159612Sjasone "v|verbose" => \$opt_verbose, 6259612Sjasone "q|quiet" => \$opt_quiet, 6376912Sjasone "s|srcdir=s" => \$opt_srcdir, 6476912Sjasone "o|objdir=s" => \$opt_objdir, 6559612Sjasone "u|ustats" => \$opt_ustats, 6659612Sjasone "z|zero" => \$opt_zero 6759612Sjasone ); 6859612Sjasone 6959612Sjasoneif ($opt_help) 7059612Sjasone{ 7159612Sjasone &usage(); 7259612Sjasone exit(0); 7359612Sjasone} 7459612Sjasone 7559612Sjasoneif ($opt_retval == 0) 7659612Sjasone{ 7759612Sjasone &usage(); 7859612Sjasone exit 1; 7959612Sjasone} 8059612Sjasone 8159612Sjasoneif ($opt_verbose && $opt_quiet) 8259612Sjasone{ 8359612Sjasone print STDERR "-v and -q are incompatible\n"; 8459612Sjasone &usage(); 8559612Sjasone exit 1; 8659612Sjasone} 8759612Sjasone 8876912Sjasoneif ($#ARGV + 1 == 0) 8959612Sjasone{ 9059612Sjasone print STDERR "No tests specified\n"; 9159612Sjasone &usage(); 9259612Sjasone exit 1; 9359612Sjasone} 9459612Sjasone 9559612Sjasoneif ($opt_verbose) 9659612Sjasone{ 9776912Sjasone print STDERR "Option values: h:$opt_help, v:$opt_verbose, " 9876912Sjasone . "s:\"$opt_srcdir\", o:\"$opt_objdir\" " 9976912Sjasone . "q:$opt_quiet, u:$opt_ustats, z:$opt_zero\n"; 10076912Sjasone printf STDERR "Tests (%d total): @ARGV\n", $#ARGV + 1; 10159612Sjasone} 10259612Sjasone 10359612Sjasone# 10459612Sjasone# Create and print header. 10559612Sjasone# 10659612Sjasone@TSTATS = 10759612Sjasone( 10859612Sjasone "--------------------------------------------------------------------------\n", 10959612Sjasone "Test c_user c_system c_total chng\n", 11059612Sjasone " passed/FAILED h_user h_system h_total %% chng\n" 11159612Sjasone ); 11259612Sjasone 11359612Sjasoneif (!$opt_quiet) 11459612Sjasone{ 11559612Sjasone foreach $line (@TSTATS) 11659612Sjasone { 11759612Sjasone printf STDOUT "$line"; 11859612Sjasone } 11959612Sjasone} 12059612Sjasone 12159612Sjasone# 12259612Sjasone# Run sequence test(s). 12359612Sjasone# 12459612Sjasone$total_utime = 0.0; # Total user time. 12559612Sjasone$total_stime = 0.0; # Total system time. 12659612Sjasone$total_hutime = 0.0; # Total historical user time. 12759612Sjasone$total_hstime = 0.0; # Total historical system time. 12859612Sjasone$total_ntime = 0.0; # Total time for tests that have historical data. 12959612Sjasone 13076912Sjasoneforeach $test (@ARGV) 13159612Sjasone{ 13276912Sjasone # Strip out any whitespace in $test. 13376912Sjasone $test =~ s/^\s*(.*)\s*$/$1/; 13476912Sjasone 13559612Sjasone $okay = 1; 13659612Sjasone 13776912Sjasone if (-e "$opt_srcdir/$test.exp") 13859612Sjasone { 13976912Sjasone # Diff mode. 14059612Sjasone 14176912Sjasone ($okay, $utime, $stime) = &run_test($test); 14259612Sjasone 14376912Sjasone if (-e "$opt_objdir/$test.out") 14459612Sjasone { 14576912Sjasone `diff $opt_srcdir/$test.exp $opt_objdir/$test.out > $opt_objdir/$test.diff 2>&1`; 14676912Sjasone if ($?) 14776912Sjasone { 14876912Sjasone # diff returns non-zero if there is a difference. 14976912Sjasone $okay = 0; 15076912Sjasone } 15159612Sjasone } 15259612Sjasone else 15359612Sjasone { 15459612Sjasone $okay = 0; 15559612Sjasone if ($opt_verbose) 15659612Sjasone { 15776912Sjasone print STDERR 15876912Sjasone "Nonexistent output file \"$opt_objdir/$test.out\"\n"; 15959612Sjasone } 16059612Sjasone } 16176912Sjasone 16276912Sjasone ($hutime, $hstime) = &print_stats($test, $okay, 0, 0, $utime, $stime); 16376912Sjasone } 16476912Sjasone else 16576912Sjasone { 16676912Sjasone # Sequence mode. 16776912Sjasone 16876912Sjasone ($okay, $utime, $stime) = &run_test($test); 16976912Sjasone 17076912Sjasone if (open (STEST_OUT, "<$opt_objdir/$test.out")) 17159612Sjasone { 17276912Sjasone $num_subtests = 0; 17376912Sjasone $num_failed_subtests = 0; 17476912Sjasone 17559612Sjasone while (defined($line = <STEST_OUT>)) 17659612Sjasone { 17776912Sjasone if ($line =~ /1\.\.(\d+)/) 17859612Sjasone { 17976912Sjasone $num_subtests = $1; 18059612Sjasone last; 18159612Sjasone } 18276912Sjasone } 18376912Sjasone if ($num_subtests == 0) 18476912Sjasone { 18576912Sjasone $okay = 0; 18676912Sjasone if ($opt_verbose) 18759612Sjasone { 18876912Sjasone print STDERR "Malformed or missing 1..n line\n"; 18959612Sjasone } 19059612Sjasone } 19176912Sjasone else 19259612Sjasone { 19376912Sjasone for ($subtest = 1; $subtest <= $num_subtests; $subtest++) 19459612Sjasone { 19576912Sjasone while (defined($line = <STEST_OUT>)) 19659612Sjasone { 19776912Sjasone if ($line =~ /^not\s+ok\s+(\d+)?/) 19876912Sjasone { 19976912Sjasone $not = 1; 20076912Sjasone $test_num = $1; 20176912Sjasone last; 20276912Sjasone } 20376912Sjasone elsif ($line =~ /^ok\s+(\d+)?/) 20476912Sjasone { 20576912Sjasone $not = 0; 20676912Sjasone $test_num = $1; 20776912Sjasone last; 20876912Sjasone } 20959612Sjasone } 21076912Sjasone if (defined($line)) 21176912Sjasone { 21276912Sjasone if (defined($test_num) && ($test_num != $subtest)) 21376912Sjasone { 21476912Sjasone # There was no output printed for one or more tests. 21576912Sjasone for (; $subtest < $test_num; $subtest++) 21676912Sjasone { 21776912Sjasone $num_failed_subtests++; 21876912Sjasone } 21976912Sjasone } 22076912Sjasone if ($not) 22176912Sjasone { 22276912Sjasone $num_failed_subtests++; 22376912Sjasone } 22476912Sjasone } 22576912Sjasone else 22676912Sjasone { 22776912Sjasone for (; $subtest <= $num_subtests; $subtest++) 22876912Sjasone { 22976912Sjasone $num_failed_subtests++; 23076912Sjasone } 23176912Sjasone } 23259612Sjasone } 23376912Sjasone 23476912Sjasone if (0 < $num_failed_subtests) 23559612Sjasone { 23676912Sjasone $okay = 0; 23759612Sjasone } 23859612Sjasone } 23976912Sjasone } 24076912Sjasone else 24176912Sjasone { 24276912Sjasone if (!$opt_quiet) 24359612Sjasone { 24476912Sjasone print STDERR "Cannot open output file \"$opt_objdir/$test.out\"\n"; 24559612Sjasone } 24676912Sjasone exit 1; 24759612Sjasone } 24859612Sjasone 24976912Sjasone ($hutime, $hstime) = &print_stats($test, $okay, 25076912Sjasone $num_failed_subtests, $num_subtests, 25176912Sjasone $utime, $stime); 25259612Sjasone } 25359612Sjasone 25459612Sjasone $total_hutime += $hutime; 25559612Sjasone $total_hstime += $hstime; 25659612Sjasone 25759612Sjasone if ($okay) 25859612Sjasone { 25959612Sjasone $total_utime += $utime; 26059612Sjasone $total_stime += $stime; 26159612Sjasone } 26259612Sjasone else 26359612Sjasone { 26459612Sjasone @FAILED_TESTS = (@FAILED_TESTS, $test); 26559612Sjasone } 26659612Sjasone 26759612Sjasone # If there were historical data, add the run time to the total time to 26859612Sjasone # compare against the historical run time. 26959612Sjasone if (0 < ($hutime + $hstime)) 27059612Sjasone { 27159612Sjasone $total_ntime += $utime + $stime; 27259612Sjasone } 27359612Sjasone} 27459612Sjasone 27559612Sjasone# Print summary stats. 27659612Sjasone$tt_str = sprintf ("%d / %d passed (%5.2f%%%%)", 27776912Sjasone ($#ARGV + 1) - ($#FAILED_TESTS + 1), 27876912Sjasone $#ARGV + 1, 27976912Sjasone (($#ARGV + 1) - ($#FAILED_TESTS + 1)) 28076912Sjasone / ($#ARGV + 1) * 100); 28159612Sjasone 28259612Sjasone$t_str = sprintf ("Totals %7.2f %7.2f %7.2f" 28359612Sjasone . " %7.2f\n" 28459612Sjasone . " %s %7.2f %7.2f %7.2f %7.2f%%%%\n", 28559612Sjasone $total_utime, $total_stime, $total_utime + $total_stime, 28659612Sjasone ($total_ntime - ($total_hutime + $total_hstime)), 28759612Sjasone $tt_str . ' ' x (40 - length($tt_str)), 28859612Sjasone $total_hutime, $total_hstime, $total_hutime + $total_hstime, 28959612Sjasone ($total_hutime + $total_hstime == 0.0) ? 0.0 : 29059612Sjasone (($total_ntime 29159612Sjasone - ($total_hutime + $total_hstime)) 29259612Sjasone / ($total_hutime + $total_hstime) * 100)); 29359612Sjasone 29459612Sjasone@TSTATS = ("--------------------------------------------------------------------------\n", 29559612Sjasone $t_str, 29659612Sjasone "--------------------------------------------------------------------------\n" 29759612Sjasone ); 29859612Sjasoneif (!$opt_quiet) 29959612Sjasone{ 30059612Sjasone foreach $line (@TSTATS) 30159612Sjasone { 30259612Sjasone printf STDOUT "$line"; 30359612Sjasone } 30459612Sjasone} 30559612Sjasone 30676912Sjasoneif ($#FAILED_TESTS >= 0) 30776912Sjasone{ 30876912Sjasone # One or more tests failed, so return an error. 30976912Sjasone exit 1; 31076912Sjasone} 31159612Sjasone# End of main execution. 31259612Sjasone 31359612Sjasonesub run_test 31459612Sjasone{ 31559612Sjasone my ($test) = @_; 31659612Sjasone my ($okay) = 1; 31759612Sjasone my ($tutime, $tstime); 31859612Sjasone my ($utime, $stime, $cutime, $cstime); 31976912Sjasone my (@TSTATS, @TPATH); 32059612Sjasone my ($t_str); 32176912Sjasone my ($srcdir, $objdir); 32259612Sjasone 32376912Sjasone # Get the path component of $test, if any. 32476912Sjasone @TPATH = split(/\//, $test); 32576912Sjasone pop(@TPATH); 32676912Sjasone $srcdir = join('/', ($opt_srcdir, @TPATH)); 32776912Sjasone $objdir = join('/', ($opt_objdir, @TPATH)); 32876912Sjasone 32959612Sjasone @TSTATS = ("--------------------------------------------------------------------------\n"); 33059612Sjasone 33159612Sjasone $t_str = sprintf ("%s%s", $test, ' ' x (40 - length($test))); 33259612Sjasone @TSTATS = (@TSTATS, $t_str); 33359612Sjasone @STATS = (@STATS, @TSTATS); 33459612Sjasone if (!$opt_quiet) 33559612Sjasone { 33659612Sjasone foreach $line (@TSTATS) 33759612Sjasone { 33859612Sjasone printf STDOUT "$line"; 33959612Sjasone } 34059612Sjasone } 34159612Sjasone 34259612Sjasone ($utime, $stime, $cutime, $cstime) = times; 34376912Sjasone `$opt_objdir/$test $srcdir $objdir > $opt_objdir/$test.out 2>&1`; 34459612Sjasone ($utime, $stime, $tutime, $tstime) = times; 34559612Sjasone 34659612Sjasone # Subtract the before time from the after time. 34759612Sjasone $tutime -= $cutime; 34859612Sjasone $tstime -= $cstime; 34959612Sjasone 35059612Sjasone if ($opt_zero) 35159612Sjasone { 35259612Sjasone if ($?) 35359612Sjasone { 35459612Sjasone $okay = 0; 35559612Sjasone if ($opt_verbose) 35659612Sjasone { 35776912Sjasone print STDERR 35876912Sjasone "\"$opt_objdir/$test > $opt_objdir/$test.out 2>&1\" returned $?\n"; 35959612Sjasone } 36059612Sjasone } 36159612Sjasone } 36259612Sjasone 36359612Sjasone return ($okay, $tutime, $tstime); 36459612Sjasone} 36559612Sjasone 36659612Sjasonesub print_stats 36759612Sjasone{ 36859612Sjasone my ($test, $okay, $failed_subtests, $subtests, $utime, $stime) = @_; 36959612Sjasone my ($hutime, $hstime); 37059612Sjasone# my (TEST_PERF); 37159612Sjasone my (@TSTATS); 37259612Sjasone my ($t_str, $pass_str); 37359612Sjasone 37459612Sjasone $pass_str = $okay ? "passed" : "*** FAILED ***"; 37559612Sjasone if ((0 != $subtests) && (!$okay)) 37659612Sjasone { 37759612Sjasone $pass_str = $pass_str . " ($failed_subtests/$subtests failed)"; 37859612Sjasone } 37959612Sjasone $pass_str = $pass_str . ' ' x (39 - length($pass_str)); 38059612Sjasone 38159612Sjasone if (-r "$test.perf") 38259612Sjasone { 38376912Sjasone if (!open (TEST_PERF, "<$opt_objdir/$test.perf")) 38459612Sjasone { 38576912Sjasone print STDERR "Unable to open \"$opt_objdir/$test.perf\"\n"; 38659612Sjasone exit 1; 38759612Sjasone } 38859612Sjasone $_ = <TEST_PERF>; 38959612Sjasone 39059612Sjasone ($hutime, $hstime) = split; 39159612Sjasone close TEST_PERF; 39259612Sjasone 39359612Sjasone $t_str = sprintf (" %7.2f %7.2f %7.2f %7.2f\n" 39459612Sjasone . " %s %7.2f %7.2f %7.2f %7.2f%%%%\n", 39559612Sjasone $utime, $stime, $utime + $stime, 39659612Sjasone ($utime + $stime) - ($hutime + $hstime), 39759612Sjasone $pass_str, 39859612Sjasone $hutime, $hstime, $hutime + $hstime, 39959612Sjasone (($hutime + $hstime) == 0.0) ? 0.0 : 40059612Sjasone ((($utime + $stime) - ($hutime + $hstime)) 40159612Sjasone / ($hutime + $hstime) * 100)); 40259612Sjasone } 40359612Sjasone else 40459612Sjasone { 40559612Sjasone $hutime = 0.0; 40659612Sjasone $hstime = 0.0; 40759612Sjasone 40859612Sjasone $t_str = sprintf (" %7.2f %7.2f %7.2f \n" 40959612Sjasone . " %s\n", 41059612Sjasone $utime, $stime, $utime + $stime, 41159612Sjasone $pass_str); 41259612Sjasone } 41359612Sjasone @TSTATS = ($t_str); 41459612Sjasone if (!$opt_quiet) 41559612Sjasone { 41659612Sjasone foreach $line (@TSTATS) 41759612Sjasone { 41859612Sjasone printf STDOUT "$line"; 41959612Sjasone } 42059612Sjasone } 42159612Sjasone 42259612Sjasone if ($okay && $opt_ustats) 42359612Sjasone { 42476912Sjasone if (!open (TEST_PERF, ">$opt_objdir/$test.perf")) 42559612Sjasone { 42659612Sjasone if (!$opt_quiet) 42759612Sjasone { 42876912Sjasone print STDERR "Unable to update \"$opt_objdir/$test.perf\"\n"; 42959612Sjasone } 43059612Sjasone } 43159612Sjasone else 43259612Sjasone { 43359612Sjasone print TEST_PERF "$utime $stime\n"; 43459612Sjasone close TEST_PERF; 43559612Sjasone } 43659612Sjasone } 43759612Sjasone 43859612Sjasone return ($hutime, $hstime); 43959612Sjasone} 44059612Sjasone 44159612Sjasonesub usage 44259612Sjasone{ 44359612Sjasone print <<EOF; 44459612Sjasone$0 usage: 44576912Sjasone $0 [<options>] <test>+ 44659612Sjasone 44759612Sjasone Option | Description 44859612Sjasone --------------+------------------------------------------------------------- 44959612Sjasone -h --help | Print usage and exit. 45059612Sjasone -v --verbose | Verbose (incompatible with quiet). 45159612Sjasone -q --quiet | Quiet (incompatible with verbose). 45259612Sjasone -s --srcdir | Path to source tree (default is "."). 45376912Sjasone -o --objdir | Path to object tree (default is "."). 45459612Sjasone -u --ustats | Update historical statistics (stored in "<test>.perf". 45559612Sjasone -z --zero | Consider non-zero exit code to be an error. 45659612Sjasone --------------+------------------------------------------------------------- 45759612Sjasone 45876912Sjasone If <test>.exp exists, <test>'s output is diff'ed with <test>.exp. Any 45976912Sjasone difference is considered failure. 46076912Sjasone 46176912Sjasone If <test>.exp does not exist, output to stdout of the following form is 46276912Sjasone expected: 46376912Sjasone 46476912Sjasone 1..<n> 46576912Sjasone {not }ok[ 1] 46676912Sjasone {not }ok[ 2] 46776912Sjasone ... 46876912Sjasone {not }ok[ n] 46976912Sjasone 47076912Sjasone 1 <= <n> < 2^31 47176912Sjasone 47276912Sjasone Lines which do not match the patterns shown above are ignored. 47359612SjasoneEOF 47459612Sjasone} 475