On Tue, 3 Feb 2026 at 11:20, Nazir Bilal Yavuz <[email protected]> wrote:
v2-0001:

This doesn't really read the first 80 lines of the combined diff.
Lines with more than 1023 characters will be counted and printed as
multiple lines. I don't think this is a problem but clearing this
would be helpful. Other than that, it looks good to me.

I was annoyed by this, so I actually fixed it (manually tested by
changing the buffer to 10 bytes). This meant I needed to introduce
DIAG_DETAIL and DIAG_END, like we already had NOTE_DETAIL and NOTE_END.

v2-0002:

I am just curious if test failure can cause file descriptors not being
properly closed and then the IPC::Run:run() call will hang
indefinitely like the pg_ctl case. Other than that, it looks good to
me.

No, this issue only happens because for the 'pg_ctl restart' process,
its the child postmaster process outlives the pg_ctl process, WHILE
still having the stdout/stderr file descriptor open. As long as all the
subprocesses exit, the file descriptor will be closed by the OS
automatically. So, this problem really only occurs in these daemon
spawning situations. Which for us in practice is only for pg_ctl
start/restart.
From 4e98f2709ce7594f8ebbb4f6926e7f3767b1f4e2 Mon Sep 17 00:00:00 2001
From: Jelte Fennema-Nio <[email protected]>
Date: Mon, 26 Jan 2026 00:15:30 +0100
Subject: [PATCH v3 1/5] pg_regress: Include diffs in output

Whenever pg_regress fails there's an indirection to actually get to the
failure reason. Locally it's possible to copy paste the filename and
open the file, but in CI it's necessary to manually traverse the
directory structure by clicking and scrolling a bunch of time.

This change starts printing the first 80 lines of the regression.diffs
file as TAP diagnostics. So it's not necessary to open the
regression.diffs file in many cases.
---
 src/test/regress/pg_regress.c | 87 +++++++++++++++++++++++++++++------
 1 file changed, 74 insertions(+), 13 deletions(-)

