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

diff --git a/t/regress.t b/t/regress.t
index 5daf496..06d926e 100755
--- a/t/regress.t
+++ b/t/regress.t
@@ -1,24 +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
+GetOptions(\my %opt,
+	'regenerate|G!',
+) or do {
+	say "Usage: $0 [-G] [<files>...]";
+	exit 64;  # EX_USAGE
+};
 
-COLUMNS=40
-diffcmd='diff --unchanged-line-format= --old-line-format=<%L --new-line-format=>%L'
+local $ENV{COLUMNS} = 40;
 
-for candidate in ${@:-t*.in}
-do
-	test_count=$((test_count+1))
-	file="${candidate%.in}"
-	test -r "$file.in" || continue
+my @params = @ARGV ? @ARGV : glob 't*.out';
+plan(tests => int @params);
 
-	name="$(echo ${file#*-} | tr _ \ )"
-	cmd="barcat $file.in"
-	case "$name" in *\ -*) cmd="$cmd -${name#* -}";; esac
+for my $candidate (@params) {
+	my $name = basename($candidate, '.out');
+	$name =~ tr/_/ /;
+	local $TODO;
 
-	$cmd 2>&1 | $diffcmd "$file.out" - || printf 'not '
-	echo "ok $test_count - $name"
-done
+	if (!-e $candidate) {
+		local $TODO = 'missing output';
+		fail($name);
+		next;
+	}
 
-echo "1..$test_count"
+	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");
+	};
+}
+
+done_testing();
+
+sub color {
+	return !$ENV{NOCOLOR} && "\e[@{_}m";
+}