-#!/bin/sh
+#!/usr/bin/env perl
+use 5.014;
+use warnings;
+use re '/msx';
+use Getopt::Long qw(2.32 :config gnu_getopt);
+use Test::More;
+use File::Basename;
-cd "${0%/*}" || exit 1
+chdir dirname($0) or exit 1;
-test_count=0
-fail_count=0
+GetOptions(\my %opt,
+ 'regenerate|G!',
+) or do {
+ say "Usage: $0 [-G] [<files>...]";
+ exit 64; # EX_USAGE
+};
-COLUMNS=40
-colorize=
-test -t 1 && colorize=1
-color () {
- test -n "$colorize" &&
- printf '\e[%sm' $@
-}
-regenerate=
-diffcmd () {
- comm --nocheck-order --output-delimiter=::: -3 $@ |
- perl -pe"END{exit !!\$.} s/^:::/$(color 31)>/ || s/^/$(color 32)</"
+local $ENV{COLUMNS} = 40;
+
+my @params = @ARGV ? @ARGV : glob 't*.out';
+plan(tests => int @params);
+
+for my $candidate (@params) {
+ 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;
+
+ if ($opt{regenerate}) {
+ #TODO: error
+ open my $rewrite, '>', $candidate;
+ print {$rewrite} $_ for $spec, @lines;
+ }
+
+ if ($error != $wantexit) {
+ fail($name);
+ diag("unexpected exit status $error");
+ diag(color(31), '> ', color(0), $_) for @lines;
+ diag("command: $script");
+ next;
+ }
+
+ 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 // ();
+ }
+
+ ok(!@diff, $name) or do {
+ diag(@diff);
+ diag("command: $script");
+ };
}
-for option in "$@"
-do
- case "$option" in
- -G) regenerate=1 && shift;;
- -*) echo "Usage: $0 [-G] [<files>...]"; exit 64;;
- esac
-done
-
-for candidate in ${@:-t*.out}
-do
- test_count=$((test_count+1))
- file="${candidate%.out}"
- input="${file%%_-*}.in"
- name="$(echo ${file#*-} | tr _ \ )"
-
- set -- barcat
- [ -r "$input" ] && set -- "$@" "$input"
- case "$name" in
- *\ -*)
- args="${name#* -}"
- set -- "$@" -"${args% [?|]*}"
- ;;
- esac
- case "$name" in
- *' ?' ) set -- sh -c "\$0 \$@ 2>/dev/null" "$@";;
- *' ?'*) set -- sh -c "\$0 \$@ | test \$\? = ${name#* \?}" "$@";;
- *' |'*) set -- sh -c "\$0 \$@ | ${name#* |}" "$@";;
- *) eval set -- "$1" $2 $3
- esac
-
- if test -n "$regenerate"
- then
- if test -e $file.sh
- then
- echo "ok $test_count # skip $file.out"
- continue
- fi
- "$@" >$file.out 2>&1
- elif test -e "$file.out"
- then
- "$@" 2>&1 | diffcmd "$file.out" -
- else
- color 33
- echo "not ok $test_count - $name # TODO"
- color 0
- continue
- fi
-
- if test 0 != $?
- then
- case "$name" in
- *' #TODO')
- color 33
- ;;
- *)
- fail_count=$((fail_count+1))
- color 1\;31
- esac
-
- printf 'not '
- fi
- echo "ok $test_count - $name"
- color 0
-done
-
-if test $fail_count = 0
-then
- color 32
- echo "# passed all $test_count test(s)"
-else
- color 31
- echo "# failed $fail_count among $test_count test(s)"
- fail_count=1 # exit code
-fi
-
-color 0\;36
-echo "1..$test_count"
-color 0
-exit $fail_count
+done_testing();
+
+sub color {
+ return !$ENV{NOCOLOR} && "\e[@{_}m";
+}