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