Annotation of mandoc/regress/regress.pl, Revision 1.12
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.12 ! schwarze 3: # $Id: regress.pl,v 1.11 2019/07/01 22:56:26 schwarze Exp $
1.1 schwarze 4: #
5: # Copyright (c) 2017 Ingo Schwarze <schwarze@openbsd.org>
6: #
7: # Permission to use, copy, modify, and distribute this software for any
8: # purpose with or without fee is hereby granted, provided that the above
9: # copyright notice and this permission notice appear in all copies.
10: #
11: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18:
19: use warnings;
20: use strict;
21:
22: # Used because open(3p) and open2(3p) provide no way for handling
23: # STDERR of the child process, neither for appending it to STDOUT,
24: # nor for piping it into the Perl program.
25: use IPC::Open3 qw(open3);
26:
1.2 schwarze 27: # Define this at one place such that it can easily be changed
28: # if diff(1) does not support the -a option.
29: my @diff = qw(diff -au);
1.10 schwarze 30: system @diff, '/dev/null', '/dev/null' and @diff = qw(diff -u);
1.2 schwarze 31:
1.1 schwarze 32: # --- utility functions ------------------------------------------------
33:
34: sub usage ($) {
35: warn shift;
36: print STDERR "usage: $0 [directory[:test] [modifier ...]]\n";
37: exit 1;
38: }
39:
1.8 schwarze 40: # Modifier arguments provided on the command line,
41: # inspected by the main program and by the utility functions.
42: my %targets;
43:
1.1 schwarze 44: # Run a command and send STDOUT and STDERR to a file.
45: # 1st argument: path to the output file
46: # 2nd argument: command name
47: # The remaining arguments are passed to the command.
48: sub sysout ($@) {
49: my $outfile = shift;
1.8 schwarze 50: print "@_\n" if $targets{verbose};
1.1 schwarze 51: local *OUT_FH;
52: open OUT_FH, '>', $outfile or die "$outfile: $!";
53: my $pid = open3 undef, ">&OUT_FH", undef, @_;
54: close OUT_FH;
55: waitpid $pid, 0;
56: return $? >> 8;
57: }
58:
59: # Simlar, but filter the output as needed for the lint test.
60: sub syslint ($@) {
61: my $outfile = shift;
1.8 schwarze 62: print "@_\n" if $targets{verbose};
1.1 schwarze 63: open my $outfd, '>', $outfile or die "$outfile: $!";
64: my $infd;
65: my $pid = open3 undef, $infd, undef, @_;
66: while (<$infd>) {
67: s/^mandoc: [^:]+\//mandoc: /;
68: print $outfd $_;
69: }
70: close $outfd;
71: close $infd;
72: waitpid $pid, 0;
73: return 0;
74: }
75:
76: # Simlar, but filter the output as needed for the html test.
77: sub syshtml ($@) {
78: my $outfile = shift;
1.8 schwarze 79: print "@_\n" if $targets{verbose};
1.1 schwarze 80: open my $outfd, '>', $outfile or die "$outfile: $!";
81: my $infd;
82: my $pid = open3 undef, $infd, undef, @_;
1.9 schwarze 83: my $state = 0;
1.1 schwarze 84: while (<$infd>) {
85: chomp;
86: if (!$state && s/.*<math class="eqn">//) {
1.9 schwarze 87: $state = 'math';
1.1 schwarze 88: next unless length;
1.12 ! schwarze 89: } elsif (/BEGINTEST/) {
1.9 schwarze 90: $state = 'other';
1.12 ! schwarze 91: next;
! 92: } elsif (/ENDTEST/) {
! 93: $state = 0;
! 94: next;
1.1 schwarze 95: }
1.9 schwarze 96: if ($state eq 'math') {
1.1 schwarze 97: s/^ *//;
1.9 schwarze 98: if (s/<\/math>.*//) {
99: print $outfd "$_\n" if length;
100: $state = 0;
101: next;
102: }
1.1 schwarze 103: }
104: print $outfd "$_\n" if $state;
105: }
106: close $outfd;
107: close $infd;
108: waitpid $pid, 0;
109: return 0;
110: }
111:
112: my @failures;
1.8 schwarze 113: sub fail ($$) {
1.1 schwarze 114: warn "FAILED: @_\n";
115: push @failures, [@_];
116: }
117:
118:
119: # --- process command line arguments -----------------------------------
120:
1.8 schwarze 121: my $onlytest = shift // '';
1.1 schwarze 122: for (@ARGV) {
1.4 schwarze 123: /^(all|ascii|utf8|man|html|markdown|lint|clean|verbose)$/
1.1 schwarze 124: or usage "$_: invalid modifier";
125: $targets{$_} = 1;
126: }
127: $targets{all} = 1
128: unless $targets{ascii} || $targets{utf8} || $targets{man} ||
1.4 schwarze 129: $targets{html} || $targets{markdown} ||
130: $targets{lint} || $targets{clean};
1.1 schwarze 131: $targets{ascii} = $targets{utf8} = $targets{man} = $targets{html} =
1.4 schwarze 132: $targets{markdown} = $targets{lint} = 1 if $targets{all};
1.1 schwarze 133:
134:
135: # --- parse Makefiles --------------------------------------------------
136:
1.8 schwarze 137: sub parse_makefile ($%) {
138: my ($filename, $vars) = @_;
1.1 schwarze 139: open my $fh, '<', $filename or die "$filename: $!";
140: while (<$fh>) {
141: chomp;
142: next unless /\S/;
143: last if /^# OpenBSD only/;
144: next if /^#/;
145: next if /^\.include/;
146: /^(\w+)\s*([?+]?)=\s*(.*)/
147: or die "$filename: parse error: $_";
148: my $var = $1;
149: my $opt = $2;
150: my $val = $3;
1.8 schwarze 151: $val =~ s/\$\{(\w+)\}/$vars->{$1}/;
152: $val = "$vars->{$var} $val" if $opt eq '+';
153: $vars->{$var} = $val
154: unless $opt eq '?' && defined $vars->{$var};
1.1 schwarze 155: }
156: close $fh;
157: }
158:
1.8 schwarze 159: my (@regress_tests, @utf8_tests, @lint_tests, @html_tests);
160: my (%skip_ascii, %skip_man, %skip_markdown);
161: foreach my $module (qw(roff char mdoc man tbl eqn)) {
162: my %modvars;
163: parse_makefile "$module/Makefile", \%modvars;
164: foreach my $subdir (split ' ', $modvars{SUBDIR}) {
165: my %subvars = (MOPTS => '');
166: parse_makefile "$module/$subdir/Makefile", \%subvars;
167: parse_makefile "$module/Makefile.inc", \%subvars;
168: delete $subvars{SKIP_GROFF};
169: delete $subvars{SKIP_GROFF_ASCII};
170: delete $subvars{TBL};
171: delete $subvars{EQN};
172: my @mandoc = ('../mandoc', split ' ', $subvars{MOPTS});
173: delete $subvars{MOPTS};
174: my @regress_testnames;
175: if (defined $subvars{REGRESS_TARGETS}) {
176: push @regress_testnames,
177: split ' ', $subvars{REGRESS_TARGETS};
178: push @regress_tests, {
179: NAME => "$module/$subdir/$_",
180: MANDOC => \@mandoc,
181: } foreach @regress_testnames;
182: delete $subvars{REGRESS_TARGETS};
183: }
184: if (defined $subvars{UTF8_TARGETS}) {
185: push @utf8_tests, {
186: NAME => "$module/$subdir/$_",
187: MANDOC => \@mandoc,
188: } foreach split ' ', $subvars{UTF8_TARGETS};
189: delete $subvars{UTF8_TARGETS};
190: }
191: if (defined $subvars{HTML_TARGETS}) {
192: push @html_tests, {
193: NAME => "$module/$subdir/$_",
194: MANDOC => \@mandoc,
195: } foreach split ' ', $subvars{HTML_TARGETS};
196: delete $subvars{HTML_TARGETS};
197: }
198: if (defined $subvars{LINT_TARGETS}) {
199: push @lint_tests, {
200: NAME => "$module/$subdir/$_",
201: MANDOC => \@mandoc,
202: } foreach split ' ', $subvars{LINT_TARGETS};
203: delete $subvars{LINT_TARGETS};
204: }
205: if (defined $subvars{SKIP_ASCII}) {
206: for (split ' ', $subvars{SKIP_ASCII}) {
207: $skip_ascii{"$module/$subdir/$_"} = 1;
208: $skip_man{"$module/$subdir/$_"} = 1;
209: }
210: delete $subvars{SKIP_ASCII};
211: }
212: if (defined $subvars{SKIP_TMAN}) {
213: $skip_man{"$module/$subdir/$_"} = 1
214: for split ' ', $subvars{SKIP_TMAN};
215: delete $subvars{SKIP_TMAN};
216: }
217: if (defined $subvars{SKIP_MARKDOWN}) {
218: $skip_markdown{"$module/$subdir/$_"} = 1
219: for split ' ', $subvars{SKIP_MARKDOWN};
220: delete $subvars{SKIP_MARKDOWN};
221: }
222: if (keys %subvars) {
223: my @vars = keys %subvars;
224: die "unknown var(s) @vars in dir $module/$subdir";
225: }
226: map {
227: $skip_ascii{"$module/$subdir/$_"} = 1;
228: } @regress_testnames if $skip_ascii{"$module/$subdir/ALL"};
229: map {
230: $skip_man{"$module/$subdir/$_"} = 1;
231: } @regress_testnames if $skip_man{"$module/$subdir/ALL"};
232: map {
233: $skip_markdown{"$module/$subdir/$_"} = 1;
234: } @regress_testnames if $skip_markdown{"$module/$subdir/ALL"};
235: }
236: delete $modvars{SUBDIR};
237: if (keys %modvars) {
238: my @vars = keys %modvars;
239: die "unknown var(s) @vars in module $module";
240: }
1.1 schwarze 241: }
242:
243: # --- run targets ------------------------------------------------------
244:
245: my $count_total = 0;
246: my $count_ascii = 0;
247: my $count_man = 0;
1.8 schwarze 248: my $count_rm = 0;
249: if ($targets{ascii} || $targets{man}) {
250: print "Running ascii and man tests ";
251: print "...\n" if $targets{verbose};
252: }
253: for my $test (@regress_tests) {
254: my $i = "$test->{NAME}.in";
255: my $o = "$test->{NAME}.mandoc_ascii";
256: my $w = "$test->{NAME}.out_ascii";
257: if ($targets{ascii} && !$skip_ascii{$test->{NAME}} &&
258: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 259: $count_ascii++;
260: $count_total++;
1.8 schwarze 261: sysout $o, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T ascii), $i
262: and fail $test->{NAME}, 'ascii:mandoc';
1.2 schwarze 263: system @diff, $w, $o
1.8 schwarze 264: and fail $test->{NAME}, 'ascii:diff';
265: print "." unless $targets{verbose};
1.1 schwarze 266: }
1.8 schwarze 267: my $m = "$test->{NAME}.in_man";
268: my $mo = "$test->{NAME}.mandoc_man";
269: if ($targets{man} && !$skip_man{$test->{NAME}} &&
270: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 271: $count_man++;
272: $count_total++;
1.8 schwarze 273: sysout $m, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T man), $i
274: and fail $test->{NAME}, 'man:man';
275: sysout $mo, @{$test->{MANDOC}},
276: qw(-man -I os=OpenBSD -T ascii -O mdoc), $m
277: and fail $test->{NAME}, 'man:mandoc';
1.2 schwarze 278: system @diff, $w, $mo
1.8 schwarze 279: and fail $test->{NAME}, 'man:diff';
280: print "." unless $targets{verbose};
1.1 schwarze 281: }
282: if ($targets{clean}) {
1.8 schwarze 283: print "rm $o $m $mo\n" if $targets{verbose};
284: $count_rm += unlink $o, $m, $mo;
1.1 schwarze 285: }
286: }
1.8 schwarze 287: if ($targets{ascii} || $targets{man}) {
288: print "Number of ascii and man tests:" if $targets{verbose};
289: print " $count_ascii + $count_man tests run.\n";
290: }
1.1 schwarze 291:
292: my $count_utf8 = 0;
1.8 schwarze 293: if ($targets{utf8}) {
294: print "Running utf8 tests ";
295: print "...\n" if $targets{verbose};
296: }
297: for my $test (@utf8_tests) {
298: my $i = "$test->{NAME}.in";
299: my $o = "$test->{NAME}.mandoc_utf8";
300: my $w = "$test->{NAME}.out_utf8";
301: if ($targets{utf8} && $test->{NAME} =~ /^$onlytest/o) {
1.1 schwarze 302: $count_utf8++;
303: $count_total++;
1.8 schwarze 304: sysout $o, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T utf8), $i
305: and fail $test->{NAME}, 'utf8:mandoc';
1.2 schwarze 306: system @diff, $w, $o
1.8 schwarze 307: and fail $test->{NAME}, 'utf8:diff';
308: print "." unless $targets{verbose};
1.1 schwarze 309: }
310: if ($targets{clean}) {
311: print "rm $o\n" if $targets{verbose};
1.8 schwarze 312: $count_rm += unlink $o;
1.1 schwarze 313: }
314: }
1.8 schwarze 315: if ($targets{utf8}) {
316: print "Number of utf8 tests:" if $targets{verbose};
317: print " $count_utf8 tests run.\n";
318: }
1.1 schwarze 319:
320: my $count_html = 0;
1.8 schwarze 321: if ($targets{html}) {
322: print "Running html tests ";
323: print "...\n" if $targets{verbose};
324: }
325: for my $test (@html_tests) {
326: my $i = "$test->{NAME}.in";
327: my $o = "$test->{NAME}.mandoc_html";
328: my $w = "$test->{NAME}.out_html";
329: if ($targets{html} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 330: $count_html++;
331: $count_total++;
1.8 schwarze 332: syshtml $o, @{$test->{MANDOC}}, qw(-T html), $i
333: and fail $test->{NAME}, 'html:mandoc';
1.2 schwarze 334: system @diff, $w, $o
1.8 schwarze 335: and fail $test->{NAME}, 'html:diff';
336: print "." unless $targets{verbose};
1.1 schwarze 337: }
338: if ($targets{clean}) {
339: print "rm $o\n" if $targets{verbose};
1.8 schwarze 340: $count_rm += unlink $o;
1.1 schwarze 341: }
342: }
1.8 schwarze 343: if ($targets{html}) {
344: print "Number of html tests:" if $targets{verbose};
345: print " $count_html tests run.\n";
346: }
1.1 schwarze 347:
1.4 schwarze 348: my $count_markdown = 0;
1.8 schwarze 349: if ($targets{markdown}) {
350: print "Running markdown tests ";
351: print "...\n" if $targets{verbose};
352: }
353: for my $test (@regress_tests) {
354: my $i = "$test->{NAME}.in";
355: my $o = "$test->{NAME}.mandoc_markdown";
356: my $w = "$test->{NAME}.out_markdown";
357: if ($targets{markdown} && !$skip_markdown{$test->{NAME}} &&
358: $test->{NAME} =~ /^$onlytest/) {
1.4 schwarze 359: $count_markdown++;
360: $count_total++;
1.8 schwarze 361: sysout $o, @{$test->{MANDOC}},
362: qw(-I os=OpenBSD -T markdown), $i
363: and fail $test->{NAME}, 'markdown:mandoc';
1.4 schwarze 364: system @diff, $w, $o
1.8 schwarze 365: and fail $test->{NAME}, 'markdown:diff';
366: print "." unless $targets{verbose};
1.4 schwarze 367: }
368: if ($targets{clean}) {
369: print "rm $o\n" if $targets{verbose};
1.8 schwarze 370: $count_rm += unlink $o;
1.4 schwarze 371: }
372: }
1.8 schwarze 373: if ($targets{markdown}) {
374: print "Number of markdown tests:" if $targets{verbose};
375: print " $count_markdown tests run.\n";
376: }
1.4 schwarze 377:
1.1 schwarze 378: my $count_lint = 0;
1.8 schwarze 379: if ($targets{lint}) {
380: print "Running lint tests ";
381: print "...\n" if $targets{verbose};
382: }
383: for my $test (@lint_tests) {
384: my $i = "$test->{NAME}.in";
385: my $o = "$test->{NAME}.mandoc_lint";
386: my $w = "$test->{NAME}.out_lint";
387: if ($targets{lint} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 388: $count_lint++;
389: $count_total++;
1.8 schwarze 390: syslint $o, @{$test->{MANDOC}},
391: qw(-I os=OpenBSD -T lint -W all), $i
392: and fail $test->{NAME}, 'lint:mandoc';
1.2 schwarze 393: system @diff, $w, $o
1.8 schwarze 394: and fail $test->{NAME}, 'lint:diff';
395: print "." unless $targets{verbose};
1.1 schwarze 396: }
397: if ($targets{clean}) {
398: print "rm $o\n" if $targets{verbose};
1.8 schwarze 399: $count_rm += unlink $o;
1.1 schwarze 400: }
401: }
1.8 schwarze 402: if ($targets{lint}) {
403: print "Number of lint tests:" if $targets{verbose};
404: print " $count_lint tests run.\n";
405: }
1.1 schwarze 406:
1.8 schwarze 407: # --- final report -----------------------------------------------------
1.1 schwarze 408:
409: if (@failures) {
1.8 schwarze 410: print "\nNUMBER OF FAILED TESTS: ", scalar @failures,
411: " (of $count_total tests run.)\n";
1.1 schwarze 412: print "@$_\n" for @failures;
413: print "\n";
414: exit 1;
1.8 schwarze 415: }
416: print "\n" if $targets{verbose};
417: if ($count_total == 1) {
418: print "Test succeeded.\n";
1.1 schwarze 419: } elsif ($count_total) {
1.8 schwarze 420: print "All $count_total tests OK:";
421: print " $count_ascii ascii" if $count_ascii;
422: print " $count_man man" if $count_man;
423: print " $count_utf8 utf8" if $count_utf8;
424: print " $count_html html" if $count_html;
425: print " $count_markdown markdown" if $count_markdown;
426: print " $count_lint lint" if $count_lint;
427: print "\n";
1.1 schwarze 428: } else {
1.8 schwarze 429: print "No tests were run.\n";
1.11 schwarze 430: }
1.8 schwarze 431: if ($targets{clean}) {
432: if ($count_rm) {
433: print "Deleted $count_rm test output files.\n";
434: print "The tree is now clean.\n";
435: } else {
436: print "No test output files were found.\n";
437: print "The tree was already clean.\n";
438: }
439: }
1.1 schwarze 440: exit 0;
CVSweb