Annotation of mandoc/regress/regress.pl, Revision 1.16
1.1 schwarze 1: #!/usr/bin/env perl
2: #
1.16 ! schwarze 3: # $Id: regress.pl,v 1.15 2020/07/21 15:14:20 schwarze Exp $
1.1 schwarze 4: #
1.16 ! schwarze 5: # Copyright (c) 2017,2018,2019,2020,2021 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";
1.16 ! schwarze 264: my $tos = "$test->{NAME}.mandoc_tag_s";
1.14 schwarze 265: my $tw = "$test->{NAME}.out_tag";
266: my $diff_ascii;
267: if ($targets{tag} && $tag_tests{$test->{NAME}} &&
268: $test->{NAME} =~ /^$onlytest/) {
269: $count_tag++;
270: $count_total++;
271: my @cmd = (qw(../man -l), @{$test->{MOPTS}},
1.15 schwarze 272: qw(-I os=OpenBSD -T ascii -O),
273: "outfilename=$o,tagfilename=$to", "$i");
1.14 schwarze 274: print "@cmd\n" if $targets{verbose};
275: system @cmd
276: and fail $test->{NAME}, 'tag:man';
1.16 ! schwarze 277: system "sed 's: .*/: :' $to > $tos";
! 278: system @diff, $tw, $tos
1.14 schwarze 279: and fail $test->{NAME}, 'tag:diff';
280: print "." unless $targets{verbose};
281: $diff_ascii = $targets{ascii};
282: } elsif ($targets{ascii} && !$skip_ascii{$test->{NAME}} &&
1.8 schwarze 283: $test->{NAME} =~ /^$onlytest/) {
1.14 schwarze 284: sysout $o, '../mandoc', @{$test->{MOPTS}},
285: qw(-I os=OpenBSD -T ascii), $i
286: and fail $test->{NAME}, 'ascii:mandoc';
287: $diff_ascii = 1;
288: }
289: if ($diff_ascii) {
1.1 schwarze 290: $count_ascii++;
291: $count_total++;
1.2 schwarze 292: system @diff, $w, $o
1.8 schwarze 293: and fail $test->{NAME}, 'ascii:diff';
294: print "." unless $targets{verbose};
1.1 schwarze 295: }
1.8 schwarze 296: my $m = "$test->{NAME}.in_man";
297: my $mo = "$test->{NAME}.mandoc_man";
298: if ($targets{man} && !$skip_man{$test->{NAME}} &&
299: $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 300: $count_man++;
301: $count_total++;
1.14 schwarze 302: sysout $m, '../mandoc', @{$test->{MOPTS}},
303: qw(-I os=OpenBSD -T man), $i
1.8 schwarze 304: and fail $test->{NAME}, 'man:man';
1.14 schwarze 305: sysout $mo, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 306: qw(-man -I os=OpenBSD -T ascii -O mdoc), $m
307: and fail $test->{NAME}, 'man:mandoc';
1.2 schwarze 308: system @diff, $w, $mo
1.8 schwarze 309: and fail $test->{NAME}, 'man:diff';
310: print "." unless $targets{verbose};
1.1 schwarze 311: }
312: if ($targets{clean}) {
1.16 ! schwarze 313: print "rm $o $to $tos $m $mo\n" if $targets{verbose};
! 314: $count_rm += unlink $o, $to, $tos, $m, $mo;
1.1 schwarze 315: }
316: }
1.14 schwarze 317: if ($targets{ascii} || $targets{tag} || $targets{man}) {
318: print "Number of ascii, tag, and man tests:" if $targets{verbose};
319: print " $count_ascii + $count_tag + $count_man tests run.\n";
1.8 schwarze 320: }
1.1 schwarze 321:
322: my $count_utf8 = 0;
1.8 schwarze 323: if ($targets{utf8}) {
324: print "Running utf8 tests ";
325: print "...\n" if $targets{verbose};
326: }
327: for my $test (@utf8_tests) {
328: my $i = "$test->{NAME}.in";
329: my $o = "$test->{NAME}.mandoc_utf8";
330: my $w = "$test->{NAME}.out_utf8";
331: if ($targets{utf8} && $test->{NAME} =~ /^$onlytest/o) {
1.1 schwarze 332: $count_utf8++;
333: $count_total++;
1.14 schwarze 334: sysout $o, '../mandoc', @{$test->{MOPTS}},
335: qw(-I os=OpenBSD -T utf8), $i
1.8 schwarze 336: and fail $test->{NAME}, 'utf8:mandoc';
1.2 schwarze 337: system @diff, $w, $o
1.8 schwarze 338: and fail $test->{NAME}, 'utf8:diff';
339: print "." unless $targets{verbose};
1.1 schwarze 340: }
341: if ($targets{clean}) {
342: print "rm $o\n" if $targets{verbose};
1.8 schwarze 343: $count_rm += unlink $o;
1.1 schwarze 344: }
345: }
1.8 schwarze 346: if ($targets{utf8}) {
347: print "Number of utf8 tests:" if $targets{verbose};
348: print " $count_utf8 tests run.\n";
349: }
1.1 schwarze 350:
351: my $count_html = 0;
1.8 schwarze 352: if ($targets{html}) {
353: print "Running html tests ";
354: print "...\n" if $targets{verbose};
355: }
356: for my $test (@html_tests) {
357: my $i = "$test->{NAME}.in";
358: my $o = "$test->{NAME}.mandoc_html";
359: my $w = "$test->{NAME}.out_html";
360: if ($targets{html} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 361: $count_html++;
362: $count_total++;
1.14 schwarze 363: syshtml $o, '../mandoc', @{$test->{MOPTS}},
364: qw(-T html), $i
1.8 schwarze 365: and fail $test->{NAME}, 'html:mandoc';
1.2 schwarze 366: system @diff, $w, $o
1.8 schwarze 367: and fail $test->{NAME}, 'html:diff';
368: print "." unless $targets{verbose};
1.1 schwarze 369: }
370: if ($targets{clean}) {
371: print "rm $o\n" if $targets{verbose};
1.8 schwarze 372: $count_rm += unlink $o;
1.1 schwarze 373: }
374: }
1.8 schwarze 375: if ($targets{html}) {
376: print "Number of html tests:" if $targets{verbose};
377: print " $count_html tests run.\n";
378: }
1.1 schwarze 379:
1.4 schwarze 380: my $count_markdown = 0;
1.8 schwarze 381: if ($targets{markdown}) {
382: print "Running markdown tests ";
383: print "...\n" if $targets{verbose};
384: }
385: for my $test (@regress_tests) {
386: my $i = "$test->{NAME}.in";
387: my $o = "$test->{NAME}.mandoc_markdown";
388: my $w = "$test->{NAME}.out_markdown";
389: if ($targets{markdown} && !$skip_markdown{$test->{NAME}} &&
390: $test->{NAME} =~ /^$onlytest/) {
1.4 schwarze 391: $count_markdown++;
392: $count_total++;
1.14 schwarze 393: sysout $o, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 394: qw(-I os=OpenBSD -T markdown), $i
395: and fail $test->{NAME}, 'markdown:mandoc';
1.4 schwarze 396: system @diff, $w, $o
1.8 schwarze 397: and fail $test->{NAME}, 'markdown:diff';
398: print "." unless $targets{verbose};
1.4 schwarze 399: }
400: if ($targets{clean}) {
401: print "rm $o\n" if $targets{verbose};
1.8 schwarze 402: $count_rm += unlink $o;
1.4 schwarze 403: }
404: }
1.8 schwarze 405: if ($targets{markdown}) {
406: print "Number of markdown tests:" if $targets{verbose};
407: print " $count_markdown tests run.\n";
408: }
1.4 schwarze 409:
1.1 schwarze 410: my $count_lint = 0;
1.8 schwarze 411: if ($targets{lint}) {
412: print "Running lint tests ";
413: print "...\n" if $targets{verbose};
414: }
415: for my $test (@lint_tests) {
416: my $i = "$test->{NAME}.in";
417: my $o = "$test->{NAME}.mandoc_lint";
418: my $w = "$test->{NAME}.out_lint";
419: if ($targets{lint} && $test->{NAME} =~ /^$onlytest/) {
1.1 schwarze 420: $count_lint++;
421: $count_total++;
1.14 schwarze 422: syslint $o, '../mandoc', @{$test->{MOPTS}},
1.8 schwarze 423: qw(-I os=OpenBSD -T lint -W all), $i
424: and fail $test->{NAME}, 'lint:mandoc';
1.2 schwarze 425: system @diff, $w, $o
1.8 schwarze 426: and fail $test->{NAME}, 'lint:diff';
427: print "." unless $targets{verbose};
1.1 schwarze 428: }
429: if ($targets{clean}) {
430: print "rm $o\n" if $targets{verbose};
1.8 schwarze 431: $count_rm += unlink $o;
1.1 schwarze 432: }
433: }
1.8 schwarze 434: if ($targets{lint}) {
435: print "Number of lint tests:" if $targets{verbose};
436: print " $count_lint tests run.\n";
437: }
1.1 schwarze 438:
1.8 schwarze 439: # --- final report -----------------------------------------------------
1.1 schwarze 440:
441: if (@failures) {
1.8 schwarze 442: print "\nNUMBER OF FAILED TESTS: ", scalar @failures,
443: " (of $count_total tests run.)\n";
1.1 schwarze 444: print "@$_\n" for @failures;
445: print "\n";
446: exit 1;
1.8 schwarze 447: }
448: print "\n" if $targets{verbose};
449: if ($count_total == 1) {
450: print "Test succeeded.\n";
1.1 schwarze 451: } elsif ($count_total) {
1.8 schwarze 452: print "All $count_total tests OK:";
453: print " $count_ascii ascii" if $count_ascii;
1.14 schwarze 454: print " $count_tag tag" if $count_tag;
1.8 schwarze 455: print " $count_man man" if $count_man;
456: print " $count_utf8 utf8" if $count_utf8;
457: print " $count_html html" if $count_html;
458: print " $count_markdown markdown" if $count_markdown;
459: print " $count_lint lint" if $count_lint;
460: print "\n";
1.1 schwarze 461: } else {
1.8 schwarze 462: print "No tests were run.\n";
1.11 schwarze 463: }
1.8 schwarze 464: if ($targets{clean}) {
465: if ($count_rm) {
466: print "Deleted $count_rm test output files.\n";
467: print "The tree is now clean.\n";
468: } else {
469: print "No test output files were found.\n";
470: print "The tree was already clean.\n";
471: }
472: }
1.1 schwarze 473: 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