regress/regress.pl

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