X-Git-Url: http://git.shiar.nl/barcat.git/blobdiff_plain/0442568053b7dd6c69e765bd1aaf88725d0da6d2..5d57bd7d9e6b2f62ded5c5b801f6ad971d079809:/t/regress.t

diff --git a/t/regress.t b/t/regress.t
index f81cfd7..a382f43 100755
--- a/t/regress.t
+++ b/t/regress.t
@@ -1,46 +1,98 @@
-#!/bin/sh
-
-cd "${0%/*}" || exit 1
-
-test_count=0
-
-COLUMNS=40
-diffcmd='diff --unchanged-line-format= --old-line-format=<%L --new-line-format=>%L'
-regenerate=
-
-for option in "$@"
-do
-	case "$option" in
-	-G) regenerate=1 && shift;;
-	-*) echo "Usage: $0 [-G] [<files>...]"; exit 64;;
-	esac
-done
-
-for candidate in ${@:-t*.in}
-do
-	test_count=$((test_count+1))
-	file="${candidate%.in}"
-	test -r "$file.in" || continue
-
-	name="$(echo ${file#*-} | tr _ \ )"
-	cmd="barcat $file.in"
-	case "$name" in *\ -*) cmd="$cmd -${name#* -}";; esac
-
-	if test -n "$regenerate"
-	then
-		if test -e $file.sh
-		then
-			echo "ok $test_count # skip $file.out"
-			continue
-		fi
-		$cmd >$file.out 2>&1
-	else
-		if test -e $file.sh;  then $cmd 2>&1 | ./$file.sh; fi &&
-		if test -e $file.out; then $cmd 2>&1 | $diffcmd "$file.out" -; fi
-	fi
-
-	test 0 = $? || printf 'not '
-	echo "ok $test_count - $name"
-done
-
-echo "1..$test_count"
+#!/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;
+
+chdir dirname($0) or exit 1;
+
+GetOptions(\my %opt,
+	'regenerate|G!',
+) or do {
+	say "Usage: $0 [-G] [<files>...]";
+	exit 64;  # EX_USAGE
+};
+
+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(color(31), '> ', color(0), $_) for @lines;
+		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");
+	};
+}
+
+done_testing();
+
+sub color {
+	return !$ENV{NOCOLOR} && "\e[@{_}m";
+}