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');
26 my $todo = $name =~ s/ #TODO$//;
27 local $TODO = $todo ? ' ' : undef;
30 local $TODO = 'missing output';
35 open my $fh, '<', $candidate or die "missing $candidate: $!\n";
36 !!(my $spec = readline $fh)
37 or die "input lacks a script on the first line\n";
41 my $wantexit = $script =~ s/\h+[?](\d+)\z// ? $1 : 0;
42 my $wantwarn = $script !~ s/[?]\z//;
44 if ($script =~ /\|/) {
45 # explicit shell wrapper to capture all warnings
46 $script =~ s/'/'\\''/g;
47 $shell = "sh -c '$shell'";
49 $shell .= ' 2>' . ($wantwarn ? '&1' : '/dev/null');
51 open my $cmd, '-|', $shell or do {
53 diag("open failure: $!");
54 diag("command: $script");
57 my @lines = readline $cmd;
61 if ($opt{regenerate}) {
63 open my $rewrite, '>', $candidate;
64 print {$rewrite} $_ for $spec, @lines;
67 if ($error != $wantexit) {
69 diag("unexpected exit status $error");
70 diag("command: $script");
75 my @wanted = readline $fh;
77 while (@lines or @wanted) {
78 my $was = shift @wanted;
79 my $is = shift @lines;
80 next if defined $was and defined $is and $was eq $is;
81 push @diff, color(32) . "< " . color(0) . $_ for $was // ();
82 push @diff, color(31) . "> " . color(0) . $_ for $is // ();
85 ok(!@diff, $name) or do {
87 diag("command: $script");
94 return !$ENV{NOCOLOR} && "\e[@{_}m";