lib/libc_r/test/verify

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