xref: /dragonfly/test/libpthread/verify (revision 624815385bcf105ef0d61ce7430127aa835132e7) 
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