regress/regress.pl

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