Annotation of mandoc/regress/regress.pl, Revision 1.13
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.13 ! schwarze 3: # $Id: regress.pl,v 1.12 2019/09/03 18:19:37 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;
1.13 ! schwarze 168: delete $subvars{GOPTS};
1.8 schwarze 169: delete $subvars{SKIP_GROFF};
170: delete $subvars{SKIP_GROFF_ASCII};
171: my @mandoc = ('../mandoc', split ' ', $subvars{MOPTS});
172: delete $subvars{MOPTS};
173: my @regress_testnames;
174: if (defined $subvars{REGRESS_TARGETS}) {
175: push @regress_testnames,
176: split ' ', $subvars{REGRESS_TARGETS};
177: push @regress_tests, {
178: NAME => "$module/$subdir/$_",
179: MANDOC => \@mandoc,
180: } foreach @regress_testnames;
181: delete $subvars{REGRESS_TARGETS};
182: }
183: if (defined $subvars{UTF8_TARGETS}) {
184: push @utf8_tests, {
185: NAME => "$module/$subdir/$_",
186: MANDOC => \@mandoc,
187: } foreach split ' ', $subvars{UTF8_TARGETS};
188: delete $subvars{UTF8_TARGETS};
189: }
190: if (defined $subvars{HTML_TARGETS}) {
191: push @html_tests, {
192: NAME => "$module/$subdir/$_",
193: MANDOC => \@mandoc,
194: } foreach split ' ', $subvars{HTML_TARGETS};
195: delete $subvars{HTML_TARGETS};
196: }
197: if (defined $subvars{LINT_TARGETS}) {
198: push @lint_tests, {
199: NAME => "$module/$subdir/$_",
200: MANDOC => \@mandoc,
201: } foreach split ' ', $subvars{LINT_TARGETS};
202: delete $subvars{LINT_TARGETS};
203: }
204: if (defined $subvars{SKIP_ASCII}) {
205: for (split ' ', $subvars{SKIP_ASCII}) {
206: $skip_ascii{"$module/$subdir/$_"} = 1;
207: $skip_man{"$module/$subdir/$_"} = 1;
208: }
209: delete $subvars{SKIP_ASCII};
210: }
211: if (defined $subvars{SKIP_TMAN}) {
212: $skip_man{"$module/$subdir/$_"} = 1
213: for split ' ', $subvars{SKIP_TMAN};
214: delete $subvars{SKIP_TMAN};
215: }
216: if (defined $subvars{SKIP_MARKDOWN}) {
217: $skip_markdown{"$module/$subdir/$_"} = 1
218: for split ' ', $subvars{SKIP_MARKDOWN};
219: delete $subvars{SKIP_MARKDOWN};
220: }
221: if (keys %subvars) {
222: my @vars = keys %subvars;
223: die "unknown var(s) @vars in dir $module/$subdir";
224: }
225: map {
226: $skip_ascii{"$module/$subdir/$_"} = 1;
227: } @regress_testnames if $skip_ascii{"$module/$subdir/ALL"};
228: map {
229: $skip_man{"$module/$subdir/$_"} = 1;
230: } @regress_testnames if $skip_man{"$module/$subdir/ALL"};
231: map {
232: $skip_markdown{"$module/$subdir/$_"} = 1;
233: } @regress_testnames if $skip_markdown{"$module/$subdir/ALL"};
234: }
235: delete $modvars{SUBDIR};
236: if (keys %modvars) {
237: my @vars = keys %modvars;
238: die "unknown var(s) @vars in module $module";
239: }
1.1 schwarze 240: }
241:
242: # --- run targets ------------------------------------------------------
243:
244: my $count_total = 0;
245: my $count_ascii = 0;
246: my $count_man = 0;
1.8 schwarze 247: my $count_rm = 0;
248: if ($targets{ascii} || $targets{man}) {
249: print "Running ascii and man tests ";
250: print "...\n" if $targets{verbose};
251: }
252: for my $test (@regress_tests) {
253: my $i = "$test->{NAME}.in";
254: my $o = "$test->{NAME}.mandoc_ascii";
255: my $w = "$test->{NAME}.out_ascii";
256: if ($targets{ascii} && !$skip_ascii{$test->{NAME}} &&
257: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 258: $count_ascii++;
259: $count_total++;
1.8 schwarze 260: sysout $o, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T ascii), $i
261: and fail $test->{NAME}, 'ascii:mandoc';
1.2 schwarze 262: system @diff, $w, $o
1.8 schwarze 263: and fail $test->{NAME}, 'ascii:diff';
264: print "." unless $targets{verbose};
1.1 schwarze 265: }
1.8 schwarze 266: my $m = "$test->{NAME}.in_man";
267: my $mo = "$test->{NAME}.mandoc_man";
268: if ($targets{man} && !$skip_man{$test->{NAME}} &&
269: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 270: $count_man++;
271: $count_total++;
1.8 schwarze 272: sysout $m, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T man), $i
273: and fail $test->{NAME}, 'man:man';
274: sysout $mo, @{$test->{MANDOC}},
275: qw(-man -I os=OpenBSD -T ascii -O mdoc), $m
276: and fail $test->{NAME}, 'man:mandoc';
1.2 schwarze 277: system @diff, $w, $mo
1.8 schwarze 278: and fail $test->{NAME}, 'man:diff';
279: print "." unless $targets{verbose};
1.1 schwarze 280: }
281: if ($targets{clean}) {
1.8 schwarze 282: print "rm $o $m $mo\n" if $targets{verbose};
283: $count_rm += unlink $o, $m, $mo;
1.1 schwarze 284: }
285: }
1.8 schwarze 286: if ($targets{ascii} || $targets{man}) {
287: print "Number of ascii and man tests:" if $targets{verbose};
288: print " $count_ascii + $count_man tests run.\n";
289: }
1.1 schwarze 290:
291: my $count_utf8 = 0;
1.8 schwarze 292: if ($targets{utf8}) {
293: print "Running utf8 tests ";
294: print "...\n" if $targets{verbose};
295: }
296: for my $test (@utf8_tests) {
297: my $i = "$test->{NAME}.in";
298: my $o = "$test->{NAME}.mandoc_utf8";
299: my $w = "$test->{NAME}.out_utf8";
300: if ($targets{utf8} && $test->{NAME} =~ /^$onlytest/o) {
1.1 schwarze 301: $count_utf8++;
302: $count_total++;
1.8 schwarze 303: sysout $o, @{$test->{MANDOC}}, qw(-I os=OpenBSD -T utf8), $i
304: and fail $test->{NAME}, 'utf8:mandoc';
1.2 schwarze 305: system @diff, $w, $o
1.8 schwarze 306: and fail $test->{NAME}, 'utf8:diff';
307: print "." unless $targets{verbose};
1.1 schwarze 308: }
309: if ($targets{clean}) {
310: print "rm $o\n" if $targets{verbose};
1.8 schwarze 311: $count_rm += unlink $o;
1.1 schwarze 312: }
313: }
1.8 schwarze 314: if ($targets{utf8}) {
315: print "Number of utf8 tests:" if $targets{verbose};
316: print " $count_utf8 tests run.\n";
317: }
1.1 schwarze 318:
319: my $count_html = 0;
1.8 schwarze 320: if ($targets{html}) {
321: print "Running html tests ";
322: print "...\n" if $targets{verbose};
323: }
324: for my $test (@html_tests) {
325: my $i = "$test->{NAME}.in";
326: my $o = "$test->{NAME}.mandoc_html";
327: my $w = "$test->{NAME}.out_html";
328: if ($targets{html} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 329: $count_html++;
330: $count_total++;
1.8 schwarze 331: syshtml $o, @{$test->{MANDOC}}, qw(-T html), $i
332: and fail $test->{NAME}, 'html:mandoc';
1.2 schwarze 333: system @diff, $w, $o
1.8 schwarze 334: and fail $test->{NAME}, 'html:diff';
335: print "." unless $targets{verbose};
1.1 schwarze 336: }
337: if ($targets{clean}) {
338: print "rm $o\n" if $targets{verbose};
1.8 schwarze 339: $count_rm += unlink $o;
1.1 schwarze 340: }
341: }
1.8 schwarze 342: if ($targets{html}) {
343: print "Number of html tests:" if $targets{verbose};
344: print " $count_html tests run.\n";
345: }
1.1 schwarze 346:
1.4 schwarze 347: my $count_markdown = 0;
1.8 schwarze 348: if ($targets{markdown}) {
349: print "Running markdown tests ";
350: print "...\n" if $targets{verbose};
351: }
352: for my $test (@regress_tests) {
353: my $i = "$test->{NAME}.in";
354: my $o = "$test->{NAME}.mandoc_markdown";
355: my $w = "$test->{NAME}.out_markdown";
356: if ($targets{markdown} && !$skip_markdown{$test->{NAME}} &&
357: $test->{NAME} =~ /^$onlytest/) {
1.4 schwarze 358: $count_markdown++;
359: $count_total++;
1.8 schwarze 360: sysout $o, @{$test->{MANDOC}},
361: qw(-I os=OpenBSD -T markdown), $i
362: and fail $test->{NAME}, 'markdown:mandoc';
1.4 schwarze 363: system @diff, $w, $o
1.8 schwarze 364: and fail $test->{NAME}, 'markdown:diff';
365: print "." unless $targets{verbose};
1.4 schwarze 366: }
367: if ($targets{clean}) {
368: print "rm $o\n" if $targets{verbose};
1.8 schwarze 369: $count_rm += unlink $o;
1.4 schwarze 370: }
371: }
1.8 schwarze 372: if ($targets{markdown}) {
373: print "Number of markdown tests:" if $targets{verbose};
374: print " $count_markdown tests run.\n";
375: }
1.4 schwarze 376:
1.1 schwarze 377: my $count_lint = 0;
1.8 schwarze 378: if ($targets{lint}) {
379: print "Running lint tests ";
380: print "...\n" if $targets{verbose};
381: }
382: for my $test (@lint_tests) {
383: my $i = "$test->{NAME}.in";
384: my $o = "$test->{NAME}.mandoc_lint";
385: my $w = "$test->{NAME}.out_lint";
386: if ($targets{lint} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 387: $count_lint++;
388: $count_total++;
1.8 schwarze 389: syslint $o, @{$test->{MANDOC}},
390: qw(-I os=OpenBSD -T lint -W all), $i
391: and fail $test->{NAME}, 'lint:mandoc';
1.2 schwarze 392: system @diff, $w, $o
1.8 schwarze 393: and fail $test->{NAME}, 'lint:diff';
394: print "." unless $targets{verbose};
1.1 schwarze 395: }
396: if ($targets{clean}) {
397: print "rm $o\n" if $targets{verbose};
1.8 schwarze 398: $count_rm += unlink $o;
1.1 schwarze 399: }
400: }
1.8 schwarze 401: if ($targets{lint}) {
402: print "Number of lint tests:" if $targets{verbose};
403: print " $count_lint tests run.\n";
404: }
1.1 schwarze 405:
1.8 schwarze 406: # --- final report -----------------------------------------------------
1.1 schwarze 407:
408: if (@failures) {
1.8 schwarze 409: print "\nNUMBER OF FAILED TESTS: ", scalar @failures,
410: " (of $count_total tests run.)\n";
1.1 schwarze 411: print "@$_\n" for @failures;
412: print "\n";
413: exit 1;
1.8 schwarze 414: }
415: print "\n" if $targets{verbose};
416: if ($count_total == 1) {
417: print "Test succeeded.\n";
1.1 schwarze 418: } elsif ($count_total) {
1.8 schwarze 419: print "All $count_total tests OK:";
420: print " $count_ascii ascii" if $count_ascii;
421: print " $count_man man" if $count_man;
422: print " $count_utf8 utf8" if $count_utf8;
423: print " $count_html html" if $count_html;
424: print " $count_markdown markdown" if $count_markdown;
425: print " $count_lint lint" if $count_lint;
426: print "\n";
1.1 schwarze 427: } else {
1.8 schwarze 428: print "No tests were run.\n";
1.11 schwarze 429: }
1.8 schwarze 430: if ($targets{clean}) {
431: if ($count_rm) {
432: print "Deleted $count_rm test output files.\n";
433: print "The tree is now clean.\n";
434: } else {
435: print "No test output files were found.\n";
436: print "The tree was already clean.\n";
437: }
438: }
1.1 schwarze 439: 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