diff --git a/src/test/regress/pg_regress.c b/src/test/regress/pg_regress.c
index b5c0cb647a8..0279f429923 100644
--- a/src/test/regress/pg_regress.c
+++ b/src/test/regress/pg_regress.c
@@ -84,6 +84,8 @@ const char *pretty_diff_opts = "--strip-trailing-cr -U3";
 typedef enum TAPtype
 {
 	DIAG = 0,
+	DIAG_DETAIL,
+	DIAG_END,
 	BAIL,
 	NOTE,
 	NOTE_DETAIL,
@@ -131,6 +133,7 @@ static char sockself[MAXPGPATH];
 static char socklock[MAXPGPATH];
 static StringInfo failed_tests = NULL;
 static bool in_note = false;
+static bool in_diag = false;
 
 static _resultmap *resultmap = NULL;
 
@@ -162,6 +165,8 @@ static void psql_end_command(StringInfo buf, const char *database);
 #define note(...)			emit_tap_output(NOTE, __VA_ARGS__)
 #define note_detail(...)	emit_tap_output(NOTE_DETAIL, __VA_ARGS__)
 #define diag(...)			emit_tap_output(DIAG, __VA_ARGS__)
+#define diag_detail(...)	emit_tap_output(DIAG_DETAIL, __VA_ARGS__)
+#define diag_end()			emit_tap_output(DIAG_END, "\n");
 #define note_end()			emit_tap_output(NOTE_END, "\n");
 #define bail_noatexit(...)	bail_out(true, __VA_ARGS__)
 #define bail(...)			bail_out(false, __VA_ARGS__)
@@ -356,7 +361,7 @@ emit_tap_output_v(TAPtype type, const char *fmt, va_list argp)
 	 * Bail message is also printed to stderr to aid debugging under a harness
 	 * which might otherwise not emit such an important message.
 	 */
-	if (type == DIAG || type == BAIL)
+	if (type == DIAG || type == DIAG_DETAIL || type == DIAG_END || type == BAIL)
 		fp = stderr;
 	else
 		fp = stdout;
@@ -365,9 +370,12 @@ emit_tap_output_v(TAPtype type, const char *fmt, va_list argp)
 	 * If we are ending a note_detail line we can avoid further processing and
 	 * immediately return following a newline.
 	 */
-	if (type == NOTE_END)
+	if (type == NOTE_END || type == DIAG_END)
 	{
-		in_note = false;
+		if (type == NOTE_END)
+			in_note = false;
+		else
+			in_diag = false;
 		fprintf(fp, "\n");
 		if (logfile)
 			fprintf(logfile, "\n");
@@ -382,7 +390,8 @@ emit_tap_output_v(TAPtype type, const char *fmt, va_list argp)
 	 * '#' character. We print the Bail message like this too.
 	 */
 	if ((type == NOTE || type == DIAG || type == BAIL)
-		|| (type == NOTE_DETAIL && !in_note))
+		|| (type == NOTE_DETAIL && !in_note)
+		|| (type == DIAG_DETAIL && !in_diag))
 	{
 		fprintf(fp, "# ");
 		if (logfile)
@@ -403,6 +412,8 @@ emit_tap_output_v(TAPtype type, const char *fmt, va_list argp)
 	 */
 	if (type == NOTE_DETAIL)
 		in_note = true;
+	if (type == DIAG_DETAIL)
+		in_diag = true;
 
 	/*
 	 * If this was a Bail message, the bail protocol message must go to stdout
@@ -417,7 +428,7 @@ emit_tap_output_v(TAPtype type, const char *fmt, va_list argp)
 
 	va_end(argp_logfile);
 
-	if (type != NOTE_DETAIL)
+	if (type != NOTE_DETAIL && type != DIAG_DETAIL)
 	{
 		fprintf(fp, "\n");
 		if (logfile)
@@ -1414,6 +1425,7 @@ results_differ(const char *testname, const char *resultsfile, const char *defaul
 	int			best_line_count;
 	int			i;
 	int			l;
+	long		startpos;
 	const char *platform_expectfile;
 
 	/*
@@ -1521,22 +1533,71 @@ results_differ(const char *testname, const char *resultsfile, const char *defaul
 	 * append to the diffs summary file.
 	 */
 
-	/* Write diff header */
-	difffile = fopen(difffilename, "a");
+	difffile = fopen(difffilename, "a+");
 	if (difffile)
 	{
+		fseek(difffile, 0, SEEK_END);
+		startpos = ftell(difffile);
 		fprintf(difffile,
 				"diff %s %s %s\n",
 				pretty_diff_opts, best_expect_file, resultsfile);
+		fflush(difffile);
+
+		/* Run diff */
+		snprintf(cmd, sizeof(cmd),
+				 "diff %s \"%s\" \"%s\" >> \"%s\"",
+				 pretty_diff_opts, best_expect_file, resultsfile, difffilename);
+		run_diff(cmd, difffilename);
+
+		/* Emit diff as TAP diagnostics */
+		{
+			/*
+			 * In case of a crash the diff can be huge and all of the
+			 * subsequent tests will fail with essentially useless diffs too.
+			 * So to avoid flooding the output, while still providing useful
+			 * info in most cases we output only the first 80 lines of the
+			 * *combined* diff. The number 80 is chosen so that we output less
+			 * than 100 lines of diagnostics per pg_regress run. Otherwise if
+			 * meson is run with the --quiet flag only the last 100 lines are
+			 * shown and usually the most useful information is actually in
+			 * the first few lines
+			 */
+			static int	nlines = 0;
+			const int	max_diff_lines = 80;
+			char		line[1024];
+
+			fseek(difffile, startpos, SEEK_SET);
+			while (nlines <= max_diff_lines &&
+				   fgets(line, sizeof(line), difffile))
+			{
+				size_t		len = strlen(line);
+				bool		newline_found = (len > 0 && line[len - 1] == '\n');
+
+				if (newline_found)
+					line[len - 1] = '\0';
+
+				diag_detail("%s", line);
+				if (newline_found)
+				{
+					diag_end();
+
+					if (++nlines > max_diff_lines)
+						diag("(diff output truncated and silencing output for further failing tests...)");
+				}
+			}
+
+			if (in_diag)
+			{
+				/*
+				 * If there was no final newline for some reason, we should
+				 * still end the diagnostic.
+				 */
+				diag_end();
+			}
+		}
 		fclose(difffile);
 	}
 
-	/* Run diff */
-	snprintf(cmd, sizeof(cmd),
-			 "diff %s \"%s\" \"%s\" >> \"%s\"",
-			 pretty_diff_opts, best_expect_file, resultsfile, difffilename);
-	run_diff(cmd, difffilename);
-
 	unlink(diff);
 	return true;
 }

base-commit: 1eb09ed63a8d8063dc6bb75c8f31ec564bf35250
-- 
2.52.0

From 8f4538930e5f658939708e6f3fb123f911c7a1f1 Mon Sep 17 00:00:00 2001
From: Jelte Fennema-Nio <[email protected]>
Date: Mon, 26 Jan 2026 09:09:11 +0100
Subject: [PATCH v3 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 | 52 +++++++++++++++++++++++---
 2 files changed, 47 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..5c4586558bc 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,13 @@ 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);
+	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,13 @@ 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);
+	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.52.0

