From: Mischa POSLAWSKY <perl@shiar.org>
Date: Sun, 27 Nov 2022 18:33:35 +0000 (+0100)
Subject: t/regress: integrate cmddiff in line
X-Git-Tag: v1.10~25
X-Git-Url: http://git.shiar.nl/barcat.git/commitdiff_plain/01b0de7ee82aad3b315a95f7900071480f431774

t/regress: integrate cmddiff in line

Restore to near shell speed, and control diagnostics output.
---

diff --git a/t/cmddiff b/t/cmddiff
deleted file mode 100755
index de1536c..0000000
--- a/t/cmddiff
+++ /dev/null
@@ -1,61 +0,0 @@
-#!/usr/bin/env perl
-use 5.012;
-use warnings;
-
-# run script on the first line and compare its output to remaining lines
-
-my $regenerate = @ARGV > 1 && $ARGV[0] eq '-G' && shift;
-
-@ARGV or die "missing input script\n";
-!!(my $spec = readline)
-	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>&1' if $wantwarn;
-
-local $ENV{COLUMNS} = 40;
-open my $cmd, '-|', $shell or do {
-	say "cannot run script `$script`: $!";
-	exit 2;
-};
-my @lines = readline $cmd;
-close $cmd;
-my $error = $? >> 8;
-
-if ($regenerate) {
-	open my $rewrite, '>', $ARGV;
-	print {$rewrite} $_ for $spec, @lines;
-	exit;
-}
-
-if ($error != $wantexit) {
-	say "unexpected exit status $error for `$script`";
-	exit 2;
-}
-
-my @wanted = readline;
-my $diff = 0;
-
-while (@lines or @wanted) {
-	my $was = shift @wanted;
-	my $is  = shift @lines;
-	next if defined $was and defined $is and $was eq $is;
-	$diff++;
-	print color(32), "< ", color(0), $_ for $was // ();
-	print color(31), "> ", color(0), $_ for $is  // ();
-}
-
-exit($diff > 0);
-
-sub color {
-	return "\e[@{_}m";
-}
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";
+}