From ba08edb065459fca62191c020362022efd42b522 Mon Sep 17 00:00:00 2001
From: Michael Paquier <michael@paquier.xyz>
Date: Wed, 6 Nov 2024 15:31:14 +0900
Subject: [PATCH] Extend Cluster.pm's background_psql() to be able to start
 asynchronously

This commit extends the constructor routine of BackgroundPsql.pm with a
new "wait" parameter.  If set to 0, the routine returns without waiting
for psql to start, ready to consume input.

background_psql() in Cluster.pm gains the same "wait" parameter.  The
default behavior is still to wait for psql to start.  It becomes now
possible to not wait, giving to TAP scripts the possibility to perform
actions between a BackgroundPsql startup and its wait_connect() call.

Author: Jacob Champion
Discussion: https://postgr.es/m/CAOYmi+=60deN20WDyCoHCiecgivJxr=98s7s7-C8SkXwrCfHXg@mail.gmail.com
---
 .../perl/PostgreSQL/Test/BackgroundPsql.pm    | 28 ++++++++++++++-----
 src/test/perl/PostgreSQL/Test/Cluster.pm      | 10 ++++++-
 2 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
index 3c2aca1c5d7..c7a3d3e920d 100644
--- a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
+++ b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
@@ -68,7 +68,7 @@ use Test::More;
 
 =over
 
-=item PostgreSQL::Test::BackgroundPsql->new(interactive, @psql_params, timeout)
+=item PostgreSQL::Test::BackgroundPsql->new(interactive, @psql_params, timeout, wait)
 
 Builds a new object of class C<PostgreSQL::Test::BackgroundPsql> for either
 an interactive or background session and starts it. If C<interactive> is
@@ -76,12 +76,15 @@ true then a PTY will be attached. C<psql_params> should contain the full
 command to run psql with all desired parameters and a complete connection
 string. For C<interactive> sessions, IO::Pty is required.
 
+This routine will not return until psql has started up and is ready to
+consume input. Set B<wait> to 0 to return immediately instead.
+
 =cut
 
 sub new
 {
 	my $class = shift;
-	my ($interactive, $psql_params, $timeout) = @_;
+	my ($interactive, $psql_params, $timeout, $wait) = @_;
 	my $psql = {
 		'stdin' => '',
 		'stdout' => '',
@@ -119,14 +122,25 @@ sub new
 
 	my $self = bless $psql, $class;
 
-	$self->_wait_connect();
+	$wait = 1 unless defined($wait);
+	if ($wait)
+	{
+		$self->wait_connect();
+	}
 
 	return $self;
 }
 
-# Internal routine for awaiting psql starting up and being ready to consume
-# input.
-sub _wait_connect
+=pod
+
+=item $session->wait_connect
+
+Returns once psql has started up and is ready to consume input. This is called
+automatically for clients unless requested otherwise in the constructor.
+
+=cut
+
+sub wait_connect
 {
 	my ($self) = @_;
 
@@ -187,7 +201,7 @@ sub reconnect_and_clear
 	$self->{stdin} = '';
 	$self->{stdout} = '';
 
-	$self->_wait_connect();
+	$self->wait_connect();
 }
 
 =pod
diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 007571e948e..e5526c7565f 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -2286,6 +2286,12 @@ connection.
 
 If given, it must be an array reference containing additional parameters to B<psql>.
 
+=item wait => 1
+
+By default, this method will not return until connection has completed (or
+failed). Set B<wait> to 0 to return immediately instead. (Clients can call the
+session's C<wait_connect> method manually when needed.)
+
 =back
 
 =cut
@@ -2316,13 +2322,15 @@ sub background_psql
 		'-XAtq', '-d', $psql_connstr, '-f', '-');
 
 	$params{on_error_stop} = 1 unless defined $params{on_error_stop};
+	$params{wait} = 1 unless defined $params{wait};
 	$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, $timeout);
+	return PostgreSQL::Test::BackgroundPsql->new(0, \@psql_params, $timeout,
+		$params{wait});
 }
 
 =pod