From c1c4c282a9d8cb11c579a671a9f29153e4cb0e88 Mon Sep 17 00:00:00 2001
From: Jelte Fennema-Nio <[email protected]>
Date: Mon, 26 Jan 2026 09:32:15 +0100
Subject: [PATCH v3 3/5] perl tap: Show die reason in TAP output

In our Perl tests the most commonly used function is probably safe_psql.
But if that call failed you would get this totally useless output in the
meson output:

Tests were run but no plan was declared and done_testing() was not seen.
Looks like your test exited with 29 just after 21.

With this change you get the actual failure reason too:

die: error running SQL: 'psql:<stdin>:2: ERROR:  unterminated quoted string at or near "'"
LINE 1: GRANT ALL ON sysuser_data TO scram_role '
                                                ^'
while running 'psql --no-psqlrc --no-align --tuples-only --quiet --dbname port=17335 host=/tmp/y9KX6JADha dbname='postgres' --file - --variable ON_ERROR_STOP=1' with sql 'CREATE TABLE sysuser_data (n) AS SELECT NULL FROM generate_series(1, 10);
   GRANT ALL ON sysuser_data TO scram_role '' at /home/jelte/work/postgres-3/src/test/perl/PostgreSQL/Test/Cluster.pm line 2300.
Looks like your test exited with 29 just after 21.

Discussion: https://www.postgresql.org/message-id/20220222181924.eehi7o4pmneeb4hm%40alap3.anarazel.de
Discussion: https://www.postgresql.org/message-id/flat/[email protected]
---
 src/test/perl/PostgreSQL/Test/Utils.pm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 5c4586558bc..39f76c0aaba 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -244,6 +244,24 @@ INIT
 	autoflush STDOUT 1;
 	autoflush STDERR 1;
 	autoflush $testlog 1;
+
+	# Because of the above redirection the tap output wouldn't contain
+	# information about tests failing due to die etc. Fix that by also
+	# printing the failure to the original stderr.
+	$SIG{__DIE__} = sub {
+		# Ignore dies because of syntax errors, those will be displayed
+		# correctly anyway.
+		return if !defined $^S;
+
+		# Ignore dies inside evals
+		return if $^S == 1;
+
+		diag("die: $_[0]");
+		# Also call done_testing() to avoid the confusing "no plan was declared"
+		# message in TAP output when a test dies.
+		done_testing();
+	};
+
 }
 
 END
-- 
2.52.0

From 718cf90b26c99d5309b5f9645fbe633769ec4d96 Mon Sep 17 00:00:00 2001
From: Jelte Fennema-Nio <[email protected]>
Date: Mon, 26 Jan 2026 10:04:44 +0100
Subject: [PATCH v3 4/5] perl tap: Use croak instead of die in our perl helper
 modules

Many of our helpers called die, but that means that the line number
reported on exit is the line number in Cluster.pm  or Utils.pm. This
starts using croak everywhere (except for INIT) in our Cluster.pm and
Utils.pm files. That way the line number of the caller is reported
instead.

As an example, this is the new output the safe_psql call that fails:

die: error running SQL: 'psql:<stdin>:2: ERROR:  unterminated quoted string at or near "'"
LINE 1: GRANT ALL ON sysuser_data TO scram_role '
                                                ^'
