X-Git-Url: http://git.shiar.net/barcat.git/blobdiff_plain/0b4ffa71d10be29d112ff539911be31d6f7fffd7..01b0de7ee82aad3b315a95f7900071480f431774:/t/regress.t

diff --git a/t/regress.t b/t/regress.t
index 7980b84..c910748 100755
--- a/t/regress.t
+++ b/t/regress.t
@@ -5,8 +5,6 @@ use re '/ms';
 use Getopt::Long qw(2.32 :config gnu_getopt);
 use Test::More;
 use File::Basename;
-use IPC::Run 'run';
-use Data::Dump 'pp';
 
 chdir dirname($0) or exit 1;
 
@@ -23,32 +21,75 @@ my @params = @ARGV ? @ARGV : glob 't*.out';
 plan(tests => int @params);
 
 for my $candidate (@params) {
-	my $file = basename($candidate, '.out');
-	(my $name = $file =~ s/^[^-]*-//r) =~ tr/_/ /;
+	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
+		$script =~ 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;
 
-	my $diff;
 	if ($opt{regenerate}) {
-		if (-e "$file.sh") {
-			skip("$file.out", 1);
-			next;
-		}
-		#run(\@run, '>&', "$file.out");
+		#TODO: error
+		open my $rewrite, '>', $candidate;
+		print {$rewrite} $_ for $spec, @lines;
 	}
-	elsif (!-e "$file.out") {
-		local $TODO = 'missing output';
+
+	if ($error != $wantexit) {
 		fail($name);
+		diag("unexpected exit status $error");
+		diag("command: $script");
 		next;
 	}
-	else {
-		run(['./cmddiff', "$file.out"], '>', \$diff);
+
+	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  // ();
 	}
 
-	local $TODO = $todo ? ' ' : undef;
-	is($? >> 8, 0, $name) or do {
-		#diag('command: ', pp(@run));
-		diag($diff);  #TODO native
+	ok(!@diff, $name) or do {
+		diag(@diff);
+		diag("command: $script");
 	};
 }
 
 done_testing();
+
+sub color {
+	return !$ENV{NOCOLOR} && "\e[@{_}m";
+}