Initial import from FreeBSD RELENG_4:
[dragonfly.git] / lib / libc_r / test / verify
CommitLineData
984263bc
MD
1#!/usr/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#
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}