Finally port the OpenBSD regression suite.

Both kristaps@ and wiz@ repeated asked for this,
literally for years.

1 files changed, 347 insertions, 0 deletions

diff --git a/regress/regress.pl b/regress/regress.pl
new file mode 100755
index 00000000..65a3ecc5
--- /dev/null
+++ b/regress/regress.pl
@@ -0,0 +1,347 @@
+#!/usr/bin/env perl
+#
+# $Id: regress.pl,v 1.1 2017/02/08 03:02:13 schwarze Exp $
+#
+# Copyright (c) 2017 Ingo Schwarze <schwarze@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use warnings;
+use strict;
+
+# Used because open(3p) and open2(3p) provide no way for handling
+# STDERR of the child process, neither for appending it to STDOUT,
+# nor for piping it into the Perl program.
+use IPC::Open3 qw(open3);
+
+# --- utility functions ------------------------------------------------
+
+sub usage ($) {
+	warn shift;
+	print STDERR "usage: $0 [directory[:test] [modifier ...]]\n";
+	exit 1;
+}
+
+# Run a command and send STDOUT and STDERR to a file.
+# 1st argument: path to the output file
+# 2nd argument: command name
+# The remaining arguments are passed to the command.
+sub sysout ($@) {
+	my $outfile = shift;
+	local *OUT_FH;
+	open OUT_FH, '>', $outfile or die "$outfile: $!";
+	my $pid = open3 undef, ">&OUT_FH", undef, @_;
+	close OUT_FH;
+	waitpid $pid, 0;
+	return $? >> 8;
+}
+
+# Simlar, but filter the output as needed for the lint test.
+sub syslint ($@) {
+	my $outfile = shift;
+	open my $outfd, '>', $outfile or die "$outfile: $!";
+	my $infd;
+	my $pid = open3 undef, $infd, undef, @_;
+	while (<$infd>) {
+		s/^mandoc: [^:]+\//mandoc: /;
+		print $outfd $_;
+	}
+	close $outfd;
+	close $infd;
+	waitpid $pid, 0;
+	return 0;
+}
+
+# Simlar, but filter the output as needed for the html test.
+sub syshtml ($@) {
+	my $outfile = shift;
+	open my $outfd, '>', $outfile or die "$outfile: $!";
+	my $infd;
+	my $pid = open3 undef, $infd, undef, @_;
+	my $state;
+	while (<$infd>) {
+		chomp;
+		if (!$state && s/.*<math class="eqn">//) {
+			$state = 1;
+			next unless length;
+		}
+		$state = 1 if /^BEGINTEST/;
+		if ($state && s/<\/math>.*//) {
+			s/^ *//;
+			print $outfd "$_\n" if length;
+			undef $state;
+			next;
+		}
+		s/^ *//;
+		print $outfd "$_\n" if $state;
+		undef $state if /^ENDTEST/;
+	}
+	close $outfd;
+	close $infd;
+	waitpid $pid, 0;
+	return 0;
+}
+
+my @failures;
+sub fail ($$$) {
+	warn "FAILED: @_\n";
+	push @failures, [@_];
+}
+
+
+# --- process command line arguments -----------------------------------
+
+my ($subdir, $onlytest) = split ':', (shift // '.');
+my $displaylevel = 2;
+my %targets;
+for (@ARGV) {
+	if (/^[0123]$/) {
+		$displaylevel = int;
+		next;
+	}
+	/^(all|ascii|utf8|man|html|lint|clean|verbose)$/
+	    or usage "$_: invalid modifier";
+	$targets{$_} = 1;
+}
+$targets{all} = 1
+    unless $targets{ascii} || $targets{utf8} || $targets{man} ||
+      $targets{html} || $targets{lint} || $targets{clean};
+$targets{ascii} = $targets{utf8} = $targets{man} = $targets{html} =
+    $targets{lint} = 1 if $targets{all};
+$displaylevel = 3 if $targets{verbose};
+
+
+# --- parse Makefiles --------------------------------------------------
+
+my %vars = (MOPTS => '');
+sub parse_makefile ($) {
+	my $filename = shift;
+	open my $fh, '<', $filename or die "$filename: $!";
+	while (<$fh>) {
+		chomp;
+		next unless /\S/;
+		last if /^# OpenBSD only/;
+		next if /^#/;
+		next if /^\.include/;
+		/^(\w+)\s*([?+]?)=\s*(.*)/
+		    or die "$filename: parse error: $_";
+		my $var = $1;
+		my $opt = $2;
+		my $val = $3;
+		$val =~ s/\${(\w+)}/$vars{$1}/;
+		$val = "$vars{$var} $val" if $opt eq '+';
+		$vars{$var} = $val
+		    unless $opt eq '?' && defined $vars{$var};
+	}
+	close $fh;
+}
+
+if ($subdir eq '.') {
+	$vars{SUBDIR} = 'roff char mdoc man tbl eqn';
+} else {
+	parse_makefile "$subdir/Makefile";
+	parse_makefile "$subdir/../Makefile.inc"
+	    if -e "$subdir/../Makefile.inc";
+}
+
+my @mandoc = '../mandoc';
+my @subdir_names;
+my (@regress_testnames, @utf8_testnames, @html_testnames, @lint_testnames);
+my (%skip_ascii, %skip_man);
+
+push @mandoc, split ' ', $vars{MOPTS} if $vars{MOPTS};
+delete $vars{MOPTS};
+delete $vars{SKIP_GROFF};
+delete $vars{SKIP_GROFF_ASCII};
+delete $vars{TBL};
+delete $vars{EQN};
+if (defined $vars{SUBDIR}) {
+	@subdir_names = split ' ', $vars{SUBDIR};
+	delete $vars{SUBDIR};
+}
+if (defined $vars{REGRESS_TARGETS}) {
+	@regress_testnames = split ' ', $vars{REGRESS_TARGETS};
+	delete $vars{REGRESS_TARGETS};
+}
+if (defined $vars{UTF8_TARGETS}) {
+	@utf8_testnames = split ' ', $vars{UTF8_TARGETS};
+	delete $vars{UTF8_TARGETS};
+}
+if (defined $vars{HTML_TARGETS}) {
+	@html_testnames = split ' ', $vars{HTML_TARGETS};
+	delete $vars{HTML_TARGETS};
+}
+if (defined $vars{LINT_TARGETS}) {
+	@lint_testnames = split ' ', $vars{LINT_TARGETS};
+	delete $vars{LINT_TARGETS};
+}
+if (defined $vars{SKIP_ASCII}) {
+	for (split ' ', $vars{SKIP_ASCII}) {
+		$skip_ascii{$_} = 1;
+		$skip_man{$_} = 1;
+	}
+	delete $vars{SKIP_ASCII};
+}
+if (defined $vars{SKIP_TMAN}) {
+	$skip_man{$_} = 1 for split ' ', $vars{SKIP_TMAN};
+	delete $vars{SKIP_TMAN};
+}
+if (keys %vars) {
+	my @vars = keys %vars;
+	die "unknown var(s) @vars";
+}
+map { $skip_ascii{$_} = 1; } @regress_testnames if $skip_ascii{ALL};
+map { $skip_man{$_} = 1; } @regress_testnames if $skip_man{ALL};
+
+# --- run targets ------------------------------------------------------
+
+my $count_total = 0;
+for my $dirname (@subdir_names) {
+	$count_total++;
+	print "\n" if $targets{verbose};
+	system './regress.pl', "$subdir/$dirname", keys %targets,
+	    ($displaylevel ? $displaylevel - 1 : 0),
+	    and fail $subdir, $dirname, 'subdir';
+}
+
+my $count_ascii = 0;
+my $count_man = 0;
+for my $testname (@regress_testnames) {
+	next if $onlytest && $testname ne $onlytest;
+	my $i = "$subdir/$testname.in";
+	my $o = "$subdir/$testname.mandoc_ascii";
+	my $w = "$subdir/$testname.out_ascii";
+	if ($targets{ascii} && !$skip_ascii{$testname}) {
+		$count_ascii++;
+		$count_total++;
+		print "@mandoc -T ascii $i\n" if $targets{verbose};
+		sysout $o, @mandoc, qw(-T ascii), $i
+		    and fail $subdir, $testname, 'ascii:mandoc';
+		system qw(diff -au), $w, $o
+		    and fail $subdir, $testname, 'ascii:diff';
+	}
+	my $m = "$subdir/$testname.in_man";
+	my $mo = "$subdir/$testname.mandoc_man";
+	if ($targets{man} && !$skip_man{$testname}) {
+		$count_man++;
+		$count_total++;
+		print "@mandoc -T man $i\n" if $targets{verbose};
+		sysout $m, @mandoc, qw(-T man), $i
+		    and fail $subdir, $testname, 'man:man';
+		print "@mandoc -man -T ascii $m\n" if $targets{verbose};
+		sysout $mo, @mandoc, qw(-man -T ascii -O mdoc), $m
+		    and fail $subdir, $testname, 'man:mandoc';
+		system qw(diff -au), $w, $mo
+		    and fail $subdir, $testname, 'man:diff';
+	}
+	if ($targets{clean}) {
+		print "rm $o\n"
+		    if $targets{verbose} && !$skip_ascii{$testname};
+		unlink $o;
+		print "rm $m $mo\n"
+		    if $targets{verbose} && !$skip_man{$testname};
+		unlink $m, $mo;
+	}
+}
+
+my $count_utf8 = 0;
+for my $testname (@utf8_testnames) {
+	next if $onlytest && $testname ne $onlytest;
+	my $i = "$subdir/$testname.in";
+	my $o = "$subdir/$testname.mandoc_utf8";
+	my $w = "$subdir/$testname.out_utf8";
+	if ($targets{utf8}) {
+		$count_utf8++;
+		$count_total++;
+		print "@mandoc -T utf8 $i\n" if $targets{verbose};
+		sysout $o, @mandoc, qw(-T utf8), $i
+		    and fail $subdir, $testname, 'utf8:mandoc';
+		system qw(diff -au), $w, $o
+		    and fail $subdir, $testname, 'utf8:diff';
+	}
+	if ($targets{clean}) {
+		print "rm $o\n" if $targets{verbose};
+		unlink $o;
+	}
+}
+
+my $count_html = 0;
+for my $testname (@html_testnames) {
+	next if $onlytest && $testname ne $onlytest;
+	my $i = "$subdir/$testname.in";
+	my $o = "$subdir/$testname.mandoc_html";
+	my $w = "$subdir/$testname.out_html";
+	if ($targets{html}) {
+		$count_html++;
+		$count_total++;
+		print "@mandoc -T html $i\n" if $targets{verbose};
+		syshtml $o, @mandoc, qw(-T html), $i
+		    and fail $subdir, $testname, 'html:mandoc';
+		system qw(diff -au), $w, $o
+		    and fail $subdir, $testname, 'html:diff';
+	}
+	if ($targets{clean}) {
+		print "rm $o\n" if $targets{verbose};
+		unlink $o;
+	}
+}
+
+my $count_lint = 0;
+for my $testname (@lint_testnames) {
+	next if $onlytest && $testname ne $onlytest;
+	my $i = "$subdir/$testname.in";
+	my $o = "$subdir/$testname.mandoc_lint";
+	my $w = "$subdir/$testname.out_lint";
+	if ($targets{lint}) {
+		$count_lint++;
+		$count_total++;
+		print "@mandoc -T lint $i\n" if $targets{verbose};
+		syslint $o, @mandoc, qw(-T lint), $i
+		    and fail $subdir, $testname, 'lint:mandoc';
+		system qw(diff -au), $w, $o
+		    and fail $subdir, $testname, 'lint:diff';
+	}
+	if ($targets{clean}) {
+		print "rm $o\n" if $targets{verbose};
+		unlink $o;
+	}
+}
+
+exit 0 unless $displaylevel or @failures;
+
+print "\n" if $targets{verbose};
+if ($onlytest) {
+	print "test $subdir:$onlytest finished";
+} else {
+	print "testsuite $subdir finished";
+}
+print ' ', (scalar @subdir_names), ' subdirectories' if @subdir_names;
+print " $count_ascii ascii" if $count_ascii;
+print " $count_man man" if $count_man;
+print " $count_utf8 utf8" if $count_utf8;
+print " $count_html html" if $count_html;
+print " $count_lint lint" if $count_lint;
+
+if (@failures) {
+	print " (FAIL)\n\nSOME TESTS FAILED:\n\n";
+	print "@$_\n" for @failures;
+	print "\n";
+	exit 1;
+} elsif ($count_total == 1) {
+	print " (OK)\n";
+} elsif ($count_total) {
+	print " (all $count_total tests OK)\n";
+} else {
+	print " (no tests run)\n";
+} 
+exit 0;