Annotation of mandoc/regress/regress.pl, Revision 1.7
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.7 ! schwarze 3: # $Id: regress.pl,v 1.6 2017/05/30 19:30:40 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);
30:
1.1 schwarze 31: # --- utility functions ------------------------------------------------
32:
33: sub usage ($) {
34: warn shift;
35: print STDERR "usage: $0 [directory[:test] [modifier ...]]\n";
36: exit 1;
37: }
38:
39: # Run a command and send STDOUT and STDERR to a file.
40: # 1st argument: path to the output file
41: # 2nd argument: command name
42: # The remaining arguments are passed to the command.
43: sub sysout ($@) {
44: my $outfile = shift;
45: local *OUT_FH;
46: open OUT_FH, '>', $outfile or die "$outfile: $!";
47: my $pid = open3 undef, ">&OUT_FH", undef, @_;
48: close OUT_FH;
49: waitpid $pid, 0;
50: return $? >> 8;
51: }
52:
53: # Simlar, but filter the output as needed for the lint test.
54: sub syslint ($@) {
55: my $outfile = shift;
56: open my $outfd, '>', $outfile or die "$outfile: $!";
57: my $infd;
58: my $pid = open3 undef, $infd, undef, @_;
59: while (<$infd>) {
60: s/^mandoc: [^:]+\//mandoc: /;
61: print $outfd $_;
62: }
63: close $outfd;
64: close $infd;
65: waitpid $pid, 0;
66: return 0;
67: }
68:
69: # Simlar, but filter the output as needed for the html test.
70: sub syshtml ($@) {
71: my $outfile = shift;
72: open my $outfd, '>', $outfile or die "$outfile: $!";
73: my $infd;
74: my $pid = open3 undef, $infd, undef, @_;
75: my $state;
76: while (<$infd>) {
77: chomp;
78: if (!$state && s/.*<math class="eqn">//) {
79: $state = 1;
80: next unless length;
81: }
82: $state = 1 if /^BEGINTEST/;
83: if ($state && s/<\/math>.*//) {
84: s/^ *//;
85: print $outfd "$_\n" if length;
86: undef $state;
87: next;
88: }
89: s/^ *//;
90: print $outfd "$_\n" if $state;
91: undef $state if /^ENDTEST/;
92: }
93: close $outfd;
94: close $infd;
95: waitpid $pid, 0;
96: return 0;
97: }
98:
99: my @failures;
100: sub fail ($$$) {
101: warn "FAILED: @_\n";
102: push @failures, [@_];
103: }
104:
105:
106: # --- process command line arguments -----------------------------------
107:
108: my ($subdir, $onlytest) = split ':', (shift // '.');
109: my $displaylevel = 2;
110: my %targets;
111: for (@ARGV) {
112: if (/^[0123]$/) {
113: $displaylevel = int;
114: next;
115: }
1.4 schwarze 116: /^(all|ascii|utf8|man|html|markdown|lint|clean|verbose)$/
1.1 schwarze 117: or usage "$_: invalid modifier";
118: $targets{$_} = 1;
119: }
120: $targets{all} = 1
121: unless $targets{ascii} || $targets{utf8} || $targets{man} ||
1.4 schwarze 122: $targets{html} || $targets{markdown} ||
123: $targets{lint} || $targets{clean};
1.1 schwarze 124: $targets{ascii} = $targets{utf8} = $targets{man} = $targets{html} =
1.4 schwarze 125: $targets{markdown} = $targets{lint} = 1 if $targets{all};
1.1 schwarze 126: $displaylevel = 3 if $targets{verbose};
127:
128:
129: # --- parse Makefiles --------------------------------------------------
130:
131: my %vars = (MOPTS => '');
132: sub parse_makefile ($) {
133: my $filename = shift;
134: open my $fh, '<', $filename or die "$filename: $!";
135: while (<$fh>) {
136: chomp;
137: next unless /\S/;
138: last if /^# OpenBSD only/;
139: next if /^#/;
140: next if /^\.include/;
141: /^(\w+)\s*([?+]?)=\s*(.*)/
142: or die "$filename: parse error: $_";
143: my $var = $1;
144: my $opt = $2;
145: my $val = $3;
1.3 schwarze 146: $val =~ s/\$\{(\w+)\}/$vars{$1}/;
1.1 schwarze 147: $val = "$vars{$var} $val" if $opt eq '+';
148: $vars{$var} = $val
149: unless $opt eq '?' && defined $vars{$var};
150: }
151: close $fh;
152: }
153:
154: if ($subdir eq '.') {
155: $vars{SUBDIR} = 'roff char mdoc man tbl eqn';
156: } else {
157: parse_makefile "$subdir/Makefile";
158: parse_makefile "$subdir/../Makefile.inc"
159: if -e "$subdir/../Makefile.inc";
160: }
161:
162: my @mandoc = '../mandoc';
163: my @subdir_names;
1.4 schwarze 164: my (@regress_testnames, @utf8_testnames, @lint_testnames);
165: my (@html_testnames, @markdown_testnames);
1.5 schwarze 166: my (%skip_ascii, %skip_man, %skip_markdown);
1.1 schwarze 167:
168: push @mandoc, split ' ', $vars{MOPTS} if $vars{MOPTS};
169: delete $vars{MOPTS};
170: delete $vars{SKIP_GROFF};
171: delete $vars{SKIP_GROFF_ASCII};
172: delete $vars{TBL};
173: delete $vars{EQN};
174: if (defined $vars{SUBDIR}) {
175: @subdir_names = split ' ', $vars{SUBDIR};
176: delete $vars{SUBDIR};
177: }
178: if (defined $vars{REGRESS_TARGETS}) {
179: @regress_testnames = split ' ', $vars{REGRESS_TARGETS};
180: delete $vars{REGRESS_TARGETS};
181: }
182: if (defined $vars{UTF8_TARGETS}) {
183: @utf8_testnames = split ' ', $vars{UTF8_TARGETS};
184: delete $vars{UTF8_TARGETS};
185: }
186: if (defined $vars{HTML_TARGETS}) {
187: @html_testnames = split ' ', $vars{HTML_TARGETS};
188: delete $vars{HTML_TARGETS};
189: }
1.4 schwarze 190: if (defined $vars{MARKDOWN_TARGETS}) {
191: @markdown_testnames = split ' ', $vars{MARKDOWN_TARGETS};
192: delete $vars{MARKDOWN_TARGETS};
193: }
1.1 schwarze 194: if (defined $vars{LINT_TARGETS}) {
195: @lint_testnames = split ' ', $vars{LINT_TARGETS};
196: delete $vars{LINT_TARGETS};
197: }
198: if (defined $vars{SKIP_ASCII}) {
199: for (split ' ', $vars{SKIP_ASCII}) {
200: $skip_ascii{$_} = 1;
201: $skip_man{$_} = 1;
202: }
203: delete $vars{SKIP_ASCII};
204: }
205: if (defined $vars{SKIP_TMAN}) {
206: $skip_man{$_} = 1 for split ' ', $vars{SKIP_TMAN};
207: delete $vars{SKIP_TMAN};
208: }
1.5 schwarze 209: if (defined $vars{SKIP_MARKDOWN}) {
210: $skip_markdown{$_} = 1 for split ' ', $vars{SKIP_MARKDOWN};
211: delete $vars{SKIP_MARKDOWN};
212: }
1.1 schwarze 213: if (keys %vars) {
214: my @vars = keys %vars;
215: die "unknown var(s) @vars";
216: }
217: map { $skip_ascii{$_} = 1; } @regress_testnames if $skip_ascii{ALL};
218: map { $skip_man{$_} = 1; } @regress_testnames if $skip_man{ALL};
1.5 schwarze 219: map { $skip_markdown{$_} = 1; } @regress_testnames if $skip_markdown{ALL};
1.1 schwarze 220:
221: # --- run targets ------------------------------------------------------
222:
223: my $count_total = 0;
224: for my $dirname (@subdir_names) {
225: $count_total++;
226: print "\n" if $targets{verbose};
227: system './regress.pl', "$subdir/$dirname", keys %targets,
228: ($displaylevel ? $displaylevel - 1 : 0),
229: and fail $subdir, $dirname, 'subdir';
230: }
231:
232: my $count_ascii = 0;
233: my $count_man = 0;
234: for my $testname (@regress_testnames) {
235: next if $onlytest && $testname ne $onlytest;
236: my $i = "$subdir/$testname.in";
237: my $o = "$subdir/$testname.mandoc_ascii";
238: my $w = "$subdir/$testname.out_ascii";
239: if ($targets{ascii} && !$skip_ascii{$testname}) {
240: $count_ascii++;
241: $count_total++;
242: print "@mandoc -T ascii $i\n" if $targets{verbose};
1.7 ! schwarze 243: sysout $o, @mandoc, qw(-I os=OpenBSD -T ascii), $i
1.1 schwarze 244: and fail $subdir, $testname, 'ascii:mandoc';
1.2 schwarze 245: system @diff, $w, $o
1.1 schwarze 246: and fail $subdir, $testname, 'ascii:diff';
247: }
248: my $m = "$subdir/$testname.in_man";
249: my $mo = "$subdir/$testname.mandoc_man";
250: if ($targets{man} && !$skip_man{$testname}) {
251: $count_man++;
252: $count_total++;
253: print "@mandoc -T man $i\n" if $targets{verbose};
1.7 ! schwarze 254: sysout $m, @mandoc, qw(-I os=OpenBSD -T man), $i
1.1 schwarze 255: and fail $subdir, $testname, 'man:man';
256: print "@mandoc -man -T ascii $m\n" if $targets{verbose};
1.7 ! schwarze 257: sysout $mo, @mandoc, qw(-man -I os=OpenBSD -T ascii -O mdoc), $m
1.1 schwarze 258: and fail $subdir, $testname, 'man:mandoc';
1.2 schwarze 259: system @diff, $w, $mo
1.1 schwarze 260: and fail $subdir, $testname, 'man:diff';
261: }
262: if ($targets{clean}) {
263: print "rm $o\n"
264: if $targets{verbose} && !$skip_ascii{$testname};
265: unlink $o;
266: print "rm $m $mo\n"
267: if $targets{verbose} && !$skip_man{$testname};
268: unlink $m, $mo;
269: }
270: }
271:
272: my $count_utf8 = 0;
273: for my $testname (@utf8_testnames) {
274: next if $onlytest && $testname ne $onlytest;
275: my $i = "$subdir/$testname.in";
276: my $o = "$subdir/$testname.mandoc_utf8";
277: my $w = "$subdir/$testname.out_utf8";
278: if ($targets{utf8}) {
279: $count_utf8++;
280: $count_total++;
281: print "@mandoc -T utf8 $i\n" if $targets{verbose};
1.7 ! schwarze 282: sysout $o, @mandoc, qw(-I os=OpenBSD -T utf8), $i
1.1 schwarze 283: and fail $subdir, $testname, 'utf8:mandoc';
1.2 schwarze 284: system @diff, $w, $o
1.1 schwarze 285: and fail $subdir, $testname, 'utf8:diff';
286: }
287: if ($targets{clean}) {
288: print "rm $o\n" if $targets{verbose};
289: unlink $o;
290: }
291: }
292:
293: my $count_html = 0;
294: for my $testname (@html_testnames) {
295: next if $onlytest && $testname ne $onlytest;
296: my $i = "$subdir/$testname.in";
297: my $o = "$subdir/$testname.mandoc_html";
298: my $w = "$subdir/$testname.out_html";
299: if ($targets{html}) {
300: $count_html++;
301: $count_total++;
302: print "@mandoc -T html $i\n" if $targets{verbose};
303: syshtml $o, @mandoc, qw(-T html), $i
304: and fail $subdir, $testname, 'html:mandoc';
1.2 schwarze 305: system @diff, $w, $o
1.1 schwarze 306: and fail $subdir, $testname, 'html:diff';
307: }
308: if ($targets{clean}) {
309: print "rm $o\n" if $targets{verbose};
310: unlink $o;
311: }
312: }
313:
1.4 schwarze 314: my $count_markdown = 0;
1.5 schwarze 315: for my $testname (@regress_testnames) {
1.4 schwarze 316: next if $onlytest && $testname ne $onlytest;
317: my $i = "$subdir/$testname.in";
318: my $o = "$subdir/$testname.mandoc_markdown";
319: my $w = "$subdir/$testname.out_markdown";
1.5 schwarze 320: if ($targets{markdown} && !$skip_markdown{$testname}) {
1.4 schwarze 321: $count_markdown++;
322: $count_total++;
323: print "@mandoc -T markdown $i\n" if $targets{verbose};
1.7 ! schwarze 324: sysout $o, @mandoc, qw(-I os=OpenBSD -T markdown), $i
1.4 schwarze 325: and fail $subdir, $testname, 'markdown:mandoc';
326: system @diff, $w, $o
327: and fail $subdir, $testname, 'markdown:diff';
328: }
329: if ($targets{clean}) {
330: print "rm $o\n" if $targets{verbose};
331: unlink $o;
332: }
333: }
334:
1.1 schwarze 335: my $count_lint = 0;
336: for my $testname (@lint_testnames) {
337: next if $onlytest && $testname ne $onlytest;
338: my $i = "$subdir/$testname.in";
339: my $o = "$subdir/$testname.mandoc_lint";
340: my $w = "$subdir/$testname.out_lint";
341: if ($targets{lint}) {
342: $count_lint++;
343: $count_total++;
1.6 schwarze 344: print "@mandoc -T lint -W all $i\n" if $targets{verbose};
1.7 ! schwarze 345: syslint $o, @mandoc, qw(-I os=OpenBSD -T lint -W all), $i
1.1 schwarze 346: and fail $subdir, $testname, 'lint:mandoc';
1.2 schwarze 347: system @diff, $w, $o
1.1 schwarze 348: and fail $subdir, $testname, 'lint:diff';
349: }
350: if ($targets{clean}) {
351: print "rm $o\n" if $targets{verbose};
352: unlink $o;
353: }
354: }
355:
356: exit 0 unless $displaylevel or @failures;
357:
358: print "\n" if $targets{verbose};
359: if ($onlytest) {
360: print "test $subdir:$onlytest finished";
361: } else {
362: print "testsuite $subdir finished";
363: }
364: print ' ', (scalar @subdir_names), ' subdirectories' if @subdir_names;
365: print " $count_ascii ascii" if $count_ascii;
366: print " $count_man man" if $count_man;
367: print " $count_utf8 utf8" if $count_utf8;
368: print " $count_html html" if $count_html;
1.4 schwarze 369: print " $count_markdown markdown" if $count_markdown;
1.1 schwarze 370: print " $count_lint lint" if $count_lint;
371:
372: if (@failures) {
373: print " (FAIL)\n\nSOME TESTS FAILED:\n\n";
374: print "@$_\n" for @failures;
375: print "\n";
376: exit 1;
377: } elsif ($count_total == 1) {
378: print " (OK)\n";
379: } elsif ($count_total) {
380: print " (all $count_total tests OK)\n";
381: } else {
382: print " (no tests run)\n";
383: }
384: exit 0;
CVSweb