X-Git-Url: http://git.shiar.nl/barcat.git/blobdiff_plain/704f0f343df103c321caa2ea7e846dea650cd24e..96e83823c4b9ba26b6b65a7f5563d93fa21571ff:/t/regress.t

diff --git a/t/regress.t b/t/regress.t
index 5911e25..06d926e 100755
--- a/t/regress.t
+++ b/t/regress.t
@@ -1,86 +1,97 @@
-#!/bin/sh
+#!/usr/bin/env perl
+use 5.014;
+use warnings;
+use re '/msx';
+use Getopt::Long qw(2.32 :config gnu_getopt);
+use Test::More;
+use File::Basename;
 
-cd "${0%/*}" || exit 1
+chdir dirname($0) or exit 1;
 
-test_count=0
-fail_count=0
+GetOptions(\my %opt,
+	'regenerate|G!',
+) or do {
+	say "Usage: $0 [-G] [<files>...]";
+	exit 64;  # EX_USAGE
+};
 
-COLUMNS=40
-colorize=
-test -t 1 && colorize=1
-color () {
-	test -n "$colorize" &&
-	printf '\e[%sm' $@
-}
-regenerate=
-diffcmd () {
-	comm --nocheck-order --output-delimiter=::: -3 $@ |
-	perl -pe"END{exit !!\$.} s/^:::/$(color 31)>/ || s/^/$(color 32)</"
+local $ENV{COLUMNS} = 40;
+
+my @params = @ARGV ? @ARGV : glob 't*.out';
+plan(tests => int @params);
+
+for my $candidate (@params) {
+	my $name = basename($candidate, '.out');
+	$name =~ tr/_/ /;
+	local $TODO;
+
+	if (!-e $candidate) {
+		local $TODO = 'missing output';
+		fail($name);
+		next;
+	}
+
+	open my $fh, '<', $candidate or die "missing $candidate: $!\n";
+	!!(my $spec = readline $fh)
+		or die "input lacks a script on the first line\n";
+
+	my $script = $spec;
+	chomp $script;
+	$script =~ s/\h* [#]\h* todo \h* (.*?) \z//i
+		and $TODO = $+ || ' ';
+	my $wantexit = $script =~ s/\h+[?](\d+)\z// ? $1 : 0;
+	my $wantwarn = $script !~ s/[?]\z//;
+
+	my $shell = $script;
+	if ($script =~ /\|/) {
+		# explicit shell wrapper to capture all warnings
+		$shell =~ s/'/'\\''/g;
+		$shell = "sh -c '$shell'";
+	}
+	$shell .= ' 2>' . ($wantwarn ? '&1' : '/dev/null');
+
+	open my $cmd, '-|', $shell or do {
+		fail($name);
+		diag("open failure: $!");
+		diag("command: $script");
+		next;
+	};
+	my @lines = readline $cmd;
+	close $cmd;
+	my $error = $? >> 8;
+
+	if ($opt{regenerate}) {
+		#TODO: error
+		open my $rewrite, '>', $candidate;
+		print {$rewrite} $_ for $spec, @lines;
+	}
+
+	if ($error != $wantexit) {
+		fail($name);
+		diag("unexpected exit status $error");
+		diag("command: $script");
+		next;
+	}
+
+	my @diff;
+	my @wanted = readline $fh;
+
+	while (@lines or @wanted) {
+		my $was = shift @wanted;
+		my $is  = shift @lines;
+		next if defined $was and defined $is and $was eq $is;
+		push @diff, color(32) . "< " . color(0) . $_ for $was // ();
+		push @diff, color(31) . "> " . color(0) . $_ for $is  // ();
+	}
+
+	ok(!@diff, $name) or do {
+		diag(@diff);
+		diag("command: $script");
+	};
 }
 
-for option in "$@"
-do
-	case "$option" in
-	-G) regenerate=1 && shift;;
-	-*) echo "Usage: $0 [-G] [<files>...]"; exit 64;;
-	esac
-done
-
-for candidate in ${@:-t*.out}
-do
-	test_count=$((test_count+1))
-	file="${candidate%.out}"
-	input="${file%%_-*}.in"
-	name="$(echo ${file#*-} | tr _ \ )"
-
-	set -- barcat
-	[ -r "$input" ] && set -- "$@" "$input"
-	case "$name" in *\ -*) set -- "$@" -"${name#* -}";; esac
-	case "$name" in
-		*' ?'*) set -- sh -c "\$0 \$1 | test \$\? = ${name#* \?}" "$@";;
-		*' |'*) set -- sh -c "\$0 \$1 | ${name#* |}" "$@";;
-		*)      set -- "$1" $2 $3
-	esac
-
-	if test -n "$regenerate"
-	then
-		if test -e $file.sh
-		then
-			echo "ok $test_count # skip $file.out"
-			continue
-		fi
-		"$@" >$file.out 2>&1
-	elif test -e "$file.out"
-	then
-		"$@" 2>&1 | diffcmd "$file.out" -
-	else
-		color 33
-		echo "not ok $test_count - $name # TODO"
-		color 0
-		continue
-	fi
-
-	if test 0 != $?
-	then
-		fail_count=$((fail_count+1))
-		color 1\;31
-		printf 'not '
-	fi
-	echo "ok $test_count - $name"
-	color 0
-done
-
-if test $fail_count = 0
-then
-	color 32
-	echo "# passed all $test_count test(s)"
-else
-	color 31
-	echo "# failed $fail_count among $test_count test(s)"
-	fail_count=1  # exit code
-fi
-
-color 0\;36
-echo "1..$test_count"
-color 0
-exit $fail_count
+done_testing();
+
+sub color {
+	return !$ENV{NOCOLOR} && "\e[@{_}m";
+}