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