while running 'psql --no-psqlrc --no-align --tuples-only --quiet --dbname port=26578 host=/tmp/KaOjou8HJa dbname='postgres' --file - --variable ON_ERROR_STOP=1' with sql 'CREATE TABLE sysuser_data (n) AS SELECT NULL FROM generate_series(1, 10);
   GRANT ALL ON sysuser_data TO scram_role '' at /home/jelte/work/postgres-3/src/test/authentication/t/001_password.pl line 144.
Looks like your test exited with 29 just after 21.
---
 src/test/perl/PostgreSQL/Test/Cluster.pm | 108 +++++++++++------------
 src/test/perl/PostgreSQL/Test/Utils.pm   |  26 +++---
 2 files changed, 67 insertions(+), 67 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index e267ba868fe..b62aaa58cc4 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -57,7 +57,7 @@ PostgreSQL::Test::Cluster - class representing PostgreSQL server instance
   # run query every second until it returns 't'
   # or times out
   $node->poll_query_until('postgres', q|SELECT random() < 0.1;|')
-    or die "timed out";
+    or croak "timed out";
 
   # Do an online pg_basebackup
   my $ret = $node->backup('testbackup1');
@@ -339,7 +339,7 @@ sub raw_connect
 		$socket = IO::Socket::UNIX->new(
 			Type => SOCK_STREAM(),
 			Peer => $path,
-		) or die "Cannot create socket - $IO::Socket::errstr\n";
+		) or croak "Cannot create socket - $IO::Socket::errstr\n";
 	}
 	else
 	{
@@ -347,7 +347,7 @@ sub raw_connect
 			PeerHost => $pghost,
 			PeerPort => $pgport,
 			Proto => 'tcp'
-		) or die "Cannot create socket - $IO::Socket::errstr\n";
+		) or croak "Cannot create socket - $IO::Socket::errstr\n";
 	}
 	return $socket;
 }
@@ -406,7 +406,7 @@ sub group_access
 	my $dir_stat = stat($self->data_dir);
 
 	defined($dir_stat)
-	  or die('unable to stat ' . $self->data_dir);
+	  or croak('unable to stat ' . $self->data_dir);
 
 	return (S_IMODE($dir_stat->mode) == 0750);
 }
@@ -508,7 +508,7 @@ sub config_data
 	my $result =
 	  IPC::Run::run [ $self->installed_command('pg_config'), @options ],
 	  '>', \$stdout, '2>', \$stderr
-	  or die "could not execute pg_config";
+	  or croak "could not execute pg_config";
 	# standardize line endings
 	$stdout =~ s/\r(?=\n)//g;
 	# no options, scalar context: just hand back the output
@@ -542,7 +542,7 @@ sub info
 {
 	my ($self) = @_;
 	my $_info = '';
-	open my $fh, '>', \$_info or die;
+	open my $fh, '>', \$_info or croak;
 	print $fh "Name: " . $self->name . "\n";
 	print $fh "Version: " . $self->{_pg_version} . "\n"
 	  if $self->{_pg_version};
@@ -553,7 +553,7 @@ sub info
 	print $fh "Log file: " . $self->logfile . "\n";
 	print $fh "Install Path: ", $self->{_install_path} . "\n"
 	  if $self->{_install_path};
-	close $fh or die;
+	close $fh or croak;
 	return $_info;
 }
 
@@ -583,7 +583,7 @@ sub set_replication_conf
 	$self->host eq $test_pghost
 	  or croak "set_replication_conf only works with the default host";
 
-	open my $hba, '>>', "$pgdata/pg_hba.conf" or die $!;
+	open my $hba, '>>', "$pgdata/pg_hba.conf" or croak $!;
 	print $hba
 	  "\n# Allow replication (set up by PostgreSQL::Test::Cluster.pm)\n";
 	if ($PostgreSQL::Test::Utils::windows_os
@@ -707,7 +707,7 @@ sub init
 	PostgreSQL::Test::Utils::system_or_bail($ENV{PG_REGRESS},
 		'--config-auth', $pgdata, @{ $params{auth_extra} });
 
-	open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
+	open my $conf, '>>', "$pgdata/postgresql.conf" or croak $!;
 	print $conf "\n# Added by PostgreSQL::Test::Cluster.pm\n";
 	print $conf "fsync = off\n";
 	print $conf "restart_after_crash = off\n";
@@ -764,7 +764,7 @@ sub init
 	close $conf;
 
 	chmod($self->group_access ? 0640 : 0600, "$pgdata/postgresql.conf")
-	  or die("unable to set permissions for $pgdata/postgresql.conf");
+	  or croak("unable to set permissions for $pgdata/postgresql.conf");
 
 	$self->set_replication_conf if $params{allows_streaming};
 	$self->enable_archiving if $params{has_archiving};
@@ -793,7 +793,7 @@ sub append_conf
 	PostgreSQL::Test::Utils::append_to_file($conffile, $str . "\n");
 
 	chmod($self->group_access() ? 0640 : 0600, $conffile)
-	  or die("unable to set permissions for $conffile");
+	  or croak("unable to set permissions for $conffile");
 
 	return;
 }
