v2-0001-inproduce-general-polling-functions-for-TAP-tests.patch

From 9381683a804b17434399c0bffc280ffd371890e8 Mon Sep 17 00:00:00 2001
From: roman khapov <r.khapov@ya.ru>
Date: Mon, 22 Dec 2025 13:41:20 +0000
Subject: [PATCH v2 1/2] inproduce general polling functions for TAP tests

There are polling logic across all TAP tests, one of
the notable example is poll_query_until.

This logic must be implemented in each test in case the
test want to perform some polling actions.

This patch introduces two new functions at Utils:
 - poll_until, that make polling general condition callback
 - poll_cmd_until, that uses poll_until and makes polling for
background process results.

Existed poll_query_until rewritten to use more general poll_cmd_until,
both new functions will be used in next patch, to implement all the
waitings in tests for archive_mode=follow_primary feature.

Author: Roman Khapov <r.khapov@ya.ru>
Reviewed-by:
Discussion:
---
 src/test/perl/PostgreSQL/Test/Cluster.pm |  41 +------
 src/test/perl/PostgreSQL/Test/Utils.pm   | 146 +++++++++++++++++++++++
 2 files changed, 152 insertions(+), 35 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 295988b8b87..e9add0c6660 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -2726,7 +2726,7 @@ sub poll_query_until
 {
 	my ($self, $dbname, $query, $expected) = @_;
 
-	local %ENV = $self->_get_env();
+	my %env = $self->_get_env();
 
 	$expected = 't' unless defined($expected);    # default value
 
@@ -2736,41 +2736,12 @@ sub poll_query_until
 		'--dbname' => $self->connstr($dbname)
 	];
 	my ($stdout, $stderr);
-	my $max_attempts = 10 * $PostgreSQL::Test::Utils::timeout_default;
-	my $attempts = 0;
 
-	while ($attempts < $max_attempts)
-	{
-		my $result = IPC::Run::run $cmd,
-		  '<' => \$query,
-		  '>' => \$stdout,
-		  '2>' => \$stderr;
-
-		chomp($stdout);
-		chomp($stderr);
-
-		if ($stdout eq $expected && $stderr eq '')
-		{
-			return 1;
-		}
-
-		# Wait 0.1 second before retrying.
-		usleep(100_000);
-
-		$attempts++;
-	}
-
-	# Give up. Print the output from the last attempt, hopefully that's useful
-	# for debugging.
-	diag qq(poll_query_until timed out executing this query:
-$query
-expecting this output:
-$expected
-last actual query output:
-$stdout
-with stderr:
-$stderr);
-	return 0;
+	return PostgreSQL::Test::Utils::poll_cmd($cmd,
+		input => $query,
+		expected => $expected,
+		env => \%env
+	);
 }
 
 =pod
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 0332d28916e..4f247b28f1b 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -57,6 +57,7 @@ use File::stat qw(stat);
 use File::Temp ();
 use IPC::Run;
 use POSIX qw(locale_h);
+use Time::HiRes qw(usleep);
 use PostgreSQL::Test::SimpleTee;
 
 # We need a version of Test::More recent enough to support subtests
@@ -562,6 +563,151 @@ sub append_to_file
 	close $fh;
 	return;
 }
+=pod
+
+=item poll_until($condition, [, %options])
+
+Run callback B<$condition> repeatedly, until it returns 1
+Continues polling if B<$condition> returns an error result.
+Times out after $PostgreSQL::Test::Utils::timeout_default seconds.
+Returns 1 if successful, 0 if timed out.
+
+=over
+
+=item interval => $number
+
+Number of microseconds to wait before next poll.
+Default is 100_000 (0.1 second).
+
+=item max_attempts => $number
+
+Maximum number of polling attempts.
+Default is B<$PostgreSQL::Test::Utils::timeout_default> / B<$interval>.
+
+=back
+
+=cut
+
+sub poll_until
+{
+	my ($condition, %args) = @_;
+
+	my $interval = $args{interval} // 100_000;
+	my $max_attempts = $args{max_attempts} // int($timeout_default * 1_000_000 / $interval);
+
+	my $attempts = 0;
+	while ($attempts < $max_attempts)
+	{
+		if ($condition->())
+		{
+			return 1;
+		}
+
+		usleep($interval);
+
+		$attempts++;
+	}
+
+	return 0;
+}
+
+=pod
+
+=item poll_cmd($cmd, %options)
+
+Run B<$cmd> repeatedly until it returns the expected result.
+Continues polling if B<$cmd> returns an error result.
+Times out after B<$PostgreSQL::Test::Utils::timeout_default> seconds.
+Returns 1 if successful, 0 if timed out.
+
+=over
+
+=item expected => $string
+
+Expected stdout output. If not provided, checks for zero return code.
+
+=item input => $string
+
+Optional input to pass to the command via stdin.
+
+=item interval => $number
+
+Number of microseconds to wait before next poll.
+Default is 100_000 (0.1 second).
+
+=item max_attempts => $number
+
+Maximum number of polling attempts.
+Default is B<$PostgreSQL::Test::Utils::timeout_default> / B<$interval>.
+
+=item env => \%hash
+
+Hash reference with environment variables to set for the command.
+
+=back
+
+=cut
+
+sub poll_cmd
+{
+	my ($cmd, %args) = @_;
+
+	my $expected = $args{expected};
+	my $input = $args{input};
+	my $env = $args{env};
+	my $max_attempts = $args{max_attempts};
+	my $interval = $args{interval};
+
+	my ($stdout, $stderr);
+
+	local %ENV = %$env if defined($env);
+
+	my $condition = sub {
+		my $result;
+
+		$result = IPC::Run::run $cmd,
+		  '<' => \$input,
+		  '>' => \$stdout,
+		  '2>' => \$stderr;
+
+		chomp($stdout);
+		chomp($stderr);
+
+		if (defined($expected))
+		{
+			return ($stdout eq $expected && $stderr eq '');
+		}
+		else
+		{
+			return $result;
+		}
+	};
+
+	my %poll_args = ();
+	$poll_args{max_attempts} = $max_attempts if defined($max_attempts);
+	$poll_args{interval} = $interval if defined($interval);
+
+	my $result = poll_until($condition, %poll_args);
+
+	if (!$result)
+	{
+		my $cmd_str = join(' ', @$cmd);
+		my $expected_str = defined($expected) ? $expected : '<successful exit code>';
+
+		diag qq(poll_cmd timed out executing this cmd:
+$cmd_str
+with input:
+$input
+expecting this output:
+$expected_str
+last actual cmd output:
+$stdout
+with stderr:
+$stderr);
+	}
+
+	return $result;
+}
 
 =pod
 
-- 
2.43.0