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

diff --git a/t/regress.t b/t/regress.t
index ef28f6f..a10827b 100755
--- a/t/regress.t
+++ b/t/regress.t
@@ -1,18 +1,95 @@
-#!/bin/sh
+#!/usr/bin/env perl
+use 5.014;
+use warnings;
+use re '/ms';
+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))
-	name="${candidate%.out}"
-	barcat <"$name.in" | $diffcmd "$name.out" - || printf 'not '
-	echo "ok $test_count - $name"
-done
+my @params = @ARGV ? @ARGV : glob 't*.out';
+plan(tests => int @params);
 
-echo "1..$test_count"
+for my $candidate (@params) {
+	my $name = basename($candidate, '.out');
+	$name =~ tr/_/ /;
+	my $todo = $name =~ s/ #TODO$//;
+	local $TODO = $todo ? ' ' : undef;
+
+	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;
+	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";
+}