Annotation of mandoc/regress/regress.pl, Revision 1.15
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.15 ! schwarze 3: # $Id: regress.pl,v 1.14 2020/03/13 15:32:31 schwarze Exp $
1.1 schwarze 4: #
1.14 schwarze 5: # Copyright (c) 2017, 2018, 2019, 2020 Ingo Schwarze <schwarze@openbsd.org>
1.1 schwarze 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.14 schwarze 123: /^(all|ascii|tag|man|utf8|html|markdown|lint|clean|verbose)$/
1.1 schwarze 124: or usage "$_: invalid modifier";
125: $targets{$_} = 1;
126: }
127: $targets{all} = 1
1.14 schwarze 128: unless $targets{ascii} || $targets{tag} || $targets{man} ||
129: $targets{utf8} || $targets{html} || $targets{markdown} ||
1.4 schwarze 130: $targets{lint} || $targets{clean};
1.14 schwarze 131: $targets{ascii} = $targets{tag} = $targets{man} = $targets{utf8} =
132: $targets{html} = $targets{markdown} = $targets{lint} = 1
133: if $targets{all};
1.1 schwarze 134:
135:
136: # --- parse Makefiles --------------------------------------------------
137:
1.8 schwarze 138: sub parse_makefile ($%) {
139: my ($filename, $vars) = @_;
1.1 schwarze 140: open my $fh, '<', $filename or die "$filename: $!";
141: while (<$fh>) {
142: chomp;
143: next unless /\S/;
144: last if /^# OpenBSD only/;
145: next if /^#/;
146: next if /^\.include/;
147: /^(\w+)\s*([?+]?)=\s*(.*)/
148: or die "$filename: parse error: $_";
149: my $var = $1;
150: my $opt = $2;
151: my $val = $3;
1.8 schwarze 152: $val =~ s/\$\{(\w+)\}/$vars->{$1}/;
153: $val = "$vars->{$var} $val" if $opt eq '+';
154: $vars->{$var} = $val
155: unless $opt eq '?' && defined $vars->{$var};
1.1 schwarze 156: }
157: close $fh;
158: }
159:
1.8 schwarze 160: my (@regress_tests, @utf8_tests, @lint_tests, @html_tests);
1.14 schwarze 161: my (%tag_tests, %skip_ascii, %skip_man, %skip_markdown);
1.8 schwarze 162: foreach my $module (qw(roff char mdoc man tbl eqn)) {
163: my %modvars;
164: parse_makefile "$module/Makefile", \%modvars;
165: foreach my $subdir (split ' ', $modvars{SUBDIR}) {
166: my %subvars = (MOPTS => '');
167: parse_makefile "$module/$subdir/Makefile", \%subvars;
168: parse_makefile "$module/Makefile.inc", \%subvars;
1.13 schwarze 169: delete $subvars{GOPTS};
1.8 schwarze 170: delete $subvars{SKIP_GROFF};
171: delete $subvars{SKIP_GROFF_ASCII};
1.14 schwarze 172: my @mopts = split ' ', $subvars{MOPTS};
1.8 schwarze 173: delete $subvars{MOPTS};
174: my @regress_testnames;
1.14 schwarze 175: if (defined $subvars{TAG_TARGETS}) {
176: $tag_tests{"$module/$subdir/$_"} = 1
177: for split ' ', $subvars{TAG_TARGETS};
178: delete $subvars{TAG_TARGETS};
179: }
1.8 schwarze 180: if (defined $subvars{REGRESS_TARGETS}) {
181: push @regress_testnames,
182: split ' ', $subvars{REGRESS_TARGETS};
183: push @regress_tests, {
184: NAME => "$module/$subdir/$_",
1.14 schwarze 185: MOPTS => \@mopts,
1.8 schwarze 186: } foreach @regress_testnames;
187: delete $subvars{REGRESS_TARGETS};
188: }
189: if (defined $subvars{UTF8_TARGETS}) {
190: push @utf8_tests, {
191: NAME => "$module/$subdir/$_",
1.14 schwarze 192: MOPTS => \@mopts,
1.8 schwarze 193: } foreach split ' ', $subvars{UTF8_TARGETS};
194: delete $subvars{UTF8_TARGETS};
195: }
196: if (defined $subvars{HTML_TARGETS}) {
197: push @html_tests, {
198: NAME => "$module/$subdir/$_",
1.14 schwarze 199: MOPTS => \@mopts,
1.8 schwarze 200: } foreach split ' ', $subvars{HTML_TARGETS};
201: delete $subvars{HTML_TARGETS};
202: }
203: if (defined $subvars{LINT_TARGETS}) {
204: push @lint_tests, {
205: NAME => "$module/$subdir/$_",
1.14 schwarze 206: MOPTS => \@mopts,
1.8 schwarze 207: } foreach split ' ', $subvars{LINT_TARGETS};
208: delete $subvars{LINT_TARGETS};
209: }
210: if (defined $subvars{SKIP_ASCII}) {
211: for (split ' ', $subvars{SKIP_ASCII}) {
212: $skip_ascii{"$module/$subdir/$_"} = 1;
213: $skip_man{"$module/$subdir/$_"} = 1;
214: }
215: delete $subvars{SKIP_ASCII};
216: }
217: if (defined $subvars{SKIP_TMAN}) {
218: $skip_man{"$module/$subdir/$_"} = 1
219: for split ' ', $subvars{SKIP_TMAN};
220: delete $subvars{SKIP_TMAN};
221: }
222: if (defined $subvars{SKIP_MARKDOWN}) {
223: $skip_markdown{"$module/$subdir/$_"} = 1
224: for split ' ', $subvars{SKIP_MARKDOWN};
225: delete $subvars{SKIP_MARKDOWN};
226: }
227: if (keys %subvars) {
228: my @vars = keys %subvars;
229: die "unknown var(s) @vars in dir $module/$subdir";
230: }
231: map {
232: $skip_ascii{"$module/$subdir/$_"} = 1;
233: } @regress_testnames if $skip_ascii{"$module/$subdir/ALL"};
234: map {
235: $skip_man{"$module/$subdir/$_"} = 1;
236: } @regress_testnames if $skip_man{"$module/$subdir/ALL"};
237: map {
238: $skip_markdown{"$module/$subdir/$_"} = 1;
239: } @regress_testnames if $skip_markdown{"$module/$subdir/ALL"};
240: }
241: delete $modvars{SUBDIR};
242: if (keys %modvars) {
243: my @vars = keys %modvars;
244: die "unknown var(s) @vars in module $module";
245: }
1.1 schwarze 246: }
247:
248: # --- run targets ------------------------------------------------------
249:
250: my $count_total = 0;
251: my $count_ascii = 0;
1.14 schwarze 252: my $count_tag = 0;
1.1 schwarze 253: my $count_man = 0;
1.8 schwarze 254: my $count_rm = 0;
1.14 schwarze 255: if ($targets{ascii} || $targets{tag} || $targets{man}) {
256: print "Running ascii, tag, and man tests ";
1.8 schwarze 257: print "...\n" if $targets{verbose};
258: }
259: for my $test (@regress_tests) {
260: my $i = "$test->{NAME}.in";
261: my $o = "$test->{NAME}.mandoc_ascii";
262: my $w = "$test->{NAME}.out_ascii";
1.14 schwarze 263: my $to = "$test->{NAME}.mandoc_tag";
264: my $tw = "$test->{NAME}.out_tag";
265: my $diff_ascii;
266: if ($targets{tag} && $tag_tests{$test->{NAME}} &&
267: $test->{NAME} =~ /^$onlytest/) {
268: $count_tag++;
269: $count_total++;
270: my @cmd = (qw(../man -l), @{$test->{MOPTS}},
1.15 ! schwarze 271: qw(-I os=OpenBSD -T ascii -O),
! 272: "outfilename=$o,tagfilename=$to", "$i");
1.14 schwarze 273: print "@cmd\n" if $targets{verbose};
274: system @cmd
275: and fail $test->{NAME}, 'tag:man';
1.15 ! schwarze 276: system qw(sed -i), 's/ .*\// /', $to;
1.14 schwarze 277: system @diff, $tw, $to
278: and fail $test->{NAME}, 'tag:diff';
279: print "." unless $targets{verbose};
280: $diff_ascii = $targets{ascii};
281: } elsif ($targets{ascii} && !$skip_ascii{$test->{NAME}} &&
1.8 schwarze 282: $test->{NAME} =~ /^$onlytest/) {
1.14 schwarze 283: sysout $o, '../mandoc', @{$test->{MOPTS}},
284: qw(-I os=OpenBSD -T ascii), $i
285: and fail $test->{NAME}, 'ascii:mandoc';
286: $diff_ascii = 1;
287: }
288: if ($diff_ascii) {
1.1 schwarze 289: $count_ascii++;
290: $count_total++;
1.2 schwarze 291: system @diff, $w, $o
1.8 schwarze 292: and fail $test->{NAME}, 'ascii:diff';
293: print "." unless $targets{verbose};
1.1 schwarze 294: }
1.8 schwarze 295: my $m = "$test->{NAME}.in_man";
296: my $mo = "$test->{NAME}.mandoc_man";
297: if ($targets{man} && !$skip_man{$test->{NAME}} &&
298: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 299: $count_man++;
300: $count_total++;
1.14 schwarze 301: sysout $m, '../mandoc', @{$test->{MOPTS}},
302: qw(-I os=OpenBSD -T man), $i
1.8 schwarze 303: and fail $test->{NAME}, 'man:man';
1.14 schwarze 304: sysout $mo, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 305: qw(-man -I os=OpenBSD -T ascii -O mdoc), $m
306: and fail $test->{NAME}, 'man:mandoc';
1.2 schwarze 307: system @diff, $w, $mo
1.8 schwarze 308: and fail $test->{NAME}, 'man:diff';
309: print "." unless $targets{verbose};
1.1 schwarze 310: }
311: if ($targets{clean}) {
1.14 schwarze 312: print "rm $o $to $m $mo\n" if $targets{verbose};
313: $count_rm += unlink $o, $to, $m, $mo;
1.1 schwarze 314: }
315: }
1.14 schwarze 316: if ($targets{ascii} || $targets{tag} || $targets{man}) {
317: print "Number of ascii, tag, and man tests:" if $targets{verbose};
318: print " $count_ascii + $count_tag + $count_man tests run.\n";
1.8 schwarze 319: }
1.1 schwarze 320:
321: my $count_utf8 = 0;
1.8 schwarze 322: if ($targets{utf8}) {
323: print "Running utf8 tests ";
324: print "...\n" if $targets{verbose};
325: }
326: for my $test (@utf8_tests) {
327: my $i = "$test->{NAME}.in";
328: my $o = "$test->{NAME}.mandoc_utf8";
329: my $w = "$test->{NAME}.out_utf8";
330: if ($targets{utf8} && $test->{NAME} =~ /^$onlytest/o) {
1.1 schwarze 331: $count_utf8++;
332: $count_total++;
1.14 schwarze 333: sysout $o, '../mandoc', @{$test->{MOPTS}},
334: qw(-I os=OpenBSD -T utf8), $i
1.8 schwarze 335: and fail $test->{NAME}, 'utf8:mandoc';
1.2 schwarze 336: system @diff, $w, $o
1.8 schwarze 337: and fail $test->{NAME}, 'utf8:diff';
338: print "." unless $targets{verbose};
1.1 schwarze 339: }
340: if ($targets{clean}) {
341: print "rm $o\n" if $targets{verbose};
1.8 schwarze 342: $count_rm += unlink $o;
1.1 schwarze 343: }
344: }
1.8 schwarze 345: if ($targets{utf8}) {
346: print "Number of utf8 tests:" if $targets{verbose};
347: print " $count_utf8 tests run.\n";
348: }
1.1 schwarze 349:
350: my $count_html = 0;
1.8 schwarze 351: if ($targets{html}) {
352: print "Running html tests ";
353: print "...\n" if $targets{verbose};
354: }
355: for my $test (@html_tests) {
356: my $i = "$test->{NAME}.in";
357: my $o = "$test->{NAME}.mandoc_html";
358: my $w = "$test->{NAME}.out_html";
359: if ($targets{html} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 360: $count_html++;
361: $count_total++;
1.14 schwarze 362: syshtml $o, '../mandoc', @{$test->{MOPTS}},
363: qw(-T html), $i
1.8 schwarze 364: and fail $test->{NAME}, 'html:mandoc';
1.2 schwarze 365: system @diff, $w, $o
1.8 schwarze 366: and fail $test->{NAME}, 'html:diff';
367: print "." unless $targets{verbose};
1.1 schwarze 368: }
369: if ($targets{clean}) {
370: print "rm $o\n" if $targets{verbose};
1.8 schwarze 371: $count_rm += unlink $o;
1.1 schwarze 372: }
373: }
1.8 schwarze 374: if ($targets{html}) {
375: print "Number of html tests:" if $targets{verbose};
376: print " $count_html tests run.\n";
377: }
1.1 schwarze 378:
1.4 schwarze 379: my $count_markdown = 0;
1.8 schwarze 380: if ($targets{markdown}) {
381: print "Running markdown tests ";
382: print "...\n" if $targets{verbose};
383: }
384: for my $test (@regress_tests) {
385: my $i = "$test->{NAME}.in";
386: my $o = "$test->{NAME}.mandoc_markdown";
387: my $w = "$test->{NAME}.out_markdown";
388: if ($targets{markdown} && !$skip_markdown{$test->{NAME}} &&
389: $test->{NAME} =~ /^$onlytest/) {
1.4 schwarze 390: $count_markdown++;
391: $count_total++;
1.14 schwarze 392: sysout $o, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 393: qw(-I os=OpenBSD -T markdown), $i
394: and fail $test->{NAME}, 'markdown:mandoc';
1.4 schwarze 395: system @diff, $w, $o
1.8 schwarze 396: and fail $test->{NAME}, 'markdown:diff';
397: print "." unless $targets{verbose};
1.4 schwarze 398: }
399: if ($targets{clean}) {
400: print "rm $o\n" if $targets{verbose};
1.8 schwarze 401: $count_rm += unlink $o;
1.4 schwarze 402: }
403: }
1.8 schwarze 404: if ($targets{markdown}) {
405: print "Number of markdown tests:" if $targets{verbose};
406: print " $count_markdown tests run.\n";
407: }
1.4 schwarze 408:
1.1 schwarze 409: my $count_lint = 0;
1.8 schwarze 410: if ($targets{lint}) {
411: print "Running lint tests ";
412: print "...\n" if $targets{verbose};
413: }
414: for my $test (@lint_tests) {
415: my $i = "$test->{NAME}.in";
416: my $o = "$test->{NAME}.mandoc_lint";
417: my $w = "$test->{NAME}.out_lint";
418: if ($targets{lint} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 419: $count_lint++;
420: $count_total++;
1.14 schwarze 421: syslint $o, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 422: qw(-I os=OpenBSD -T lint -W all), $i
423: and fail $test->{NAME}, 'lint:mandoc';
1.2 schwarze 424: system @diff, $w, $o
1.8 schwarze 425: and fail $test->{NAME}, 'lint:diff';
426: print "." unless $targets{verbose};
1.1 schwarze 427: }
428: if ($targets{clean}) {
429: print "rm $o\n" if $targets{verbose};
1.8 schwarze 430: $count_rm += unlink $o;
1.1 schwarze 431: }
432: }
1.8 schwarze 433: if ($targets{lint}) {
434: print "Number of lint tests:" if $targets{verbose};
435: print " $count_lint tests run.\n";
436: }
1.1 schwarze 437:
1.8 schwarze 438: # --- final report -----------------------------------------------------
1.1 schwarze 439:
440: if (@failures) {
1.8 schwarze 441: print "\nNUMBER OF FAILED TESTS: ", scalar @failures,
442: " (of $count_total tests run.)\n";
1.1 schwarze 443: print "@$_\n" for @failures;
444: print "\n";
445: exit 1;
1.8 schwarze 446: }
447: print "\n" if $targets{verbose};
448: if ($count_total == 1) {
449: print "Test succeeded.\n";
1.1 schwarze 450: } elsif ($count_total) {
1.8 schwarze 451: print "All $count_total tests OK:";
452: print " $count_ascii ascii" if $count_ascii;
1.14 schwarze 453: print " $count_tag tag" if $count_tag;
1.8 schwarze 454: print " $count_man man" if $count_man;
455: print " $count_utf8 utf8" if $count_utf8;
456: print " $count_html html" if $count_html;
457: print " $count_markdown markdown" if $count_markdown;
458: print " $count_lint lint" if $count_lint;
459: print "\n";
1.1 schwarze 460: } else {
1.8 schwarze 461: print "No tests were run.\n";
1.11 schwarze 462: }
1.8 schwarze 463: if ($targets{clean}) {
464: if ($count_rm) {
465: print "Deleted $count_rm test output files.\n";
466: print "The tree is now clean.\n";
467: } else {
468: print "No test output files were found.\n";
469: print "The tree was already clean.\n";
470: }
471: }
1.1 schwarze 472: 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