@@ -839,7 +839,7 @@ sub adjust_conf
 	close $fh;
 
 	chmod($self->group_access() ? 0640 : 0600, $conffile)
-	  or die("unable to set permissions for $conffile");
+	  or croak("unable to set permissions for $conffile");
 }
 
 =pod
@@ -995,7 +995,7 @@ sub init_from_backup
 	}
 	elsif (defined $params{tar_program})
 	{
-		mkdir($data_path) || die "mkdir $data_path: $!";
+		mkdir($data_path) || croak "mkdir $data_path: $!";
 		PostgreSQL::Test::Utils::system_or_bail(
 			$params{tar_program},
 			'xf' => $backup_path . '/base.tar',
@@ -1007,7 +1007,7 @@ sub init_from_backup
 
 		# We need to generate a tablespace_map file.
 		open(my $tsmap, ">", "$data_path/tablespace_map")
-		  || die "$data_path/tablespace_map: $!";
+		  || croak "$data_path/tablespace_map: $!";
 
 		# Extract tarfiles and add tablespace_map entries
 		my @tstars = grep { /^\d+.tar/ }
@@ -1017,12 +1017,12 @@ sub init_from_backup
 			my $tsoid = $tstar;
 			$tsoid =~ s/\.tar$//;
 
-			die "no tablespace mapping for $tstar"
+			croak "no tablespace mapping for $tstar"
 			  if !exists $params{tablespace_map}
 			  || !exists $params{tablespace_map}{$tsoid};
 			my $newdir = $params{tablespace_map}{$tsoid};
 
-			mkdir($newdir) || die "mkdir $newdir: $!";
+			mkdir($newdir) || croak "mkdir $newdir: $!";
 			PostgreSQL::Test::Utils::system_or_bail(
 				$params{tar_program},
 				'xf' => $backup_path . '/' . $tstar,
@@ -1061,12 +1061,12 @@ sub init_from_backup
 		{
 			# We need to generate a tablespace_map file.
 			open(my $tsmap, ">", "$data_path/tablespace_map")
-			  || die "$data_path/tablespace_map: $!";
+			  || croak "$data_path/tablespace_map: $!";
 
 			# Now use the list of tablespace links to copy each tablespace.
 			for my $tsoid (@tsoids)
 			{
-				die "no tablespace mapping for $tsoid"
+				croak "no tablespace mapping for $tsoid"
 				  if !exists $params{tablespace_map}
 				  || !exists $params{tablespace_map}{$tsoid};
 
@@ -1083,7 +1083,7 @@ sub init_from_backup
 			close($tsmap);
 		}
 	}
-	chmod(0700, $data_path) or die $!;
+	chmod(0700, $data_path) or croak $!;
 
 	# Base configuration for this node
 	$self->append_conf(
@@ -1906,7 +1906,7 @@ sub can_bind
 	my $paddr = sockaddr_in($port, $iaddr);
 
 	socket(SOCK, PF_INET, SOCK_STREAM, 0)
-	  or die "socket failed: $!";
+	  or croak "socket failed: $!";
 
 	# As in postmaster, don't use SO_REUSEADDR on Windows
 	setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
@@ -1924,9 +1924,9 @@ sub _reserve_port
 	# open in rw mode so we don't have to reopen it and lose the lock
 	my $filename = "$portdir/$port.rsv";
 	sysopen(my $portfile, $filename, O_RDWR | O_CREAT)
-	  || die "opening port file $filename: $!";
+	  || croak "opening port file $filename: $!";
 	# take an exclusive lock to avoid concurrent access
-	flock($portfile, LOCK_EX) || die "locking port file $filename: $!";
+	flock($portfile, LOCK_EX) || croak "locking port file $filename: $!";
 	# see if someone else has or had a reservation of this port
 	my $pid = <$portfile> || "0";
 	chomp $pid;
@@ -1935,16 +1935,16 @@ sub _reserve_port
 		if (kill 0, $pid)
 		{
 			# process exists and is owned by us, so we can't reserve this port
-			flock($portfile, LOCK_UN) || die $!;
+			flock($portfile, LOCK_UN) || croak $!;
 			close($portfile);
 			return 0;
 		}
 	}
 	# All good, go ahead and reserve the port
-	seek($portfile, 0, SEEK_SET) || die $!;
+	seek($portfile, 0, SEEK_SET) || croak $!;
 	# print the pid with a fixed width so we don't leave any trailing junk
 	print $portfile sprintf("%10d\n", $$);
-	flock($portfile, LOCK_UN) || die $!;
+	flock($portfile, LOCK_UN) || croak $!;
 	close($portfile);
 	push(@port_reservation_files, $filename);
 	return 1;
@@ -2246,13 +2246,13 @@ sub psql
 
 			# IPC::Run::run threw an exception. re-throw unless it's a
 			# timeout, which we'll handle by testing is_expired
-			die $exc_save
+			croak $exc_save
 			  if (blessed($exc_save)
 				|| $exc_save !~ /^\Q$timeout_exception\E/);
 
 			$ret = undef;
 
-			die "Got timeout exception '$exc_save' but timer not expired?!"
+			croak "Got timeout exception '$exc_save' but timer not expired?!"
 			  unless $timeout->is_expired;
 
 			if (defined($params{timed_out}))
@@ -2261,7 +2261,7 @@ sub psql
 			}
 			else
 			{
-				die "psql timed out: stderr: '$$stderr'\n"
+				croak "psql timed out: stderr: '$$stderr'\n"
 				  . "while running '@psql_params'";
 			}
 		}
@@ -2284,7 +2284,7 @@ sub psql
 	if (defined $ret)
 	{
 		my $core = $ret & 128 ? " (core dumped)" : "";
-		die "psql exited with signal "
+		croak "psql exited with signal "
 		  . ($ret & 127)
 		  . "$core: '$$stderr' while running '@psql_params'"
 		  if $ret & 127;
@@ -2293,14 +2293,14 @@ sub psql
 
 	if ($ret && $params{on_error_die})
 	{
-		die "psql error: stderr: '$$stderr'\nwhile running '@psql_params'"
+		croak "psql error: stderr: '$$stderr'\nwhile running '@psql_params'"
 		  if $ret == 1;
-		die "connection error: '$$stderr'\nwhile running '@psql_params'"
+		croak "connection error: '$$stderr'\nwhile running '@psql_params'"
 		  if $ret == 2;
-		die
+		croak
 		  "error running SQL: '$$stderr'\nwhile running '@psql_params' with sql '$sql'"
 		  if $ret == 3;
-		die "psql returns $ret: '$$stderr'\nwhile running '@psql_params'";
+		croak "psql returns $ret: '$$stderr'\nwhile running '@psql_params'";
 	}
 
 	if (wantarray)
@@ -2501,7 +2501,7 @@ sub _pgbench_make_files
 			if (-e $filename)
 			{
 				ok(0, "$filename must not already exist");
-				unlink $filename or die "cannot unlink $filename: $!";
+				unlink $filename or croak "cannot unlink $filename: $!";
 			}
 			PostgreSQL::Test::Utils::append_to_file($filename, $$files{$fn});
 		}
@@ -3123,8 +3123,8 @@ sub write_wal
 	my $path =
 	  sprintf("%s/pg_wal/%08X%08X%08X", $self->data_dir, $tli, 0, $segment);
 
-	open my $fh, "+<:raw", $path or die "could not open WAL segment $path";
-	seek($fh, $offset, SEEK_SET) or die "could not seek WAL segment $path";
+	open my $fh, "+<:raw", $path or croak "could not open WAL segment $path";
+	seek($fh, $offset, SEEK_SET) or croak "could not seek WAL segment $path";
 	print $fh $data;
 	close $fh;
 
@@ -3288,7 +3288,7 @@ sub wait_for_event
 		SELECT count(*) > 0 FROM pg_stat_activity
 		WHERE backend_type = '$backend_type' AND wait_event = '$wait_event_name'
 	])
