regress/regress.pl

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