1#!/usr/bin/env perl -w 2#-*-mode:perl-*- 3############################################################################# 4# 5# Copyright (C) 1999-2001 Jason Evans <jasone@freebsd.org>. 6# All rights reserved. 7# 8# Redistribution and use in source and binary forms, with or without 9# modification, are permitted provided that the following conditions 10# are met: 11# 1. Redistributions of source code must retain the above copyright 12# notice(s), this list of conditions and the following disclaimer as 13# the first lines of this file unmodified other than the possible 14# addition of one or more copyright notices. 15# 2. Redistributions in binary form must reproduce the above copyright 16# notice(s), this list of conditions and the following disclaimer in 17# the documentation and/or other materials provided with the 18# distribution. 19# 20# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S) ``AS IS'' AND ANY 21# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 23# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER(S) BE 24# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 25# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 26# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 27# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 28# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 29# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 30# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31# 32############################################################################# 33# 34# Test harness. 35# 36# $FreeBSD: src/lib/libc_r/test/verify,v 1.1.2.2 2001/06/22 21:44:27 jasone Exp $ 37# 38############################################################################# 39 40# Shut off buffering. 41select(STDOUT); 42$| = 1; 43 44# 45# Parse command-line arguments. 46# 47use Getopt::Long; 48Getopt::Long::config("bundling"); # Allow -hv rather than forcing -h -v. 49 50# Set option defaults for optional arguments. 51$opt_help = 0; 52$opt_verbose = 0; 53$opt_quiet = 0; 54$opt_srcdir = "."; 55$opt_objdir = "."; 56$opt_ustats = 0; 57$opt_zero = 0; 58 59$opt_retval = 60&GetOptions("h|help" => \$opt_help, 61 "v|verbose" => \$opt_verbose, 62 "q|quiet" => \$opt_quiet, 63 "s|srcdir=s" => \$opt_srcdir, 64 "o|objdir=s" => \$opt_objdir, 65 "u|ustats" => \$opt_ustats, 66 "z|zero" => \$opt_zero 67 ); 68 69if ($opt_help) 70{ 71 &usage(); 72 exit(0); 73} 74 75if ($opt_retval == 0) 76{ 77 &usage(); 78 exit 1; 79} 80 81if ($opt_verbose && $opt_quiet) 82{ 83 print STDERR "-v and -q are incompatible\n"; 84 &usage(); 85 exit 1; 86} 87 88if ($#ARGV + 1 == 0) 89{ 90 print STDERR "No tests specified\n"; 91 &usage(); 92 exit 1; 93} 94 95if ($opt_verbose) 96{ 97 print STDERR "Option values: h:$opt_help, v:$opt_verbose, " 98 . "s:\"$opt_srcdir\", o:\"$opt_objdir\" " 99 . "q:$opt_quiet, u:$opt_ustats, z:$opt_zero\n"; 100 printf STDERR "Tests (%d total): @ARGV\n", $#ARGV + 1; 101} 102 103# 104# Create and print header. 105# 106@TSTATS = 107( 108 "--------------------------------------------------------------------------\n", 109 "Test c_user c_system c_total chng\n", 110 " passed/FAILED h_user h_system h_total %% chng\n" 111 ); 112 113if (!$opt_quiet) 114{ 115 foreach $line (@TSTATS) 116 { 117 printf STDOUT "$line"; 118 } 119} 120 121# 122# Run sequence test(s). 123# 124$total_utime = 0.0; # Total user time. 125$total_stime = 0.0; # Total system time. 126$total_hutime = 0.0; # Total historical user time. 127$total_hstime = 0.0; # Total historical system time. 128$total_ntime = 0.0; # Total time for tests that have historical data. 129 130foreach $test (@ARGV) 131{ 132 # Strip out any whitespace in $test. 133 $test =~ s/^\s*(.*)\s*$/$1/; 134 135 $okay = 1; 136 137 if (-e "$opt_srcdir/$test.exp") 138 { 139 # Diff mode. 140 141 ($okay, $utime, $stime) = &run_test($test); 142 143 if (-e "$opt_objdir/$test.out") 144 { 145 `diff $opt_srcdir/$test.exp $opt_objdir/$test.out > $opt_objdir/$test.diff 2>&1`; 146 if ($?) 147 { 148 # diff returns non-zero if there is a difference. 149 $okay = 0; 150 } 151 } 152 else 153 { 154 $okay = 0; 155 if ($opt_verbose) 156 { 157 print STDERR 158 "Nonexistent output file \"$opt_objdir/$test.out\"\n"; 159 } 160 } 161 162 ($hutime, $hstime) = &print_stats($test, $okay, 0, 0, $utime, $stime); 163 } 164 else 165 { 166 # Sequence mode. 167 168 ($okay, $utime, $stime) = &run_test($test); 169 170 if (open (STEST_OUT, "<$opt_objdir/$test.out")) 171 { 172 $num_subtests = 0; 173 $num_failed_subtests = 0; 174 175 while (defined($line = <STEST_OUT>)) 176 { 177 if ($line =~ /1\.\.(\d+)/) 178 { 179 $num_subtests = $1; 180 last; 181 } 182 } 183 if ($num_subtests == 0) 184 { 185 $okay = 0; 186 if ($opt_verbose) 187 { 188 print STDERR "Malformed or missing 1..n line\n"; 189 } 190 } 191 else 192 { 193 for ($subtest = 1; $subtest <= $num_subtests; $subtest++) 194 { 195 while (defined($line = <STEST_OUT>)) 196 { 197 if ($line =~ /^not\s+ok\s+(\d+)?/) 198 { 199 $not = 1; 200 $test_num = $1; 201 last; 202 } 203 elsif ($line =~ /^ok\s+(\d+)?/) 204 { 205 $not = 0; 206 $test_num = $1; 207 last; 208 } 209 } 210 if (defined($line)) 211 { 212 if (defined($test_num) && ($test_num != $subtest)) 213 { 214 # There was no output printed for one or more tests. 215 for (; $subtest < $test_num; $subtest++) 216 { 217 $num_failed_subtests++; 218 } 219 } 220 if ($not) 221 { 222 $num_failed_subtests++; 223 } 224 } 225 else 226 { 227 for (; $subtest <= $num_subtests; $subtest++) 228 { 229 $num_failed_subtests++; 230 } 231 } 232 } 233 234 if (0 < $num_failed_subtests) 235 { 236 $okay = 0; 237 } 238 } 239 } 240 else 241 { 242 if (!$opt_quiet) 243 { 244 print STDERR "Cannot open output file \"$opt_objdir/$test.out\"\n"; 245 } 246 exit 1; 247 } 248 249 ($hutime, $hstime) = &print_stats($test, $okay, 250 $num_failed_subtests, $num_subtests, 251 $utime, $stime); 252 } 253 254 $total_hutime += $hutime; 255 $total_hstime += $hstime; 256 257 if ($okay) 258 { 259 $total_utime += $utime; 260 $total_stime += $stime; 261 } 262 else 263 { 264 @FAILED_TESTS = (@FAILED_TESTS, $test); 265 } 266 267 # If there were historical data, add the run time to the total time to 268 # compare against the historical run time. 269 if (0 < ($hutime + $hstime)) 270 { 271 $total_ntime += $utime + $stime; 272 } 273} 274 275# Print summary stats. 276$tt_str = sprintf ("%d / %d passed (%5.2f%%%%)", 277 ($#ARGV + 1) - ($#FAILED_TESTS + 1), 278 $#ARGV + 1, 279 (($#ARGV + 1) - ($#FAILED_TESTS + 1)) 280 / ($#ARGV + 1) * 100); 281 282$t_str = sprintf ("Totals %7.2f %7.2f %7.2f" 283 . " %7.2f\n" 284 . " %s %7.2f %7.2f %7.2f %7.2f%%%%\n", 285 $total_utime, $total_stime, $total_utime + $total_stime, 286 ($total_ntime - ($total_hutime + $total_hstime)), 287 $tt_str . ' ' x (40 - length($tt_str)), 288 $total_hutime, $total_hstime, $total_hutime + $total_hstime, 289 ($total_hutime + $total_hstime == 0.0) ? 0.0 : 290 (($total_ntime 291 - ($total_hutime + $total_hstime)) 292 / ($total_hutime + $total_hstime) * 100)); 293 294@TSTATS = ("--------------------------------------------------------------------------\n", 295 $t_str, 296 "--------------------------------------------------------------------------\n" 297 ); 298if (!$opt_quiet) 299{ 300 foreach $line (@TSTATS) 301 { 302 printf STDOUT "$line"; 303 } 304} 305 306if ($#FAILED_TESTS >= 0) 307{ 308 # One or more tests failed, so return an error. 309 exit 1; 310} 311# End of main execution. 312 313sub run_test 314{ 315 my ($test) = @_; 316 my ($okay) = 1; 317 my ($tutime, $tstime); 318 my ($utime, $stime, $cutime, $cstime); 319 my (@TSTATS, @TPATH); 320 my ($t_str); 321 my ($srcdir, $objdir); 322 323 # Get the path component of $test, if any. 324 @TPATH = split(/\//, $test); 325 pop(@TPATH); 326 $srcdir = join('/', ($opt_srcdir, @TPATH)); 327 $objdir = join('/', ($opt_objdir, @TPATH)); 328 329 @TSTATS = ("--------------------------------------------------------------------------\n"); 330 331 $t_str = sprintf ("%s%s", $test, ' ' x (40 - length($test))); 332 @TSTATS = (@TSTATS, $t_str); 333 @STATS = (@STATS, @TSTATS); 334 if (!$opt_quiet) 335 { 336 foreach $line (@TSTATS) 337 { 338 printf STDOUT "$line"; 339 } 340 } 341 342 ($utime, $stime, $cutime, $cstime) = times; 343 `$opt_objdir/$test $srcdir $objdir > $opt_objdir/$test.out 2>&1`; 344 ($utime, $stime, $tutime, $tstime) = times; 345 346 # Subtract the before time from the after time. 347 $tutime -= $cutime; 348 $tstime -= $cstime; 349 350 if ($opt_zero) 351 { 352 if ($?) 353 { 354 $okay = 0; 355 if ($opt_verbose) 356 { 357 print STDERR 358 "\"$opt_objdir/$test > $opt_objdir/$test.out 2>&1\" returned $?\n"; 359 } 360 } 361 } 362 363 return ($okay, $tutime, $tstime); 364} 365 366sub print_stats 367{ 368 my ($test, $okay, $failed_subtests, $subtests, $utime, $stime) = @_; 369 my ($hutime, $hstime); 370# my (TEST_PERF); 371 my (@TSTATS); 372 my ($t_str, $pass_str); 373 374 $pass_str = $okay ? "passed" : "*** FAILED ***"; 375 if ((0 != $subtests) && (!$okay)) 376 { 377 $pass_str = $pass_str . " ($failed_subtests/$subtests failed)"; 378 } 379 $pass_str = $pass_str . ' ' x (39 - length($pass_str)); 380 381 if (-r "$test.perf") 382 { 383 if (!open (TEST_PERF, "<$opt_objdir/$test.perf")) 384 { 385 print STDERR "Unable to open \"$opt_objdir/$test.perf\"\n"; 386 exit 1; 387 } 388 $_ = <TEST_PERF>; 389 390 ($hutime, $hstime) = split; 391 close TEST_PERF; 392 393 $t_str = sprintf (" %7.2f %7.2f %7.2f %7.2f\n" 394 . " %s %7.2f %7.2f %7.2f %7.2f%%%%\n", 395 $utime, $stime, $utime + $stime, 396 ($utime + $stime) - ($hutime + $hstime), 397 $pass_str, 398 $hutime, $hstime, $hutime + $hstime, 399 (($hutime + $hstime) == 0.0) ? 0.0 : 400 ((($utime + $stime) - ($hutime + $hstime)) 401 / ($hutime + $hstime) * 100)); 402 } 403 else 404 { 405 $hutime = 0.0; 406 $hstime = 0.0; 407 408 $t_str = sprintf (" %7.2f %7.2f %7.2f \n" 409 . " %s\n", 410 $utime, $stime, $utime + $stime, 411 $pass_str); 412 } 413 @TSTATS = ($t_str); 414 if (!$opt_quiet) 415 { 416 foreach $line (@TSTATS) 417 { 418 printf STDOUT "$line"; 419 } 420 } 421 422 if ($okay && $opt_ustats) 423 { 424 if (!open (TEST_PERF, ">$opt_objdir/$test.perf")) 425 { 426 if (!$opt_quiet) 427 { 428 print STDERR "Unable to update \"$opt_objdir/$test.perf\"\n"; 429 } 430 } 431 else 432 { 433 print TEST_PERF "$utime $stime\n"; 434 close TEST_PERF; 435 } 436 } 437 438 return ($hutime, $hstime); 439} 440 441sub usage 442{ 443 print <<EOF; 444$0 usage: 445 $0 [<options>] <test>+ 446 447 Option | Description 448 --------------+------------------------------------------------------------- 449 -h --help | Print usage and exit. 450 -v --verbose | Verbose (incompatible with quiet). 451 -q --quiet | Quiet (incompatible with verbose). 452 -s --srcdir | Path to source tree (default is "."). 453 -o --objdir | Path to object tree (default is "."). 454 -u --ustats | Update historical statistics (stored in "<test>.perf". 455 -z --zero | Consider non-zero exit code to be an error. 456 --------------+------------------------------------------------------------- 457 458 If <test>.exp exists, <test>'s output is diff'ed with <test>.exp. Any 459 difference is considered failure. 460 461 If <test>.exp does not exist, output to stdout of the following form is 462 expected: 463 464 1..<n> 465 {not }ok[ 1] 466 {not }ok[ 2] 467 ... 468 {not }ok[ n] 469 470 1 <= <n> < 2^31 471 472 Lines which do not match the patterns shown above are ignored. 473EOF 474} 475