-	  or die
+	  or croak
 	  qq(timed out when waiting for $backend_type to reach wait event '$wait_event_name');
 
 	return;
@@ -3325,7 +3325,7 @@ poll_query_until timeout.
 
 Requires that the 'postgres' db exists and is accessible.
 
-This is not a test. It die()s on failure.
+This is not a test. It croak()s on failure.
 
 =cut
 
@@ -3409,7 +3409,7 @@ The replication connection must be in a streaming state.
 
 Requires that the 'postgres' db exists and is accessible.
 
-This is not a test. It die()s on failure.
+This is not a test. It croak()s on failure.
 
 =cut
 
@@ -3429,7 +3429,7 @@ be 'restart' or 'confirmed_flush'.
 
 Requires that the 'postgres' db exists and is accessible.
 
-This is not a test. It die()s on failure.
+This is not a test. It croak()s on failure.
 
 If the slot is not active, will time out after poll_query_until's timeout.
 
@@ -3484,7 +3484,7 @@ creating a new subscription.
 If there is no active replication connection from this peer, wait until
 poll_query_until timeout.
 
-This is not a test. It die()s on failure.
+This is not a test. It croak()s on failure.
 
 =cut
 
@@ -3624,7 +3624,7 @@ Disallows pg_recvlogical from internally retrying on error by passing --no-loop.
 
 Plugin options are passed as additional keyword arguments.
 
