From d0d04d080992c42478d228a4f73ff19a4703297e Mon Sep 17 00:00:00 2001 From: Andrew Dunstan Date: Tue, 2 Jun 2026 11:28:05 -0400 Subject: [PATCH v12 2/3] Use PostgreSQL::Test::Session within the TAP test framework Make the test framework itself benefit from in-process libpq access: * PostgreSQL::Test::Cluster::safe_psql() runs a single, parameterless statement through a Session instead of spawning psql, falling back to psql for multi-statement or parameterized calls. * poll_query_until() polls through a Session. * add poll_until_connection() to wait for the server to accept connections. Also harden PostgreSQL::Test::Utils against errors raised during global destruction. Such errors happen after the test body has finished (for example FFI::Platypus bindings or callback closures being freed in an unpredictable order as the process exits); reporting them by calling done_testing() a second time would spuriously fail an otherwise-passing test, so they are now logged and ignored. --- src/test/perl/PostgreSQL/Test/Cluster.pm | 114 ++++++++++++++++------- src/test/perl/PostgreSQL/Test/Utils.pm | 13 +++ 2 files changed, 91 insertions(+), 36 deletions(-) diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm index 4fcb1f6be56..a5bf18e6a16 100644 --- a/src/test/perl/PostgreSQL/Test/Cluster.pm +++ b/src/test/perl/PostgreSQL/Test/Cluster.pm @@ -112,6 +112,7 @@ use Socket; use Test::More; use PostgreSQL::Test::Utils (); use PostgreSQL::Test::BackgroundPsql (); +use PostgreSQL::Test::Session; use Text::ParseWords qw(shellwords); use Time::HiRes qw(usleep); use Scalar::Util qw(blessed); @@ -2071,20 +2072,40 @@ sub safe_psql my ($stdout, $stderr); - my $ret = $self->psql( - $dbname, $sql, - %params, - stdout => \$stdout, - stderr => \$stderr, - on_error_die => 1, - on_error_stop => 1); - - # psql can emit stderr from NOTICEs etc - if ($stderr ne "") + # for now only use a Session object for single statement sql without + # any special params + if ($sql =~ /\w/ && $sql !~ /\\bind|;.*\w/s && !scalar(keys(%params))) { - print "#### Begin standard error\n"; - print $stderr; - print "\n#### End standard error\n"; + + my $session = PostgreSQL::Test::Session->new(node=> $self, + dbname => $dbname); + my $res = $session->query($sql); + my $status = $res->{status}; + $stdout = $res->{psqlout} // ""; + $stderr = $res->{error_message} // ""; + die "error: status = $status stderr: '$stderr'\nwhile running '$sql'" + if ($status != 1 && $status != 2); # COMMAND_OK or COMMAND_TUPLES + + } + else + { + # diag "safe_psql call has params or multiple statements"; + + my $ret = $self->psql( + $dbname, $sql, + %params, + stdout => \$stdout, + stderr => \$stderr, + on_error_die => 1, + on_error_stop => 1); + + # psql can emit stderr from NOTICEs etc + if ($stderr ne "") + { + print "#### Begin standard error\n"; + print $stderr; + print "\n#### End standard error\n"; + } } return $stdout; @@ -2188,6 +2209,9 @@ sub psql local %ENV = $self->_get_env(); + # uncomment to get a count of calls to psql + # note("counting psql"); + my $stdout = $params{stdout}; my $stderr = $params{stderr}; my $replication = $params{replication}; @@ -2761,33 +2785,20 @@ sub poll_query_until { my ($self, $dbname, $query, $expected) = @_; - local %ENV = $self->_get_env(); - $expected = 't' unless defined($expected); # default value - my $cmd = [ - $self->installed_command('psql'), '--no-psqlrc', - '--no-align', '--tuples-only', - '--dbname' => $self->connstr($dbname) - ]; - my ($stdout, $stderr); + my $session = PostgreSQL::Test::Session->new(node => $self, + dbname => $dbname); my $max_attempts = 10 * $PostgreSQL::Test::Utils::timeout_default; my $attempts = 0; + my $query_value; + 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; - } + my $result = $session->query($query); + $query_value = ($result->{psqlout} // ""); + return 1 if $query_value eq $expected; # Wait 0.1 second before retrying. usleep(100_000); @@ -2802,9 +2813,40 @@ $query expecting this output: $expected last actual query output: -$stdout -with stderr: -$stderr); +$query_value +); + return 0; +} + +=pod + +=item $node->poll_until_connection($dbname) + +Try to connect repeatedly, until it we succeed. +Times out after $PostgreSQL::Test::Utils::timeout_default seconds. +Returns 1 if successful, 0 if timed out. + +=cut + +sub poll_until_connection +{ + my ($self, $dbname) = @_; + + my $max_attempts = 10 * $PostgreSQL::Test::Utils::timeout_default; + my $attempts = 0; + + while ($attempts < $max_attempts) + { + my $session = PostgreSQL::Test::Session->new(node => $self, + dbname => $dbname); + return 1 if $session; + + # Wait 0.1 second before retrying. + usleep(100_000); + + $attempts++; + } + return 0; } diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm index d3e6abf7a68..c091ce0326d 100644 --- a/src/test/perl/PostgreSQL/Test/Utils.pm +++ b/src/test/perl/PostgreSQL/Test/Utils.pm @@ -262,6 +262,19 @@ INIT # Ignore dies inside evals return if $^S == 1; + # Dies during global destruction happen after the test body has + # finished (done_testing() has already run). They are typically + # harmless teardown-ordering artifacts -- for example FFI::Platypus + # bindings or callback closures being freed in an unpredictable order + # while the process exits. Reporting them by calling done_testing() + # again would spuriously fail an otherwise-passing test, so just log + # them and return. + if (${^GLOBAL_PHASE} eq 'DESTRUCT') + { + diag("die during global destruction (ignored): $_[0]"); + return; + } + diag("die: $_[0]"); # Also call done_testing() to avoid the confusing "no plan was declared" # message in TAP output when a test dies. -- 2.43.0