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 (executable)
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 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";
+}