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