-If called in scalar context, returns stdout, and die()s on timeout or nonzero return.
+If called in scalar context, returns stdout, and croak()s on timeout or nonzero return.
 
 If called in array context, returns a tuple of (retval, stdout, stderr, timeout).
 timeout is the IPC::Run::Timeout object whose is_expired method can be tested
@@ -3680,15 +3680,15 @@ sub pg_recvlogical_upto
 
 			# IPC::Run::run threw an exception. re-throw unless it's a
 			# timeout, which we'll handle by testing is_expired
-			die $exc_save
+			croak $exc_save
 			  if (blessed($exc_save) || $exc_save !~ qr/$timeout_exception/);
 
 			$ret = undef;
 
-			die "Got timeout exception '$exc_save' but timer not expired?!"
+			croak "Got timeout exception '$exc_save' but timer not expired?!"
 			  unless $timeout->is_expired;
 
-			die
+			croak
 			  "$exc_save waiting for endpos $endpos with stdout '$stdout', stderr '$stderr'"
 			  unless wantarray;
 		}
@@ -3700,7 +3700,7 @@ sub pg_recvlogical_upto
 	}
 	else
 	{
-		die
+		croak
 		  "pg_recvlogical exited with code '$ret', stdout '$stdout' and stderr '$stderr'"
 		  if $ret;
 		return $stdout;
@@ -3725,14 +3725,14 @@ sub corrupt_page_checksum
 	my $pgdata = $self->data_dir;
 	my $pageheader;
 
-	open my $fh, '+<', "$pgdata/$file" or die "open($file) failed: $!";
+	open my $fh, '+<', "$pgdata/$file" or croak "open($file) failed: $!";
 	binmode $fh;
-	sysseek($fh, $page_offset, 0) or die "sysseek failed: $!";
-	sysread($fh, $pageheader, 24) or die "sysread failed: $!";
+	sysseek($fh, $page_offset, 0) or croak "sysseek failed: $!";
+	sysread($fh, $pageheader, 24) or croak "sysread failed: $!";
 	# This inverts the pd_checksum field (only); see struct PageHeaderData
 	$pageheader ^= "\0\0\0\0\0\0\0\0\xff\xff";
-	sysseek($fh, $page_offset, 0) or die "sysseek failed: $!";
-	syswrite($fh, $pageheader) or die "syswrite failed: $!";
+	sysseek($fh, $page_offset, 0) or croak "sysseek failed: $!";
+	syswrite($fh, $pageheader) or croak "syswrite failed: $!";
 	close $fh;
 
 	return;
@@ -3760,7 +3760,7 @@ sub log_standby_snapshot
 		SELECT restart_lsn IS NOT NULL
 		FROM pg_catalog.pg_replication_slots WHERE slot_name = '$slot_name'
 	])
