Annotation of mandoc/regress/regress.pl, Revision 1.4
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.4 ! schwarze 3: # $Id: regress.pl,v 1.3 2017/02/09 15:34:28 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.1 schwarze 166: my (%skip_ascii, %skip_man);
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: }
209: if (keys %vars) {
210: my @vars = keys %vars;
211: die "unknown var(s) @vars";
212: }
213: map { $skip_ascii{$_} = 1; } @regress_testnames if $skip_ascii{ALL};
214: map { $skip_man{$_} = 1; } @regress_testnames if $skip_man{ALL};
215:
216: # --- run targets ------------------------------------------------------
217:
218: my $count_total = 0;
219: for my $dirname (@subdir_names) {
220: $count_total++;
221: print "\n" if $targets{verbose};
222: system './regress.pl', "$subdir/$dirname", keys %targets,
223: ($displaylevel ? $displaylevel - 1 : 0),
224: and fail $subdir, $dirname, 'subdir';
225: }
226:
227: my $count_ascii = 0;
228: my $count_man = 0;
229: for my $testname (@regress_testnames) {
230: next if $onlytest && $testname ne $onlytest;
231: my $i = "$subdir/$testname.in";
232: my $o = "$subdir/$testname.mandoc_ascii";
233: my $w = "$subdir/$testname.out_ascii";
234: if ($targets{ascii} && !$skip_ascii{$testname}) {
235: $count_ascii++;
236: $count_total++;
237: print "@mandoc -T ascii $i\n" if $targets{verbose};
238: sysout $o, @mandoc, qw(-T ascii), $i
239: and fail $subdir, $testname, 'ascii:mandoc';
1.2 schwarze 240: system @diff, $w, $o
1.1 schwarze 241: and fail $subdir, $testname, 'ascii:diff';
242: }
243: my $m = "$subdir/$testname.in_man";
244: my $mo = "$subdir/$testname.mandoc_man";
245: if ($targets{man} && !$skip_man{$testname}) {
246: $count_man++;
247: $count_total++;
248: print "@mandoc -T man $i\n" if $targets{verbose};
249: sysout $m, @mandoc, qw(-T man), $i
250: and fail $subdir, $testname, 'man:man';
251: print "@mandoc -man -T ascii $m\n" if $targets{verbose};
252: sysout $mo, @mandoc, qw(-man -T ascii -O mdoc), $m
253: and fail $subdir, $testname, 'man:mandoc';
1.2 schwarze 254: system @diff, $w, $mo
1.1 schwarze 255: and fail $subdir, $testname, 'man:diff';
256: }
257: if ($targets{clean}) {
258: print "rm $o\n"
259: if $targets{verbose} && !$skip_ascii{$testname};
260: unlink $o;
261: print "rm $m $mo\n"
262: if $targets{verbose} && !$skip_man{$testname};
263: unlink $m, $mo;
264: }
265: }
266:
267: my $count_utf8 = 0;
268: for my $testname (@utf8_testnames) {
269: next if $onlytest && $testname ne $onlytest;
270: my $i = "$subdir/$testname.in";
271: my $o = "$subdir/$testname.mandoc_utf8";
272: my $w = "$subdir/$testname.out_utf8";
273: if ($targets{utf8}) {
274: $count_utf8++;
275: $count_total++;
276: print "@mandoc -T utf8 $i\n" if $targets{verbose};
277: sysout $o, @mandoc, qw(-T utf8), $i
278: and fail $subdir, $testname, 'utf8:mandoc';
1.2 schwarze 279: system @diff, $w, $o
1.1 schwarze 280: and fail $subdir, $testname, 'utf8:diff';
281: }
282: if ($targets{clean}) {
283: print "rm $o\n" if $targets{verbose};
284: unlink $o;
285: }
286: }
287:
288: my $count_html = 0;
289: for my $testname (@html_testnames) {
290: next if $onlytest && $testname ne $onlytest;
291: my $i = "$subdir/$testname.in";
292: my $o = "$subdir/$testname.mandoc_html";
293: my $w = "$subdir/$testname.out_html";
294: if ($targets{html}) {
295: $count_html++;
296: $count_total++;
297: print "@mandoc -T html $i\n" if $targets{verbose};
298: syshtml $o, @mandoc, qw(-T html), $i
299: and fail $subdir, $testname, 'html:mandoc';
1.2 schwarze 300: system @diff, $w, $o
1.1 schwarze 301: and fail $subdir, $testname, 'html:diff';
302: }
303: if ($targets{clean}) {
304: print "rm $o\n" if $targets{verbose};
305: unlink $o;
306: }
307: }
308:
1.4 ! schwarze 309: my $count_markdown = 0;
! 310: for my $testname (@markdown_testnames) {
! 311: next if $onlytest && $testname ne $onlytest;
! 312: my $i = "$subdir/$testname.in";
! 313: my $o = "$subdir/$testname.mandoc_markdown";
! 314: my $w = "$subdir/$testname.out_markdown";
! 315: if ($targets{markdown}) {
! 316: $count_markdown++;
! 317: $count_total++;
! 318: print "@mandoc -T markdown $i\n" if $targets{verbose};
! 319: sysout $o, @mandoc, qw(-T markdown), $i
! 320: and fail $subdir, $testname, 'markdown:mandoc';
! 321: system @diff, $w, $o
! 322: and fail $subdir, $testname, 'markdown:diff';
! 323: }
! 324: if ($targets{clean}) {
! 325: print "rm $o\n" if $targets{verbose};
! 326: unlink $o;
! 327: }
! 328: }
! 329:
1.1 schwarze 330: my $count_lint = 0;
331: for my $testname (@lint_testnames) {
332: next if $onlytest && $testname ne $onlytest;
333: my $i = "$subdir/$testname.in";
334: my $o = "$subdir/$testname.mandoc_lint";
335: my $w = "$subdir/$testname.out_lint";
336: if ($targets{lint}) {
337: $count_lint++;
338: $count_total++;
339: print "@mandoc -T lint $i\n" if $targets{verbose};
340: syslint $o, @mandoc, qw(-T lint), $i
341: and fail $subdir, $testname, 'lint:mandoc';
1.2 schwarze 342: system @diff, $w, $o
1.1 schwarze 343: and fail $subdir, $testname, 'lint:diff';
344: }
345: if ($targets{clean}) {
346: print "rm $o\n" if $targets{verbose};
347: unlink $o;
348: }
349: }
350:
351: exit 0 unless $displaylevel or @failures;
352:
353: print "\n" if $targets{verbose};
354: if ($onlytest) {
355: print "test $subdir:$onlytest finished";
356: } else {
357: print "testsuite $subdir finished";
358: }
359: print ' ', (scalar @subdir_names), ' subdirectories' if @subdir_names;
360: print " $count_ascii ascii" if $count_ascii;
361: print " $count_man man" if $count_man;
362: print " $count_utf8 utf8" if $count_utf8;
363: print " $count_html html" if $count_html;
1.4 ! schwarze 364: print " $count_markdown markdown" if $count_markdown;
1.1 schwarze 365: print " $count_lint lint" if $count_lint;
366:
367: if (@failures) {
368: print " (FAIL)\n\nSOME TESTS FAILED:\n\n";
369: print "@$_\n" for @failures;
370: print "\n";
371: exit 1;
372: } elsif ($count_total == 1) {
373: print " (OK)\n";
374: } elsif ($count_total) {
375: print " (all $count_total tests OK)\n";
376: } else {
377: print " (no tests run)\n";
378: }
379: exit 0;
CVSweb
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to regress.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [cvsweb.bsd.lv] / mandoc / regress