[BACK]Return to regress.pl CVS log [TXT][DIR] Up to [cvsweb.bsd.lv] / mandoc / regress

Annotation of mandoc/regress/regress.pl, Revision 1.6

1.1       schwarze    1: #!/usr/bin/env perl
                      2: #
1.6     ! schwarze    3: # $Id: regress.pl,v 1.5 2017/03/08 22:54:22 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:
                     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:        }
1.4       schwarze  116:        /^(all|ascii|utf8|man|html|markdown|lint|clean|verbose)$/
1.1       schwarze  117:            or usage "$_: invalid modifier";
                    118:        $targets{$_} = 1;
                    119: }
                    120: $targets{all} = 1
                    121:     unless $targets{ascii} || $targets{utf8} || $targets{man} ||
1.4       schwarze  122:       $targets{html} || $targets{markdown} ||
                    123:       $targets{lint} || $targets{clean};
1.1       schwarze  124: $targets{ascii} = $targets{utf8} = $targets{man} = $targets{html} =
1.4       schwarze  125:     $targets{markdown} = $targets{lint} = 1 if $targets{all};
1.1       schwarze  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;
1.3       schwarze  146:                $val =~ s/\$\{(\w+)\}/$vars{$1}/;
1.1       schwarze  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;
1.4       schwarze  164: my (@regress_testnames, @utf8_testnames, @lint_testnames);
                    165: my (@html_testnames, @markdown_testnames);
1.5       schwarze  166: my (%skip_ascii, %skip_man, %skip_markdown);
1.1       schwarze  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: }
1.4       schwarze  190: if (defined $vars{MARKDOWN_TARGETS}) {
                    191:        @markdown_testnames = split ' ', $vars{MARKDOWN_TARGETS};
                    192:        delete $vars{MARKDOWN_TARGETS};
                    193: }
1.1       schwarze  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: }
1.5       schwarze  209: if (defined $vars{SKIP_MARKDOWN}) {
                    210:        $skip_markdown{$_} = 1 for split ' ', $vars{SKIP_MARKDOWN};
                    211:        delete $vars{SKIP_MARKDOWN};
                    212: }
1.1       schwarze  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};
1.5       schwarze  219: map { $skip_markdown{$_} = 1; } @regress_testnames if $skip_markdown{ALL};
1.1       schwarze  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';
1.2       schwarze  245:                system @diff, $w, $o
1.1       schwarze  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';
1.2       schwarze  259:                system @diff, $w, $mo
1.1       schwarze  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';
1.2       schwarze  284:                system @diff, $w, $o
1.1       schwarze  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';
1.2       schwarze  305:                system @diff, $w, $o
1.1       schwarze  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:
1.4       schwarze  314: my $count_markdown = 0;
1.5       schwarze  315: for my $testname (@regress_testnames) {
1.4       schwarze  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";
1.5       schwarze  320:        if ($targets{markdown} && !$skip_markdown{$testname}) {
1.4       schwarze  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:
1.1       schwarze  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++;
1.6     ! schwarze  344:                print "@mandoc -T lint -W all $i\n" if $targets{verbose};
        !           345:                syslint $o, @mandoc, qw(-T lint -W all), $i
1.1       schwarze  346:                    and fail $subdir, $testname, 'lint:mandoc';
1.2       schwarze  347:                system @diff, $w, $o
1.1       schwarze  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;
1.4       schwarze  369: print " $count_markdown markdown" if $count_markdown;
1.1       schwarze  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;

CVSweb