t/regress: integrate cmddiff in line

[barcat.git] / t / regress.t

diff --git a/t/regress.t b/t/regress.t
index 7980b84bde4de1add470350e9d5bcc1f8a3caab8..c9107486b6fd710461bd851d3522c0e2fc0e310f 100755 (executable)
--- 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";
+}