lib/libc_r/test/verify

   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.
  41 select(STDOUT);
  42 $| = 1;
  43
  44 #
  45 # Parse command-line arguments.
  46 #
  47 use Getopt::Long;
  48 Getopt::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
  69 if ($opt_help)
  70 {
  71     &usage();
  72     exit(0);
  73 }
  74
  75 if ($opt_retval == 0)
  76 {
  77     &usage();
  78     exit 1;
  79 }
  80
  81 if ($opt_verbose && $opt_quiet)
  82 {
  83     print STDERR "-v and -q are incompatible\n";
  84     &usage();
  85     exit 1;
  86 }
  87
  88 if ($#ARGV + 1 == 0)
  89 {
  90     print STDERR "No tests specified\n";
  91     &usage();
  92     exit 1;
  93 }
  94
  95 if ($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
 113 if (!$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
 130 foreach $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            );
 298 if (!$opt_quiet)
 299 {
 300     foreach $line (@TSTATS)
 301     {
 302         printf STDOUT "$line";
 303     }
 304 }
 305
 306 if ($#FAILED_TESTS >= 0)
 307 {
 308     # One or more tests failed, so return an error.
 309     exit 1;
 310 }
 311 # End of main execution.
 312
 313 sub 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
 366 sub 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
 441 sub 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.
 473 EOF
 474 }