5 use Getopt::Long qw(2.32 :config gnu_getopt);
9 chdir dirname($0) or exit 1;
14 say "Usage: $0 [-G] [<files>...]";
18 local $ENV{COLUMNS} = 40;
20 my @params = @ARGV ? @ARGV : glob 't*.out';
21 plan(tests => int @params);
23 for my $candidate (@params) {
24 my $name = basename($candidate, '.out');
29 local $TODO = 'missing output';
34 open my $fh, '<', $candidate or die "missing $candidate: $!\n";
35 !!(my $spec = readline $fh)
36 or die "input lacks a script on the first line\n";
40 $script =~ s/\h* [#]\h* todo \h* (.*?) \z//i
41 and $TODO = $+ || ' ';
42 my $wantexit = $script =~ s/\h+[?](\d+)\z// ? $1 : 0;
43 my $wantwarn = $script !~ s/[?]\z//;
46 if ($script =~ /\|/) {
47 # explicit shell wrapper to capture all warnings
48 $shell =~ s/'/'\\''/g;
49 $shell = "sh -c '$shell'";
51 $shell .= ' 2>' . ($wantwarn ? '&1' : '/dev/null');
53 open my $cmd, '-|', $shell or do {
55 diag("open failure: $!");
56 diag("command: $script");
59 my @lines = readline $cmd;
63 if ($opt{regenerate}) {
65 open my $rewrite, '>', $candidate;
66 print {$rewrite} $_ for $spec, @lines;
69 if ($error != $wantexit) {
71 diag("unexpected exit status $error");
72 diag("command: $script");
77 my @wanted = readline $fh;
79 while (@lines or @wanted) {
80 my $was = shift @wanted;
81 my $is = shift @lines;
82 next if defined $was and defined $is and $was eq $is;
83 push @diff, color(32) . "< " . color(0) . $_ for $was // ();
84 push @diff, color(31) . "> " . color(0) . $_ for $is // ();
87 ok(!@diff, $name) or do {
89 diag("command: $script");
96 return !$ENV{NOCOLOR} && "\e[@{_}m";