regress/regress.pl

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