perl tap: Show failed command output

Capture stdout and stderr from command_ok() and command_fails() and emit
them as TAP diagnostics on failure.  Output is truncated to the first
and last 30 lines per channel to avoid flooding.

A new helper _diag_command_output() is introduced in Utils.pm so
both functions share the same truncation and formatting logic.

Author: Jelte Fennema-Nio <postgres@jeltef.nl>
Reviewed-by: Andrew Dunstan <andrew@dunslane.net>
Reviewed-by: Corey Huinker <corey.huinker@gmail.com>
Reviewed-by: Zsolt Parragi <zsolt.parragi@percona.com>
Reviewed-by: Nazir Bilal Yavuz <byavuz81@gmail.com>
Reviewed-by: Andres Freund <andres@anarazel.de>
Discussion: https://postgr.es/m/DFYFWM053WHS.10K8ZPJ605UFK@jeltef.nl
This commit is contained in:
Andrew Dunstan 2026-04-01 13:54:29 -04:00
parent 5720ae0143
commit 1402b8d2fc
2 changed files with 48 additions and 7 deletions

View file

@ -112,7 +112,7 @@ SKIP:
ok(check_mode_recursive("$tempdir/data", 0750, 0640));
}
command_ok([ 'pg_ctl', 'restart', '--pgdata' => "$tempdir/data" ],
command_ok([ 'pg_ctl', 'restart', '--pgdata' => "$tempdir/data", '--log' => $logFileName ],
'pg_ctl restart with server running');
system_or_bail 'pg_ctl', 'stop', '--pgdata' => "$tempdir/data";

View file

@ -937,6 +937,35 @@ sub dir_symlink
die "No $newname" unless -e $newname;
}
# Log command output. Truncates to first/last 30 lines if over 60 lines.
sub _diag_command_output
{
my ($cmd, $stdout, $stderr) = @_;
diag(join(" ", @$cmd));
for my $channel (['stdout', $stdout], ['stderr', $stderr])
{
my ($name, $output) = @$channel;
next unless $output;
diag("-------------- $name --------------");
my @lines = split /\n/, $output;
if (@lines > 60)
{
diag(join("\n", @lines[0 .. 29]));
diag("... " . (@lines - 60) . " lines omitted ...");
diag(join("\n", @lines[-30 .. -1]));
}
else
{
diag($output);
}
}
diag("------------------------------------");
}
=pod
=back
@ -947,7 +976,7 @@ sub dir_symlink
=item command_ok(cmd, test_name)
Check that the command runs (via C<run_log>) successfully.
Check that the command runs successfully.
=cut
@ -955,8 +984,14 @@ sub command_ok
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($cmd, $test_name) = @_;
my $result = run_log($cmd);
ok($result, $test_name);
my ($stdout, $stderr);
print("# Running: " . join(" ", @{$cmd}) . "\n");
my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
ok($result, $test_name) or do
{
diag("---------- command failed ----------");
_diag_command_output($cmd, $stdout, $stderr);
};
return;
}
@ -964,7 +999,7 @@ sub command_ok
=item command_fails(cmd, test_name)
Check that the command fails (when run via C<run_log>).
Check that the command fails.
=cut
@ -972,8 +1007,14 @@ sub command_fails
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($cmd, $test_name) = @_;
my $result = run_log($cmd);
ok(!$result, $test_name);
my ($stdout, $stderr);
print("# Running: " . join(" ", @{$cmd}) . "\n");
my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
ok(!$result, $test_name) or do
{
diag("-- command succeeded unexpectedly --");
_diag_command_output($cmd, $stdout, $stderr);
};
return;
}