-	  or die
+	  or croak
 	  "timed out waiting for logical slot to calculate its restart_lsn";
 
 	# Then arrange for the xl_running_xacts record for which the standby is
@@ -3802,7 +3802,7 @@ sub create_logical_slot_on_standby
 
 	is($self->slot($slot_name)->{'slot_type'},
 		'logical', $slot_name . ' on standby created')
-	  or die "could not create slot" . $slot_name;
+	  or croak "could not create slot" . $slot_name;
 }
 
 =pod
@@ -3833,7 +3833,7 @@ sub validate_slot_inactive_since
 		),
 		't',
 		"last inactive time for slot $slot_name is valid on node $name")
-	  or die "could not validate captured inactive_since for slot $slot_name";
+	  or croak "could not validate captured inactive_since for slot $slot_name";
 
 	return $inactive_since;
 }
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 39f76c0aaba..949bd219a8d 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -636,7 +636,7 @@ sub read_head_tail
 
 	return ([], []) if $line_count <= 0;
 
-	open my $fh, '<', $filename or die "couldn't open file: $filename\n";
+	open my $fh, '<', $filename or croak "couldn't open file: $filename\n";
 	my @lines = <$fh>;
 	close $fh;
 
@@ -701,7 +701,7 @@ sub check_mode_recursive
 					}
 					else
 					{
-						die $msg;
+						croak $msg;
 					}
 				}
 
@@ -740,7 +740,7 @@ sub check_mode_recursive
 				# Else something we can't handle
 				else
 				{
-					die "unknown file type for $File::Find::name";
+					croak "unknown file type for $File::Find::name";
 				}
 			}
 		},
@@ -772,7 +772,7 @@ sub chmod_recursive
 					chmod(
 						S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode,
 						$File::Find::name
-					) or die "unable to chmod $File::Find::name";
+					) or croak "unable to chmod $File::Find::name";
 				}
 			}
 		},
@@ -798,11 +798,11 @@ sub scan_server_header
 	my $result = IPC::Run::run [ 'pg_config', '--includedir-server' ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr
-	  or die "could not execute pg_config";
+	  or croak "could not execute pg_config";
 	chomp($stdout);
 	$stdout =~ s/\r$//;
 
-	open my $header_h, '<', "$stdout/$header_path" or die "$!";
+	open my $header_h, '<', "$stdout/$header_path" or croak "$!";
 
 	my @match = undef;
 	while (<$header_h>)
@@ -816,7 +816,7 @@ sub scan_server_header
 	}
 
 	close $header_h;
-	die "could not find match in header $header_path\n"
+	croak "could not find match in header $header_path\n"
 	  unless @match;
 	return @match;
 }
@@ -837,11 +837,11 @@ sub check_pg_config
 	my $result = IPC::Run::run [ 'pg_config', '--includedir' ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr
-	  or die "could not execute pg_config";
+	  or croak "could not execute pg_config";
 	chomp($stdout);
 	$stdout =~ s/\r$//;
 
-	open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!";
+	open my $pg_config_h, '<', "$stdout/pg_config.h" or croak "$!";
 	my $match = (grep { /^$regexp/ } <$pg_config_h>);
 	close $pg_config_h;
 	return $match;
@@ -946,13 +946,13 @@ sub dir_symlink
 			# need some indirection on msys
 			$cmd = qq{echo '$cmd' | \$COMSPEC /Q};
 		}
-		system($cmd) == 0 or die;
+		system($cmd) == 0 or croak;
 	}
 	else
 	{
-		symlink $oldname, $newname or die $!;
+		symlink $oldname, $newname or croak $!;
 	}
-	die "No $newname" unless -e $newname;
+	croak "No $newname" unless -e $newname;
 }
 
 # Log command output. Truncates to first/last 30 lines if over 60 lines.
@@ -1274,7 +1274,7 @@ sub command_checks_all
 
 	# See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR
 	my $ret = $?;
-	die "command exited with signal " . ($ret & 127)
+	croak "command exited with signal " . ($ret & 127)
 	  if $ret & 127;
 	$ret = $ret >> 8;
 
-- 
2.52.0

Reply via email to