From 187b8991f70fc3d2a13dc709edd408a8df0be055 Mon Sep 17 00:00:00 2001
From: Heikki Linnakangas <heikki.linnakangas@iki.fi>
Date: Thu, 27 Jun 2024 19:00:59 +0300
Subject: [PATCH] Backport BackgroundPsql perl test module

Backport the new BackgroundPsql modules and the constructor functions,
background_psql() and interactive_psql, to all supported
branches. That makes it easier to backpatch tests that use it.

BackgroundPsql was introduced in version 16. On version 16, this
commit backports just the new timeout argument from master (commit
334f512f45). On older branches, the whole facility. This includes the
change to `use warnings FATAL => 'all'`, which we haven't otherwise
backported, but it seems good to keep the file identical across
branches.

Discussion: https://www.postgresql.org/message-id/b7c64f20-ea01-4f15-9088-0cd6832af149@iki.fi
---
 src/test/perl/PostgreSQL/Test/BackgroundPsql.pm | 14 ++++++++------
 src/test/perl/PostgreSQL/Test/Cluster.pm        | 11 ++++++++---
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
index 764f0a53801..4091c311b8a 100644
--- a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
+++ b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
@@ -1,5 +1,5 @@
 
-# Copyright (c) 2021-2023, PostgreSQL Global Development Group
+# Copyright (c) 2021-2024, PostgreSQL Global Development Group
 
 =pod
 
@@ -54,7 +54,7 @@ initiated by PostgreSQL::Test::Cluster.
 package PostgreSQL::Test::BackgroundPsql;
 
 use strict;
-use warnings;
+use warnings FATAL => 'all';
 
 use Carp;
 use Config;
@@ -68,7 +68,7 @@ use Test::More;
 
 =over
 
-=item PostgreSQL::Test::BackgroundPsql->new(interactive, @params)
+=item PostgreSQL::Test::BackgroundPsql->new(interactive, @psql_params, timeout)
 
 Builds a new object of class C<PostgreSQL::Test::BackgroundPsql> for either
 an interactive or background session and starts it. If C<interactive> is
@@ -81,7 +81,7 @@ string. For C<interactive> sessions, IO::Pty is required.
 sub new
 {
 	my $class = shift;
-	my ($interactive, $psql_params) = @_;
+	my ($interactive, $psql_params, $timeout) = @_;
 	my $psql = {
 		'stdin' => '',
 		'stdout' => '',
@@ -96,8 +96,10 @@ sub new
 	  "Forbidden caller of constructor: package: $package, file: $file:$line"
 	  unless $package->isa('PostgreSQL::Test::Cluster');
 
-	$psql->{timeout} =
-	  IPC::Run::timeout($PostgreSQL::Test::Utils::timeout_default);
+	$psql->{timeout} = IPC::Run::timeout(
+		defined($timeout)
+		? $timeout
+		: $PostgreSQL::Test::Utils::timeout_default);
 
 	if ($interactive)
 	{
diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 7743ffd544d..74592eba692 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -1972,8 +1972,6 @@ sub psql
 
 Invoke B<psql> on B<$dbname> and return a BackgroundPsql object.
 
-A timeout of $PostgreSQL::Test::Utils::timeout_default is set up.
-
 psql is invoked in tuples-only unaligned mode with reading of B<.psqlrc>
 disabled.  That may be overridden by passing extra psql parameters.
 
@@ -1991,6 +1989,11 @@ By default, the B<psql> method invokes the B<psql> program with ON_ERROR_STOP=1
 set, so SQL execution is stopped at the first error and exit code 3 is
 returned.  Set B<on_error_stop> to 0 to ignore errors instead.
 
+=item timeout => 'interval'
+
+Set a timeout for a background psql session. By default, timeout of
+$PostgreSQL::Test::Utils::timeout_default is set up.
+
 =item replication => B<value>
 
 If set, add B<replication=value> to the conninfo string.
@@ -2012,6 +2015,7 @@ sub background_psql
 	local %ENV = $self->_get_env();
 
 	my $replication = $params{replication};
+	my $timeout = undef;
 
 	my @psql_params = (
 		$self->installed_command('psql'),
@@ -2023,12 +2027,13 @@ sub background_psql
 		'-');
 
 	$params{on_error_stop} = 1 unless defined $params{on_error_stop};
+	$timeout = $params{timeout} if defined $params{timeout};
 
 	push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop};
 	push @psql_params, @{ $params{extra_params} }
 	  if defined $params{extra_params};
 
-	return PostgreSQL::Test::BackgroundPsql->new(0, \@psql_params);
+	return PostgreSQL::Test::BackgroundPsql->new(0, \@psql_params, $timeout);
 }
 
 =pod