#!/usr/bin/env perl
use 5.014;
use warnings;
-use re '/ms';
+use re '/msx';
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;
plan(tests => int @params);
for my $candidate (@params) {
- my $file = basename($candidate, '.out');
- (my $name = $file =~ s/^[^-]*-//r) =~ tr/_/ /;
- my $todo = $name =~ s/ #TODO$//;
+ my $name = basename($candidate, '.out');
+ $name =~ tr/_/ /;
+ local $TODO;
+
+ 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;
+ $script =~ s/\h* [#]\h* todo \h* (.*?) \z//i
+ and $TODO = $+ || ' ';
+ 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;
- 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(color(31), '> ', color(0), $_) for @lines;
+ 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";
+}