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