v4-0002-perl-tap-Show-failed-command-output.patch

From 3d4d27e2439b0c4baa90521a0ad84990bd375dd7 Mon Sep 17 00:00:00 2001
From: Jelte Fennema-Nio <postgres@jeltef.nl>
Date: Mon, 26 Jan 2026 09:09:11 +0100
Subject: [PATCH v4 2/5] perl tap: Show failed command output

This adds the output of failed commands to the TAP output. Before a
failed libpq_pipeline test would look like this:

  Failed test 'libpq_pipeline cancel'
  at /home/jelte/work/postgres-3/src/test/modules/libpq_pipeline/t/001_libpq_pipeline.pl line 55.

Now you can actually see the reason of the failure:

  Failed test 'libpq_pipeline cancel'
  at /home/jelte/work/postgres-3/src/test/modules/libpq_pipeline/t/001_libpq_pipeline.pl line 55.
---------- command failed ----------
libpq_pipeline -r 700 cancel port=22067 host=/tmp/u1owq5Ajit dbname='postgres' max_protocol_version=latest
-------------- stderr --------------
test cancellations...
libpq_pipeline:315: unexpected number of rows received: 1
------------------------------------

To make sure the output is not flooded. Only the first 30 and last 30
lines of both stderr and stdout are shown.

This also changes the 001_start_stop.pl test to configure a logfile
during pg_ctl restart. Otherwise IPC::Run call will hang indefinitely,
because the stdout file descriptor won't be closed on process exit.
---
 src/bin/pg_ctl/t/001_start_stop.pl     |  2 +-
 src/test/perl/PostgreSQL/Test/Utils.pm | 54 +++++++++++++++++++++++---
 2 files changed, 49 insertions(+), 7 deletions(-)

diff --git a/src/bin/pg_ctl/t/001_start_stop.pl b/src/bin/pg_ctl/t/001_start_stop.pl
index 9b79de319f2..4a25b35ed9c 100644
--- a/src/bin/pg_ctl/t/001_start_stop.pl
+++ b/src/bin/pg_ctl/t/001_start_stop.pl
@@ -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";
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index ff843eecc6e..04e4a4692b3 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -937,6 +937,36 @@ 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 +977,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 +985,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 +1000,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 +1008,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;
 }
 
-- 
2.53.0