diff --git a/.github/workflows/pg-ci.yml b/.github/workflows/pg-ci.yml
index 5bc5292d2a..5992e58843 100644
--- a/.github/workflows/pg-ci.yml
+++ b/.github/workflows/pg-ci.yml
@@ -336,6 +336,22 @@ jobs:
127.0.0.3 pg-loadbalancetest
EOF
+ # The CI container images don't yet include FFI::Platypus,
+ # which PostgreSQL::Test::Session needs. Install it from the
+ # Debian package until the images provide it. The 32-bit job
+ # runs its TAP tests with the image's i386 perl, which needs
+ # the i386 build of the module; that package cannot be
+ # installed alongside the amd64 one (it depends on perl:i386,
+ # which conflicts with the installed perl), so extract it into
+ # place the same way the image provides the i386 perl itself.
+ echo ::group::apt_ffi_platypus
+ apt-get -y -q update
+ apt-get -y -q install libffi-platypus-perl
+ (cd /tmp &&
+ apt-get -y -q download libffi-platypus-perl:i386 &&
+ dpkg -x libffi-platypus-perl_*_i386.deb /)
+ echo ::endgroup::
+
# By using a shell that includes su, the run commands themselves get
# simpler. As there are quite a few commands that need to use su...
- name: Configure
@@ -668,6 +684,16 @@ jobs:
- name: Test world
shell: *su_postgres_shell
+ # PostgreSQL::Test::Session loads the ASan-instrumented libpq
+ # in-process via FFI::Platypus. ASan must come first in the link
+ # order; dlopening it into an otherwise uninstrumented perl aborts
+ # with "ASan runtime does not come first". Preload the ASan
+ # runtime for the test run to satisfy that (a no-op for the
+ # already-instrumented server/client binaries). Scoped to this
+ # step so the build is unaffected; detect_leaks is already
+ # disabled via ASAN_OPTIONS.
+ env:
+ ADDITIONAL_SETUP: export LD_PRELOAD="$(gcc -print-file-name=libasan.so)"
run: *meson_test_world_cmd
- *linux_collect_cores_step
@@ -702,12 +728,15 @@ jobs:
MACOS_PACKAGE_LIST: >-
ccache
+ curl
icu
kerberos5
+ libuuid
lz4
meson
openldap
openssl
+ p5.34-ffi-platypus
p5.34-io-tty
p5.34-ipc-run
python312
@@ -1089,6 +1118,7 @@ jobs:
${MINGW_PACKAGE_PREFIX}-gcc \
${MINGW_PACKAGE_PREFIX}-icu \
${MINGW_PACKAGE_PREFIX}-libbacktrace \
+ ${MINGW_PACKAGE_PREFIX}-libffi \
${MINGW_PACKAGE_PREFIX}-libxml2 \
${MINGW_PACKAGE_PREFIX}-libxslt \
${MINGW_PACKAGE_PREFIX}-lz4 \
@@ -1112,6 +1142,15 @@ jobs:
perl -mIPC::Run -e 1
echo ::endgroup::
+ # FFI::Platypus, needed by PostgreSQL::Test::Session, is not
+ # packaged for MSYS2, so install it from CPAN. The mingw libffi
+ # installed above lets Alien::FFI use the system library rather
+ # than building its own.
+ echo ::group::cpan_ffi_platypus
+ (echo; echo o conf recommends_policy 0; echo notest install FFI::Platypus) | cpan
+ perl -mFFI::Platypus -e 1
+ echo ::endgroup::
+
- name: Setup socket directory
shell: cmd
run: mkdir ${{env.PG_REGRESS_SOCK_DIR}}
diff --git a/config/check_modules.pl b/config/check_modules.pl
index c659b7aade..e4deab6e3d 100644
--- a/config/check_modules.pl
+++ b/config/check_modules.pl
@@ -13,6 +13,10 @@
use IPC::Run 0.79;
+# PostgreSQL::Test::Session needs api => 1 and record_layout_1,
+# which arrived in FFI::Platypus 1.00.
+use FFI::Platypus 1.00;
+
# Test::More and Time::HiRes are supposed to be part of core Perl,
# but some distros omit them in a minimal installation.
use Test::More 0.98;
@@ -20,6 +24,7 @@
# While here, we might as well report exactly what versions we found.
diag("IPC::Run::VERSION: $IPC::Run::VERSION");
+diag("FFI::Platypus::VERSION: $FFI::Platypus::VERSION");
diag("Test::More::VERSION: $Test::More::VERSION");
diag("Time::HiRes::VERSION: $Time::HiRes::VERSION");
diff --git a/configure b/configure
index 5f77f3cac2..804062fa9d 100755
--- a/configure
+++ b/configure
@@ -1551,7 +1551,8 @@ Optional Features:
--enable-profiling build with profiling enabled
--enable-coverage build with coverage testing instrumentation
--enable-dtrace build with DTrace support
- --enable-tap-tests enable TAP tests (requires Perl and IPC::Run)
+ --enable-tap-tests enable TAP tests (requires Perl, IPC::Run and
+ FFI::Platypus)
--enable-injection-points
enable injection points (for testing)
--enable-depend turn on automatic dependency tracking
diff --git a/configure.ac b/configure.ac
index 61cee42daa..0ba011c0bc 100644
--- a/configure.ac
+++ b/configure.ac
@@ -229,7 +229,7 @@ AC_SUBST(enable_dtrace)
# TAP tests
#
PGAC_ARG_BOOL(enable, tap-tests, no,
- [enable TAP tests (requires Perl and IPC::Run)])
+ [enable TAP tests (requires Perl, IPC::Run and FFI::Platypus)])
AC_SUBST(enable_tap_tests)
AC_ARG_VAR(PG_TEST_EXTRA,
[enable selected extra tests (overridden at runtime by PG_TEST_EXTRA environment variable)])
diff --git a/contrib/amcheck/t/001_verify_heapam.pl b/contrib/amcheck/t/001_verify_heapam.pl
index e3fee19ae5..9ea72179fc 100644
--- a/contrib/amcheck/t/001_verify_heapam.pl
+++ b/contrib/amcheck/t/001_verify_heapam.pl
@@ -5,6 +5,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -18,7 +19,9 @@
$node->init(no_data_checksums => 1);
$node->append_conf('postgresql.conf', 'autovacuum=off');
$node->start;
-$node->safe_psql('postgres', q(CREATE EXTENSION amcheck));
+my $session = PostgreSQL::Test::Session->new(node => $node);
+
+$session->do(q(CREATE EXTENSION amcheck));
#
# Check a table with data loaded but no corruption, freezing, etc.
@@ -49,7 +52,7 @@
# Check a corrupt table with all-frozen data
#
fresh_test_table('test');
-$node->safe_psql('postgres', q(VACUUM (FREEZE, DISABLE_PAGE_SKIPPING) test));
+$session->do(q(VACUUM (FREEZE, DISABLE_PAGE_SKIPPING) test));
detects_no_corruption("verify_heapam('test')",
"all-frozen not corrupted table");
corrupt_first_page('test');
@@ -81,7 +84,7 @@ sub relation_filepath
my ($relname) = @_;
my $pgdata = $node->data_dir;
- my $rel = $node->safe_psql('postgres',
+ my $rel = $session->query_oneval(
qq(SELECT pg_relation_filepath('$relname')));
die "path not found for relation $relname" unless defined $rel;
return "$pgdata/$rel";
@@ -92,8 +95,8 @@ sub fresh_test_table
{
my ($relname) = @_;
- return $node->safe_psql(
- 'postgres', qq(
+ return $session->do(
+ qq(
DROP TABLE IF EXISTS $relname CASCADE;
CREATE TABLE $relname (a integer, b text);
ALTER TABLE $relname SET (autovacuum_enabled=false);
@@ -117,8 +120,8 @@ sub fresh_test_sequence
{
my ($seqname) = @_;
- return $node->safe_psql(
- 'postgres', qq(
+ return $session->do(
+ qq(
DROP SEQUENCE IF EXISTS $seqname CASCADE;
CREATE SEQUENCE $seqname
INCREMENT BY 13
@@ -134,8 +137,8 @@ sub advance_test_sequence
{
my ($seqname) = @_;
- return $node->safe_psql(
- 'postgres', qq(
+ return $session->query_oneval(
+ qq(
SELECT nextval('$seqname');
));
}
@@ -145,10 +148,7 @@ sub set_test_sequence
{
my ($seqname) = @_;
- return $node->safe_psql(
- 'postgres', qq(
- SELECT setval('$seqname', 102);
- ));
+ return $session->query_oneval(qq(SELECT setval('$seqname', 102)));
}
# Call SQL functions to reset the sequence
@@ -156,8 +156,8 @@ sub reset_test_sequence
{
my ($seqname) = @_;
- return $node->safe_psql(
- 'postgres', qq(
+ return $session->do(
+ qq(
ALTER SEQUENCE $seqname RESTART WITH 51
));
}
@@ -169,6 +169,7 @@ sub corrupt_first_page
my ($relname) = @_;
my $relpath = relation_filepath($relname);
+ $session->close;
$node->stop;
my $fh;
@@ -191,6 +192,7 @@ sub corrupt_first_page
or BAIL_OUT("close failed: $!");
$node->start;
+ $session->reconnect;
}
sub detects_heap_corruption
@@ -216,7 +218,7 @@ sub detects_corruption
my ($function, $testname, @re) = @_;
- my $result = $node->safe_psql('postgres', qq(SELECT * FROM $function));
+ my $result = $session->query_tuples(qq(SELECT * FROM $function));
like($result, $_, $testname) for (@re);
}
@@ -226,7 +228,7 @@ sub detects_no_corruption
my ($function, $testname) = @_;
- my $result = $node->safe_psql('postgres', qq(SELECT * FROM $function));
+ my $result = $session->query_tuples(qq(SELECT * FROM $function));
is($result, '', $testname);
}
diff --git a/contrib/amcheck/t/002_cic.pl b/contrib/amcheck/t/002_cic.pl
index 629d00c1d0..f2c7bc8653 100644
--- a/contrib/amcheck/t/002_cic.pl
+++ b/contrib/amcheck/t/002_cic.pl
@@ -6,6 +6,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -72,8 +73,8 @@
q(INSERT INTO quebec SELECT i FROM generate_series(1, 2) s(i);));
# start background transaction
-my $in_progress_h = $node->background_psql('postgres');
-$in_progress_h->query_safe(q(BEGIN; SELECT pg_current_xact_id();));
+my $in_progress_h = PostgreSQL::Test::Session->new(node => $node);
+$in_progress_h->do(q(BEGIN; SELECT pg_current_xact_id();));
# delete one row from table, while background transaction is in progress
$node->safe_psql('postgres', q(DELETE FROM quebec WHERE i = 1;));
@@ -86,7 +87,7 @@
q(SELECT bt_index_parent_check('oscar', heapallindexed => true)));
is($result, '0', 'bt_index_parent_check for CIC after removed row');
-$in_progress_h->quit;
+$in_progress_h->close;
$node->stop;
done_testing();
diff --git a/contrib/amcheck/t/003_cic_2pc.pl b/contrib/amcheck/t/003_cic_2pc.pl
index f28eeac17e..d3a1643bf3 100644
--- a/contrib/amcheck/t/003_cic_2pc.pl
+++ b/contrib/amcheck/t/003_cic_2pc.pl
@@ -7,6 +7,7 @@
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
@@ -36,29 +37,42 @@
# statements.
#
-my $main_h = $node->background_psql('postgres');
+my $main_h = PostgreSQL::Test::Session->new(node=>$node);
-$main_h->query_safe(
+$main_h->do_async(
q(
BEGIN;
INSERT INTO tbl VALUES(0, '[[14,2,3]]');
));
-my $cic_h = $node->background_psql('postgres');
+my $cic_h = PostgreSQL::Test::Session->new(node=>$node);
-$cic_h->query_until(
- qr/start/, q(
-\echo start
-CREATE INDEX CONCURRENTLY idx ON tbl(i);
-CREATE INDEX CONCURRENTLY ginidx ON tbl USING gin(j);
+$cic_h->setnonblocking(1);
+
+$cic_h->enterPipelineMode();
+
+$cic_h->do_pipeline(
+ q(
+CREATE INDEX CONCURRENTLY idx ON tbl(i)
+));
+
+$cic_h->pipelineSync();
+
+$cic_h->do_pipeline(
+ q(
+CREATE INDEX CONCURRENTLY ginidx ON tbl USING gin(j)
));
-$main_h->query_safe(
+$cic_h->pipelineSync();
+
+$main_h->wait_for_completion;
+$main_h->do_async(
q(
PREPARE TRANSACTION 'a';
));
-$main_h->query_safe(
+$main_h->wait_for_completion;
+$main_h->do_async(
q(
BEGIN;
INSERT INTO tbl VALUES(0, '[[14,2,3]]');
@@ -66,7 +80,8 @@
$node->safe_psql('postgres', q(COMMIT PREPARED 'a';));
-$main_h->query_safe(
+$main_h->wait_for_completion;
+$main_h->do_async(
q(
PREPARE TRANSACTION 'b';
BEGIN;
@@ -75,14 +90,17 @@
$node->safe_psql('postgres', q(COMMIT PREPARED 'b';));
-$main_h->query_safe(
- q(
-PREPARE TRANSACTION 'c';
-COMMIT PREPARED 'c';
-));
+$main_h->wait_for_completion;
+$main_h->do(
+ q(PREPARE TRANSACTION 'c';),
+ q(COMMIT PREPARED 'c';));
+
+$main_h->close;
-$main_h->quit;
-$cic_h->quit;
+# called twice out of an abundance of caution about pipeline mode
+$cic_h->wait_for_completion;
+$cic_h->wait_for_completion;
+$cic_h->close;
$result = $node->psql('postgres', q(SELECT bt_index_check('idx',true)));
is($result, '0', 'bt_index_check after overlapping 2PC');
@@ -106,10 +124,9 @@
));
$node->restart;
-my $reindex_h = $node->background_psql('postgres');
-$reindex_h->query_until(
- qr/start/, q(
-\echo start
+my $reindex_h = PostgreSQL::Test::Session->new(node => $node);
+$reindex_h->do_async(
+ q(
DROP INDEX CONCURRENTLY idx;
CREATE INDEX CONCURRENTLY idx ON tbl(i);
DROP INDEX CONCURRENTLY ginidx;
@@ -117,7 +134,8 @@
));
$node->safe_psql('postgres', "COMMIT PREPARED 'spans_restart'");
-$reindex_h->quit;
+$reindex_h->wait_for_completion;
+$reindex_h->close;
$result = $node->psql('postgres', q(SELECT bt_index_check('idx',true)));
is($result, '0', 'bt_index_check after 2PC and restart');
$result = $node->psql('postgres', q(SELECT gin_index_check('ginidx')));
diff --git a/contrib/bloom/t/001_wal.pl b/contrib/bloom/t/001_wal.pl
index 683b187605..f86c49d635 100644
--- a/contrib/bloom/t/001_wal.pl
+++ b/contrib/bloom/t/001_wal.pl
@@ -5,11 +5,14 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
my $node_primary;
my $node_standby;
+my $session_primary;
+my $session_standby;
# Run few queries on both primary and standby and check their results match.
sub test_index_replay
@@ -21,20 +24,18 @@ sub test_index_replay
# Wait for standby to catch up
$node_primary->wait_for_catchup($node_standby);
- my $queries = qq(SET enable_seqscan=off;
-SET enable_bitmapscan=on;
-SET enable_indexscan=on;
-SELECT * FROM tst WHERE i = 0;
-SELECT * FROM tst WHERE i = 3;
-SELECT * FROM tst WHERE t = 'b';
-SELECT * FROM tst WHERE t = 'f';
-SELECT * FROM tst WHERE i = 3 AND t = 'c';
-SELECT * FROM tst WHERE i = 7 AND t = 'e';
-);
+ my @queries = (
+ "SELECT * FROM tst WHERE i = 0",
+ "SELECT * FROM tst WHERE i = 3",
+ "SELECT * FROM tst WHERE t = 'b'",
+ "SELECT * FROM tst WHERE t = 'f'",
+ "SELECT * FROM tst WHERE i = 3 AND t = 'c'",
+ "SELECT * FROM tst WHERE i = 7 AND t = 'e'",
+ );
# Run test queries and compare their result
- my $primary_result = $node_primary->safe_psql("postgres", $queries);
- my $standby_result = $node_standby->safe_psql("postgres", $queries);
+ my $primary_result = $session_primary->query_tuples(@queries);
+ my $standby_result = $session_standby->query_tuples(@queries);
is($primary_result, $standby_result, "$test_name: query result matches");
return;
@@ -55,13 +56,24 @@ sub test_index_replay
has_streaming => 1);
$node_standby->start;
+# Create and initialize the sessions
+$session_primary = PostgreSQL::Test::Session->new(node => $node_primary);
+$session_standby = PostgreSQL::Test::Session->new(node => $node_standby);
+my $initset = q[
+ SET enable_seqscan=off;
+ SET enable_bitmapscan=on;
+ SET enable_indexscan=on;
+];
+$session_primary->do($initset);
+$session_standby->do($initset);
+
# Create some bloom index on primary
-$node_primary->safe_psql("postgres", "CREATE EXTENSION bloom;");
-$node_primary->safe_psql("postgres", "CREATE TABLE tst (i int4, t text);");
-$node_primary->safe_psql("postgres",
+$session_primary->do("CREATE EXTENSION bloom;");
+$session_primary->do("CREATE TABLE tst (i int4, t text);");
+$session_primary->do(
"INSERT INTO tst SELECT i%10, substr(encode(sha256(i::text::bytea), 'hex'), 1, 1) FROM generate_series(1,10000) i;"
);
-$node_primary->safe_psql("postgres",
+$session_primary->do(
"CREATE INDEX bloomidx ON tst USING bloom (i, t) WITH (col1 = 3);");
# Test that queries give same result
diff --git a/contrib/pg_visibility/t/001_concurrent_transaction.pl b/contrib/pg_visibility/t/001_concurrent_transaction.pl
index 3aa556892a..cf6e3b4518 100644
--- a/contrib/pg_visibility/t/001_concurrent_transaction.pl
+++ b/contrib/pg_visibility/t/001_concurrent_transaction.pl
@@ -6,6 +6,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -24,10 +25,10 @@
# Setup another database
$node->safe_psql("postgres", "CREATE DATABASE other_database;\n");
-my $bsession = $node->background_psql('other_database');
+my $bsession = PostgreSQL::Test::Session->new(node => $node, dbname => 'other_database');
# Run a concurrent transaction
-$bsession->query_safe(
+$bsession->do(
qq[
BEGIN;
SELECT txid_current();
@@ -55,8 +56,8 @@
ok($result eq "", "pg_check_visible() detects no errors");
# Shutdown
-$bsession->query_safe("COMMIT;");
-$bsession->quit;
+$bsession->do("COMMIT;");
+$bsession->close;
$node->stop;
$standby->stop;
diff --git a/contrib/test_decoding/t/001_repl_stats.pl b/contrib/test_decoding/t/001_repl_stats.pl
index 6814c792e2..12f6c126f7 100644
--- a/contrib/test_decoding/t/001_repl_stats.pl
+++ b/contrib/test_decoding/t/001_repl_stats.pl
@@ -7,6 +7,7 @@
use warnings FATAL => 'all';
use File::Path qw(rmtree);
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -129,11 +130,11 @@ sub test_slot_stats
);
# Look at slot data, with a persistent connection.
-my $bpgsql = $node->background_psql('postgres', on_error_stop => 1);
+my $bgsession = PostgreSQL::Test::Session->new(node=>$node);
# Launch query and look at slot data, incrementing the refcount of the
# stats entry.
-$bpgsql->query_safe(
+$bgsession->query_safe(
"SELECT pg_logical_slot_peek_binary_changes('$slot_name_restart', NULL, NULL)"
);
@@ -150,7 +151,7 @@ sub test_slot_stats
# Look again at the slot data. The local stats reference should be refreshed
# to the reinitialized entry.
-$bpgsql->query_safe(
+$bgsession->query_safe(
"SELECT pg_logical_slot_peek_binary_changes('$slot_name_restart', NULL, NULL)"
);
# Drop again the slot, the entry is not dropped yet as the previous session
@@ -176,6 +177,6 @@ sub test_slot_stats
my $stats_file = "$datadir/pg_stat/pgstat.stat";
ok(-f "$stats_file", "stats file must exist after shutdown");
-$bpgsql->quit;
+$bgsession->close;
done_testing();
diff --git a/doc/src/sgml/installation.sgml b/doc/src/sgml/installation.sgml
index b345a10567..8120b75264 100644
--- a/doc/src/sgml/installation.sgml
+++ b/doc/src/sgml/installation.sgml
@@ -1599,7 +1599,8 @@ build-postgresql:
Enable tests using the Perl TAP tools. This requires a Perl
- installation and the Perl module IPC::Run.
+ installation and the Perl modules IPC::Run
+ and FFI::Platypus.
See for more information.
@@ -3169,7 +3170,8 @@ ninja install
Enable tests using the Perl TAP tools. Defaults to auto and requires
- a Perl installation and the Perl module IPC::Run.
+ a Perl installation and the Perl modules IPC::Run
+ and FFI::Platypus.
See for more information.
diff --git a/doc/src/sgml/regress.sgml b/doc/src/sgml/regress.sgml
index c74941bfbf..63e7104de5 100644
--- a/doc/src/sgml/regress.sgml
+++ b/doc/src/sgml/regress.sgml
@@ -954,9 +954,10 @@ make check PROVE_TESTS='t/001_test1.pl t/003_test3.pl'
- The TAP tests require the Perl module IPC::Run.
- This module is available from
- CPAN
+ The TAP tests require the Perl modules
+ IPC::Run and
+ FFI::Platypus.
+ These modules are available from CPAN
or an operating system package.
They also require PostgreSQL to be
configured with the option .
diff --git a/src/bin/pg_amcheck/t/004_verify_heapam.pl b/src/bin/pg_amcheck/t/004_verify_heapam.pl
index 95f1f34c90..9afacbcaae 100644
--- a/src/bin/pg_amcheck/t/004_verify_heapam.pl
+++ b/src/bin/pg_amcheck/t/004_verify_heapam.pl
@@ -5,6 +5,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -190,16 +191,17 @@ sub write_tuple
$node->start;
my $port = $node->port;
my $pgdata = $node->data_dir;
-$node->safe_psql('postgres', "CREATE EXTENSION amcheck");
-$node->safe_psql('postgres', "CREATE EXTENSION pageinspect");
+my $session = PostgreSQL::Test::Session->new(node => $node);
+$session->do("CREATE EXTENSION amcheck");
+$session->do("CREATE EXTENSION pageinspect");
# Get a non-zero datfrozenxid
-$node->safe_psql('postgres', qq(VACUUM FREEZE));
+$session->do(qq(VACUUM FREEZE));
# Create the test table with precisely the schema that our corruption function
# expects.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
CREATE TABLE public.test (a BIGINT, b TEXT, c TEXT);
ALTER TABLE public.test SET (autovacuum_enabled=false);
ALTER TABLE public.test ALTER COLUMN c SET STORAGE EXTERNAL;
@@ -209,14 +211,15 @@ sub write_tuple
# We want (0 < datfrozenxid < test.relfrozenxid). To achieve this, we freeze
# an otherwise unused table, public.junk, prior to inserting data and freezing
# public.test
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
CREATE TABLE public.junk AS SELECT 'junk'::TEXT AS junk_column;
ALTER TABLE public.junk SET (autovacuum_enabled=false);
- VACUUM FREEZE public.junk
- ));
+ ),
+ 'VACUUM FREEZE public.junk'
+);
-my $rel = $node->safe_psql('postgres',
+my $rel = $session->query_oneval(
qq(SELECT pg_relation_filepath('public.test')));
my $relpath = "$pgdata/$rel";
@@ -229,23 +232,24 @@ sub write_tuple
# First insert data needed for tests unrelated to update chain validation.
# Then freeze the page. These tuples are at offset numbers 1 to 16.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
SELECT
x'DEADF9F9DEADF9F9'::bigint,
'abcdefg',
repeat('w', 10000)
FROM generate_series(1, $ROWCOUNT_BASIC);
- VACUUM FREEZE public.test;)
+ ),
+ 'VACUUM FREEZE public.test'
);
# Create some simple HOT update chains for line pointer validation. After
# the page is HOT pruned, we'll have two redirects line pointers each pointing
# to a tuple. We'll then change the second redirect to point to the same
# tuple as the first one and verify that we can detect corruption.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(1,2)); -- offset numbers 17 and 18
@@ -254,8 +258,8 @@ sub write_tuple
));
# Create some more HOT update chains.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(3,6)); -- offset numbers 21 through 24
@@ -264,25 +268,30 @@ sub write_tuple
));
# Negative test case of HOT-pruning with aborted tuple.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '5'; -- offset number 27
ABORT;
- VACUUM FREEZE public.test;
- ));
+ ),
+ 'VACUUM FREEZE public.test;',
+ );
# Next update on any tuple will be stored at the same place of tuple inserted
# by aborted transaction. This should not cause the table to appear corrupt.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
+ BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '6'; -- offset number 27 again
- VACUUM FREEZE public.test;
- ));
+ COMMIT;
+ ),
+ 'VACUUM FREEZE public.test;',
+ );
# Data for HOT chain validation, so not calling VACUUM FREEZE.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
+ BEGIN;
INSERT INTO public.test (a, b, c)
VALUES ( x'DEADF9F9DEADF9F9'::bigint, 'abcdefg',
generate_series(7,15)); -- offset numbers 28 to 36
@@ -293,11 +302,12 @@ sub write_tuple
UPDATE public.test SET c = 'a' WHERE c = '13'; -- offset number 41
UPDATE public.test SET c = 'a' WHERE c = '14'; -- offset number 42
UPDATE public.test SET c = 'a' WHERE c = '15'; -- offset number 43
+ COMMIT;
));
# Need one aborted transaction to test corruption in HOT chains.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
UPDATE public.test SET c = 'a' WHERE c = '9'; -- offset number 44
ABORT;
@@ -306,19 +316,19 @@ sub write_tuple
# Need one in-progress transaction to test few corruption in HOT chains.
# We are creating PREPARE TRANSACTION here as these will not be aborted
# even if we stop the node.
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
BEGIN;
PREPARE TRANSACTION 'in_progress_tx';
));
-my $in_progress_xid = $node->safe_psql(
- 'postgres', qq(
+my $in_progress_xid = $session->query_oneval(
+ qq(
SELECT transaction FROM pg_prepared_xacts;
));
-my $relfrozenxid = $node->safe_psql('postgres',
+my $relfrozenxid = $session->query_oneval(
q(select relfrozenxid from pg_class where relname = 'test'));
-my $datfrozenxid = $node->safe_psql('postgres',
+my $datfrozenxid = $session->query_oneval(
q(select datfrozenxid from pg_database where datname = 'postgres'));
# Sanity check that our 'test' table has a relfrozenxid newer than the
@@ -326,6 +336,7 @@ sub write_tuple
# first normal xid. We rely on these invariants in some of our tests.
if ($datfrozenxid <= 3 || $datfrozenxid >= $relfrozenxid)
{
+ $session->close;
$node->clean_node;
plan skip_all =>
"Xid thresholds not as expected: got datfrozenxid = $datfrozenxid, relfrozenxid = $relfrozenxid";
@@ -334,17 +345,21 @@ sub write_tuple
# Find where each of the tuples is located on the page. If a particular
# line pointer is a redirect rather than a tuple, we record the offset as -1.
-my @lp_off = split '\n', $node->safe_psql(
- 'postgres', qq(
+my $lp_off_res = $session->query(
+ qq(
SELECT CASE WHEN lp_flags = 2 THEN -1 ELSE lp_off END
FROM heap_page_items(get_raw_page('test', 'main', 0))
)
-);
+ );
+my @lp_off;
+push(@lp_off, $_->[0]) foreach @{$lp_off_res->{rows}};
+
scalar @lp_off == $ROWCOUNT or BAIL_OUT("row offset counts mismatch");
# Sanity check that our 'test' table on disk layout matches expectations. If
# this is not so, we will have to skip the test until somebody updates the test
# to work on this platform.
+$session->close;
$node->stop;
my $file;
open($file, '+<', $relpath)
@@ -751,17 +766,19 @@ sub header
close($file)
or BAIL_OUT("close failed: $!");
$node->start;
+$session->reconnect;
# Run pg_amcheck against the corrupt table with epoch=0, comparing actual
# corruption messages against the expected messages
$node->command_checks_all(
[ 'pg_amcheck', '--no-dependent-indexes', '--port' => $port, 'postgres' ],
2, [@expected], [], 'Expected corruption message output');
-$node->safe_psql(
- 'postgres', qq(
+$session->do(
+ qq(
COMMIT PREPARED 'in_progress_tx';
));
+$session->close;
$node->teardown_node;
$node->clean_node;
diff --git a/src/bin/pg_upgrade/t/007_multixact_conversion.pl b/src/bin/pg_upgrade/t/007_multixact_conversion.pl
index 867a062315..9a4c8ed983 100644
--- a/src/bin/pg_upgrade/t/007_multixact_conversion.pl
+++ b/src/bin/pg_upgrade/t/007_multixact_conversion.pl
@@ -15,6 +15,7 @@
use Math::BigInt;
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -38,10 +39,8 @@
# versions.
#
# The first argument is the cluster to connect to, the second argument
-# is a cluster using the new version. We need the 'psql' binary from
-# the new version, the new cluster is otherwise unused. (We need to
-# use the new 'psql' because some of the more advanced background psql
-# perl module features depend on a fairly recent psql version.)
+# is a cluster using the new version. We need the libpq library from
+# the new version (for Session), the new cluster is otherwise unused.
sub mxact_workload
{
my $node = shift; # Cluster to connect to
@@ -79,18 +78,20 @@ sub mxact_workload
# in each connection.
for (0 .. $nclients)
{
- # Use the psql binary from the new installation. The
- # BackgroundPsql functionality doesn't work with older psql
- # versions.
- my $conn = $binnode->background_psql(
- '',
- connstr => $node->connstr('postgres'),
- timeout => $connection_timeout_secs);
-
- $conn->query_safe("SET log_statement=none", verbose => $verbose)
+ # Connect to the (old) cluster, but load libpq from the new
+ # installation: the Session FFI wrapper binds libpq functions that
+ # may not be present in the old installation's libpq. Passing the
+ # node (rather than an explicit libdir) lets Session locate the
+ # library correctly on all platforms, including Windows where it
+ # lives in bindir.
+ my $conn = PostgreSQL::Test::Session->new(
+ node => $binnode,
+ connstr => $node->connstr('postgres'));
+
+ $conn->do("SET log_statement=none")
unless $verbose;
- $conn->query_safe("SET enable_seqscan=off", verbose => $verbose);
- $conn->query_safe("BEGIN", verbose => $verbose);
+ $conn->do("SET enable_seqscan=off");
+ $conn->do("BEGIN");
push(@connections, $conn);
}
@@ -108,9 +109,9 @@ sub mxact_workload
my $conn = $connections[ $i % $nclients ];
my $sql = ($i % $abort_every == 0) ? "ABORT" : "COMMIT";
- $conn->query_safe($sql, verbose => $verbose);
+ $conn->do($sql);
- $conn->query_safe("BEGIN", verbose => $verbose);
+ $conn->do("BEGIN");
if ($i % $update_every == 0)
{
$sql = qq[
@@ -126,12 +127,12 @@ sub mxact_workload
) as x
];
}
- $conn->query_safe($sql, verbose => $verbose);
+ $conn->do($sql);
}
for my $conn (@connections)
{
- $conn->quit();
+ $conn->close;
}
$node->stop;
diff --git a/src/test/authentication/t/001_password.pl b/src/test/authentication/t/001_password.pl
index 69ed4919b1..ac2aa3ce23 100644
--- a/src/test/authentication/t/001_password.pl
+++ b/src/test/authentication/t/001_password.pl
@@ -13,6 +13,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
if (!$use_unix_sockets)
@@ -185,36 +186,18 @@ sub test_conn
WHERE rolname = 'scram_role_iter'");
is($res, 'SCRAM-SHA-256$1024:', 'scram_iterations in server side ROLE');
-# If we don't have IO::Pty, forget it, because IPC::Run depends on that
-# to support pty connections. Also skip if IPC::Run isn't at least 0.98
-# as earlier version cause the session to time out.
-SKIP:
-{
- skip "IO::Pty and IPC::Run >= 0.98 required", 1
- unless eval { require IO::Pty; IPC::Run->VERSION('0.98'); };
-
- # Alter the password on the created role using \password in psql to ensure
- # that clientside password changes use the scram_iterations value when
- # calculating SCRAM secrets.
- my $session = $node->interactive_psql('postgres');
-
- $session->set_query_timer_restart();
- $session->query("SET password_encryption='scram-sha-256';");
- $session->query("SET scram_iterations=42;");
- $session->query_until(qr/Enter new password/,
- "\\password scram_role_iter\n");
- $session->query_until(qr/Enter it again/, "pass\n");
- $session->query_until(qr/postgres=# /, "pass\n");
- $session->quit;
-
- $res = $node->safe_psql(
- 'postgres',
+# set password using PQchangePassword
+my $session = PostgreSQL::Test::Session->new (node => $node);
+
+$session->do("SET password_encryption='scram-sha-256';",
+ "SET scram_iterations=42;");
+$res = $session->set_password("scram_role_iter","pass");
+is($res->{status}, 1, "set password ok");
+$res = $session->query_oneval(
"SELECT substr(rolpassword,1,17)
FROM pg_authid
WHERE rolname = 'scram_role_iter'");
- is($res, 'SCRAM-SHA-256$42:',
- 'scram_iterations in psql \password command');
-}
+is($res, 'SCRAM-SHA-256$42:', 'scram_iterations correct');
# Create a database to test regular expression.
$node->safe_psql('postgres', "CREATE database regex_testdb;");
diff --git a/src/test/authentication/t/007_pre_auth.pl b/src/test/authentication/t/007_pre_auth.pl
index 04063f4721..17de92bc41 100644
--- a/src/test/authentication/t/007_pre_auth.pl
+++ b/src/test/authentication/t/007_pre_auth.pl
@@ -7,6 +7,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Time::HiRes qw(usleep);
use Test::More;
@@ -36,24 +37,27 @@
$node->safe_psql('postgres', 'CREATE EXTENSION injection_points');
# Connect to the server and inject a waitpoint.
-my $psql = $node->background_psql('postgres');
-$psql->query_safe("SELECT injection_points_attach('init-pre-auth', 'wait')");
+my $session = PostgreSQL::Test::Session->new(node => $node);
+$session->do("SELECT injection_points_attach('init-pre-auth', 'wait')");
# From this point on, all new connections will hang during startup, just before
-# authentication. Use the $psql connection handle for server interaction.
-my $conn = $node->background_psql('postgres', wait => 0);
+# authentication. Use the $session connection handle for server interaction.
+my $conn = PostgreSQL::Test::Session->new(node => $node, wait => 0);
# Wait for the connection to show up in pg_stat_activity, with the wait_event
-# of the injection point.
+# of the injection point. We need to poll the async connection to drive it forward.
my $pid;
while (1)
{
- $pid = $psql->query(
+ # Drive the async connection forward - it won't progress without polling
+ $conn->poll_connect();
+
+ $pid = $session->query_oneval(
qq{SELECT pid FROM pg_stat_activity
WHERE backend_type = 'client backend'
AND state = 'starting'
- AND wait_event = 'init-pre-auth';});
- last if $pid ne "";
+ AND wait_event = 'init-pre-auth';}, 1);
+ last if defined $pid && $pid ne "";
usleep(100_000);
}
@@ -62,24 +66,24 @@
ok(1, 'authenticating connections are recorded in pg_stat_activity');
# Detach the waitpoint and wait for the connection to complete.
-$psql->query_safe("SELECT injection_points_wakeup('init-pre-auth');");
+$session->do("SELECT injection_points_wakeup('init-pre-auth')");
$conn->wait_connect();
# Make sure the pgstat entry is updated eventually.
while (1)
{
my $state =
- $psql->query("SELECT state FROM pg_stat_activity WHERE pid = $pid;");
- last if $state eq "idle";
+ $session->query_oneval("SELECT state FROM pg_stat_activity WHERE pid = $pid");
+ last if defined $state && $state eq "idle";
- note "state for backend $pid is '$state'; waiting for 'idle'...";
+ note "state for backend $pid is '" . ($state // 'undef') . "'; waiting for 'idle'...";
usleep(100_000);
}
ok(1, 'authenticated connections reach idle state in pg_stat_activity');
-$psql->query_safe("SELECT injection_points_detach('init-pre-auth');");
-$psql->quit();
-$conn->quit();
+$session->do("SELECT injection_points_detach('init-pre-auth')");
+$session->close();
+$conn->close();
done_testing();
diff --git a/src/test/modules/oauth_validator/t/001_server.pl b/src/test/modules/oauth_validator/t/001_server.pl
index 1619fbffd4..3d4eb1bfe3 100644
--- a/src/test/modules/oauth_validator/t/001_server.pl
+++ b/src/test/modules/oauth_validator/t/001_server.pl
@@ -12,6 +12,7 @@
use JSON::PP qw(encode_json);
use MIME::Base64 qw(encode_base64);
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -57,7 +58,7 @@
$node->safe_psql('postgres', 'CREATE USER testparam;');
# Save a background connection for later configuration changes.
-my $bgconn = $node->background_psql('postgres');
+my $bgconn = PostgreSQL::Test::Session->new(node => $node);
my $webserver = OAuth::Server->new();
$webserver->run();
@@ -124,11 +125,11 @@ END
$node->wait_for_log(qr/reloading configuration files/, $log_start);
# Check pg_hba_file_rules() support.
-my $contents = $bgconn->query_safe(
+my $contents = $bgconn->query(
qq(SELECT rule_number, auth_method, options
FROM pg_hba_file_rules
ORDER BY rule_number;));
-is( $contents,
+is( $contents->{psqlout},
qq{1|oauth|\{issuer=$issuer,"scope=openid postgres",validator=validator\}
2|oauth|\{issuer=$issuer/.well-known/oauth-authorization-server/alternate,"scope=openid postgres alt",validator=validator\}
3|oauth|\{issuer=$issuer/param,"scope=openid postgres",validator=validator\}},
@@ -551,7 +552,7 @@ sub connstr
"dbname=postgres oauth_issuer=$issuer/.well-known/openid-configuration oauth_scope='' oauth_client_id=f02c6361-0635";
# Misbehaving validators must fail shut.
-$bgconn->query_safe("ALTER SYSTEM SET oauth_validator.authn_id TO ''");
+$bgconn->do("ALTER SYSTEM SET oauth_validator.authn_id TO ''");
$node->reload;
$log_start =
$node->wait_for_log(qr/reloading configuration files/, $log_start);
@@ -562,15 +563,15 @@ sub connstr
expected_stderr => qr/OAuth bearer authentication failed/,
log_like => [
qr/connection authenticated: identity=""/,
- qr/FATAL:\s+OAuth bearer authentication failed/,
+ qr/FATAL: ( [A-Z0-9]+:)? OAuth bearer authentication failed/,
qr/DETAIL:\s+Validator provided no identity/,
]);
# Even if a validator authenticates the user, if the token isn't considered
# valid, the connection fails.
-$bgconn->query_safe(
+$bgconn->do(
"ALTER SYSTEM SET oauth_validator.authn_id TO 'test\@example.org'");
-$bgconn->query_safe(
+$bgconn->do(
"ALTER SYSTEM SET oauth_validator.authorize_tokens TO false");
$node->reload;
$log_start =
@@ -582,7 +583,7 @@ sub connstr
expected_stderr => qr/OAuth bearer authentication failed/,
log_like => [
qr/connection authenticated: identity="test\@example\.org"/,
- qr/FATAL:\s+OAuth bearer authentication failed/,
+ qr/FATAL: ( [A-Z0-9]+:)? OAuth bearer authentication failed/,
qr/DETAIL:\s+Validator failed to authorize the provided token/,
]);
@@ -664,8 +665,8 @@ sub connstr
});
# To start, have the validator use the role names as authn IDs.
-$bgconn->query_safe("ALTER SYSTEM RESET oauth_validator.authn_id");
-$bgconn->query_safe("ALTER SYSTEM RESET oauth_validator.authorize_tokens");
+$bgconn->do("ALTER SYSTEM RESET oauth_validator.authn_id");
+$bgconn->do("ALTER SYSTEM RESET oauth_validator.authorize_tokens");
$node->reload;
$log_start =
@@ -682,7 +683,7 @@ sub connstr
expected_stderr => qr/OAuth bearer authentication failed/);
# Have the validator identify the end user as user@example.com.
-$bgconn->query_safe(
+$bgconn->do(
"ALTER SYSTEM SET oauth_validator.authn_id TO 'user\@example.com'");
$node->reload;
$log_start =
@@ -706,7 +707,7 @@ sub connstr
expected_stderr =>
qr@Visit https://example\.com/ and enter the code: postgresuser@);
-$bgconn->query_safe("ALTER SYSTEM RESET oauth_validator.authn_id");
+$bgconn->do("ALTER SYSTEM RESET oauth_validator.authn_id");
$node->reload;
$log_start =
$node->wait_for_log(qr/reloading configuration files/, $log_start);
@@ -829,7 +830,7 @@ sub connstr
$node->connect_fails(
"user=$user dbname=postgres oauth_issuer=$issuer/.well-known/oauth-authorization-server/alternate oauth_client_id=f02c6361-0636",
"fail_validator is used for $user",
- expected_stderr => qr/FATAL:\s+fail_validator: sentinel error/);
+ expected_stderr => qr/FATAL: ( [A-Z0-9]+:)? fail_validator: sentinel error/);
#
# Test ABI compatibility magic marker
@@ -849,7 +850,7 @@ sub connstr
"user=test dbname=postgres oauth_issuer=$issuer/.well-known/oauth-authorization-server/alternate oauth_client_id=f02c6361-0636",
"magic_validator is used for $user",
expected_stderr =>
- qr/FATAL:\s+OAuth validator module "magic_validator": magic number mismatch/
+ qr/FATAL: ( [A-Z0-9]+:)? OAuth validator module "magic_validator": magic number mismatch/
);
$node->stop;
diff --git a/src/test/modules/test_aio/t/001_aio.pl b/src/test/modules/test_aio/t/001_aio.pl
index 63cadd64c1..bf94680160 100644
--- a/src/test/modules/test_aio/t/001_aio.pl
+++ b/src/test/modules/test_aio/t/001_aio.pl
@@ -4,6 +4,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -62,19 +63,19 @@ sub psql_like
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $io_method = shift;
- my $psql = shift;
+ my $session = shift;
my $name = shift;
my $sql = shift;
my $expected_stdout = shift;
my $expected_stderr = shift;
- my ($cmdret, $output);
- ($output, $cmdret) = $psql->query($sql);
+ my $res = $session->query($sql);
+ my $output = $res->{psqlout};
like($output, $expected_stdout, "$io_method: $name: expected stdout");
- like($psql->{stderr}, $expected_stderr,
+ like($session->get_stderr(), $expected_stderr,
"$io_method: $name: expected stderr");
- $psql->{stderr} = '';
+ $session->clear_stderr();
return $output;
}
@@ -87,17 +88,15 @@ sub query_wait_block
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $io_method = shift;
my $node = shift;
- my $psql = shift;
+ my $session = shift;
my $name = shift;
my $sql = shift;
my $waitfor = shift;
my $wait_current_session = shift;
- my $pid = $psql->query_safe('SELECT pg_backend_pid()');
+ my $pid = $session->backend_pid();
- $psql->{stdin} .= qq($sql;\n);
- $psql->{run}->pump_nb();
- note "issued sql: $sql;\n";
+ $session->do_async($sql);
ok(1, "$io_method: $name: issued sql");
my $waitquery;
@@ -163,7 +162,7 @@ sub test_handle
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# leak warning: implicit xact
psql_like(
@@ -269,7 +268,7 @@ sub test_batchmode
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# In a build with RELCACHE_FORCE_RELEASE and CATCACHE_FORCE_RELEASE, just
# using SELECT batch_start() causes spurious test failures, because the
@@ -329,7 +328,7 @@ sub test_io_error
my $node = shift;
my ($ret, $output);
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
$psql->query_safe(
qq(
@@ -381,8 +380,8 @@ sub test_startwait_io
my $node = shift;
my ($ret, $output);
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
### Verify behavior for normal tables
@@ -441,7 +440,7 @@ sub test_startwait_io
# Because the IO was terminated, but not marked as valid, second session should get the right to start io
- pump_until($psql_b->{run}, $psql_b->{timeout}, \$psql_b->{stdout}, qr/t/);
+ $psql_b->wait_for_async_pattern(qr/t/);
ok(1, "$io_method: blocking start buffer io, can start io");
# terminate the IO again
@@ -479,7 +478,7 @@ sub test_startwait_io
qr/^$/);
# Because the IO was terminated, and marked as valid, second session should complete but not need io
- pump_until($psql_b->{run}, $psql_b->{timeout}, \$psql_b->{stdout}, qr/f/);
+ $psql_b->wait_for_async_pattern(qr/f/);
ok(1, "$io_method: blocking start buffer io, no need to start io");
# buffer is valid now, make it invalid again
@@ -558,8 +557,8 @@ sub test_complete_foreign
my $node = shift;
my ($ret, $output);
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
# Issue IO without waiting for completion, then sleep
$psql_a->query_safe(
@@ -628,7 +627,7 @@ sub test_close_fd
my $node = shift;
my ($ret, $output);
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
psql_like(
$io_method,
@@ -678,7 +677,7 @@ sub test_inject
my $node = shift;
my ($ret, $output);
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# injected what we'd expect
$psql->query_safe(qq(SELECT inj_io_short_read_attach(8192);));
@@ -812,7 +811,7 @@ sub test_inject_worker
my $node = shift;
my ($ret, $output);
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# trigger a failure to reopen, should error out, but should recover
$psql->query_safe(
@@ -849,7 +848,7 @@ sub test_invalidate
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
foreach my $persistency (qw(normal unlogged temporary))
{
@@ -907,8 +906,8 @@ sub test_zero
my $io_method = shift;
my $node = shift;
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
foreach my $persistency (qw(normal temporary))
{
@@ -933,7 +932,7 @@ sub test_zero
qq(
SELECT read_rel_block_ll('tbl_zero', 0, zero_on_error=>false)),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 0 of relation "base\/.*\/.*$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 0 of relation "base\/.*\/.*$/
);
# Check that page validity errors are zeroed
@@ -944,7 +943,7 @@ sub test_zero
qq(
SELECT read_rel_block_ll('tbl_zero', 0, zero_on_error=>true)),
qr/^$/,
- qr/^psql::\d+: WARNING: invalid page in block 0 of relation "base\/.*\/.*"; zeroing out page$/
+ qr/^(?:psql::\d+: )?WARNING: invalid page in block 0 of relation "base\/.*\/.*"; zeroing out page$/
);
# And that once the corruption is fixed, we can read again
@@ -952,7 +951,7 @@ sub test_zero
qq(
SELECT modify_rel_block('tbl_zero', 0, zero=>true);
));
- $psql_a->{stderr} = '';
+ $psql_a->clear_stderr();
psql_like(
$io_method,
@@ -975,7 +974,7 @@ sub test_zero
"$persistency: test zeroing of invalid block 3",
qq(SELECT read_rel_block_ll('tbl_zero', 3, zero_on_error=>true);),
qr/^$/,
- qr/^psql::\d+: WARNING: invalid page in block 3 of relation "base\/.*\/.*"; zeroing out page$/
+ qr/^(?:psql::\d+: )?WARNING: invalid page in block 3 of relation "base\/.*\/.*"; zeroing out page$/
);
@@ -992,7 +991,7 @@ sub test_zero
"$persistency: test reading of invalid block 2,3 in larger read",
qq(SELECT read_rel_block_ll('tbl_zero', 1, nblocks=>4, zero_on_error=>false)),
qr/^$/,
- qr/^psql::\d+: ERROR: 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first invalid page\.\nHINT:[^\n]+$/
+ qr/^(?:psql::\d+: )?ERROR: 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first invalid page\.\nHINT:[^\n]+$/
);
# Then test zeroing via ZERO_ON_ERROR flag
@@ -1002,7 +1001,7 @@ sub test_zero
"$persistency: test zeroing of invalid block 2,3 in larger read, ZERO_ON_ERROR",
qq(SELECT read_rel_block_ll('tbl_zero', 1, nblocks=>4, zero_on_error=>true)),
qr/^$/,
- qr/^psql::\d+: WARNING: zeroing out 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first zeroed page\.\nHINT:[^\n]+$/
+ qr/^(?:psql::\d+: )?WARNING: zeroing out 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first zeroed page\.\nHINT:[^\n]+$/
);
# Then test zeroing via zero_damaged_pages
@@ -1017,7 +1016,7 @@ sub test_zero
COMMIT;
),
qr/^$/,
- qr/^psql::\d+: WARNING: zeroing out 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first zeroed page\.\nHINT:[^\n]+$/
+ qr/^(?:psql::\d+: )?WARNING: zeroing out 2 invalid pages among blocks 1..4 of relation "base\/.*\/.*\nDETAIL: Block 2 held the first zeroed page\.\nHINT:[^\n]+$/
);
$psql_a->query_safe(qq(COMMIT));
@@ -1030,7 +1029,7 @@ sub test_zero
FROM generate_series(0, 15) g(i);
SELECT modify_rel_block('tbl_zero', 3, zero=>true);
));
- $psql_a->{stderr} = '';
+ $psql_a->clear_stderr();
psql_like(
$io_method,
@@ -1039,7 +1038,7 @@ sub test_zero
qq(
SELECT count(*) FROM tbl_zero),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 2 of relation "base\/.*\/.*$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 2 of relation "base\/.*\/.*$/
);
# Verify that bufmgr.c IO zeroes out pages with page validity errors
@@ -1054,7 +1053,7 @@ sub test_zero
COMMIT;
),
qr/^\d+$/,
- qr/^psql::\d+: WARNING: invalid page in block 2 of relation "base\/.*\/.*$/
+ qr/^(?:psql::\d+: )?WARNING: invalid page in block 2 of relation "base\/.*\/.*$/
);
# Check that warnings/errors about page validity in an IO started by
@@ -1093,7 +1092,7 @@ sub test_zero
));
}
- $psql_a->{stderr} = '';
+ $psql_a->clear_stderr();
$psql_a->quit();
$psql_b->quit();
@@ -1105,19 +1104,17 @@ sub test_checksum
my $io_method = shift;
my $node = shift;
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
- $psql_a->query_safe(
- qq(
-CREATE TABLE tbl_normal(id int) WITH (AUTOVACUUM_ENABLED = false);
-INSERT INTO tbl_normal SELECT generate_series(1, 5000);
-SELECT modify_rel_block('tbl_normal', 3, corrupt_checksum=>true);
-
-CREATE TEMPORARY TABLE tbl_temp(id int) WITH (AUTOVACUUM_ENABLED = false);
-INSERT INTO tbl_temp SELECT generate_series(1, 5000);
-SELECT modify_rel_block('tbl_temp', 3, corrupt_checksum=>true);
-SELECT modify_rel_block('tbl_temp', 4, corrupt_checksum=>true);
-));
+ # Split multi-statement query into separate calls to match psql behavior
+ # where errors in one statement don't prevent subsequent statements
+ $psql_a->query_safe(qq(CREATE TABLE tbl_normal(id int) WITH (AUTOVACUUM_ENABLED = false)));
+ $psql_a->query_safe(qq(INSERT INTO tbl_normal SELECT generate_series(1, 5000)));
+ $psql_a->query_safe(qq(SELECT modify_rel_block('tbl_normal', 3, corrupt_checksum=>true)));
+ $psql_a->query_safe(qq(CREATE TEMPORARY TABLE tbl_temp(id int) WITH (AUTOVACUUM_ENABLED = false)));
+ $psql_a->query_safe(qq(INSERT INTO tbl_temp SELECT generate_series(1, 5000)));
+ $psql_a->query_safe(qq(SELECT modify_rel_block('tbl_temp', 3, corrupt_checksum=>true)));
+ $psql_a->query_safe(qq(SELECT modify_rel_block('tbl_temp', 4, corrupt_checksum=>true)));
# To be able to test checksum failures on shared rels we need a shared rel
# with invalid pages - which is a bit scary. pg_shseclabel seems like a
@@ -1140,7 +1137,7 @@ sub test_checksum
qq(
SELECT read_rel_block_ll('tbl_normal', 3, nblocks=>1, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 3 of relation "base\/\d+\/\d+"$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 3 of relation "base\/\d+\/\d+"$/
);
my ($cs_count_after, $cs_ts_after) =
@@ -1162,7 +1159,7 @@ sub test_checksum
qq(
SELECT read_rel_block_ll('tbl_temp', 4, nblocks=>2, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 4 of relation "base\/\d+\/t\d+_\d+"$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 4 of relation "base\/\d+\/t\d+_\d+"$/
);
($cs_count_after, $cs_ts_after) = checksum_failures($psql_a, 'postgres');
@@ -1183,7 +1180,7 @@ sub test_checksum
qq(
SELECT read_rel_block_ll('pg_shseclabel', 2, nblocks=>2, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: ERROR: 2 invalid pages among blocks 2..3 of relation "global\/\d+"\nDETAIL: Block 2 held the first invalid page\.\nHINT:[^\n]+$/
+ qr/^(?:psql::\d+: )?ERROR: 2 invalid pages among blocks 2..3 of relation "global\/\d+"\nDETAIL: Block 2 held the first invalid page\.\nHINT:[^\n]+$/
);
($cs_count_after, $cs_ts_after) = checksum_failures($psql_a);
@@ -1201,7 +1198,7 @@ sub test_checksum
SELECT modify_rel_block('pg_shseclabel', 1, zero=>true);
DROP TABLE tbl_normal;
));
- $psql_a->{stderr} = '';
+ $psql_a->clear_stderr();
$psql_a->quit();
}
@@ -1214,7 +1211,7 @@ sub test_checksum_createdb
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
$node->safe_psql('postgres',
'CREATE DATABASE regression_createdb_source');
@@ -1248,7 +1245,7 @@ sub test_checksum_createdb
"create database w/ wal strategy, invalid source",
$createdb_sql,
qr/^$/,
- qr/psql::\d+: ERROR: invalid page in block 1 of relation "base\/\d+\/\d+"$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 1 of relation "base\/\d+\/\d+"$/
);
my ($cs_count_after, $cs_ts_after) =
checksum_failures($psql, 'regression_createdb_source');
@@ -1277,7 +1274,7 @@ sub test_ignore_checksum
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# Test setup
$psql->query_safe(
@@ -1342,7 +1339,7 @@ sub test_ignore_checksum
qq(
SELECT read_rel_block_ll('tbl_cs_fail', 3, nblocks=>1, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: WARNING: ignoring checksum failure in block 3/
+ qr/^(?:psql::\d+: )?WARNING: ignoring checksum failure in block 3/
);
# Check that the log contains a LOG message about the failure
@@ -1357,7 +1354,7 @@ sub test_ignore_checksum
qq(
SELECT read_rel_block_ll('tbl_cs_fail', 2, nblocks=>3, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 4 of relation "base\/\d+\/\d+"$/
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 4 of relation "base\/\d+\/\d+"$/
);
# Test multi-block read with different problems in different blocks
@@ -1369,7 +1366,7 @@ sub test_ignore_checksum
SELECT modify_rel_block('tbl_cs_fail', 4, corrupt_header=>true);
SELECT modify_rel_block('tbl_cs_fail', 5, corrupt_header=>true);
));
- $psql->{stderr} = '';
+ $psql->clear_stderr();
$log_location = -s $node->logfile;
psql_like(
@@ -1379,7 +1376,7 @@ sub test_ignore_checksum
qq(
SELECT read_rel_block_ll('tbl_cs_fail', 1, nblocks=>5, zero_on_error=>true);),
qr/^$/,
- qr/^psql::\d+: WARNING: zeroing 3 page\(s\) and ignoring 2 checksum failure\(s\) among blocks 1..5 of relation "/
+ qr/^(?:psql::\d+: )?WARNING: zeroing 3 page\(s\) and ignoring 2 checksum failure\(s\) among blocks 1..5 of relation "/
);
@@ -1412,7 +1409,7 @@ sub test_ignore_checksum
qq(
SELECT modify_rel_block('tbl_cs_fail', 3, corrupt_checksum=>true, corrupt_header=>true);
));
- $psql->{stderr} = '';
+ $psql->clear_stderr();
psql_like(
$io_method,
@@ -1421,7 +1418,7 @@ sub test_ignore_checksum
qq(
SELECT read_rel_block_ll('tbl_cs_fail', 3, nblocks=>1, zero_on_error=>false);),
qr/^$/,
- qr/^psql::\d+: ERROR: invalid page in block 3 of relation "/);
+ qr/^(?:psql::\d+: )?ERROR: invalid page in block 3 of relation "/);
psql_like(
$io_method,
@@ -1430,7 +1427,7 @@ sub test_ignore_checksum
qq(
SELECT read_rel_block_ll('tbl_cs_fail', 3, nblocks=>1, zero_on_error=>true);),
qr/^$/,
- qr/^psql::\d+: WARNING: invalid page in block 3 of relation "base\/.*"; zeroing out page/
+ qr/^(?:psql::\d+: )?WARNING: invalid page in block 3 of relation "base\/.*"; zeroing out page/
);
@@ -1446,8 +1443,8 @@ sub test_read_buffers
my ($ret, $output);
my $table;
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
$psql_a->query_safe(
qq(
@@ -1631,7 +1628,7 @@ sub test_read_buffers
$psql_a->query_safe(qq|SELECT evict_rel('$table')|);
my $buf_id =
- $psql_b->query_safe(qq|SELECT buffer_create_toy('$table', 3)|);
+ $psql_b->query_oneval(qq|SELECT buffer_create_toy('$table', 3)|);
$psql_b->query_safe(
qq|SELECT buffer_call_start_io($buf_id, for_input=>true, wait=>true)|
);
@@ -1648,16 +1645,16 @@ sub test_read_buffers
qq|SELECT buffer_call_terminate_io($buf_id, for_input=>true, succeed=>false, io_error=>false, release_aio=>false)|
);
# Because no IO wref was assigned, block 3 should not report foreign IO
- pump_until($psql_a->{run}, $psql_a->{timeout}, \$psql_a->{stdout},
- qr/0\|1\|t\|f\|2\n2\|3\|t\|f\|3/);
- ok(1,
+ like(
+ $psql_a->wait_for_async_pattern(qr/0\|1\|t\|f\|2\n2\|3\|t\|f\|3/),
+ qr/0\|1\|t\|f\|2\n2\|3\|t\|f\|3/,
"$io_method: $persistency: IO was split due to concurrent failed IO"
);
# Same as before, except the concurrent IO succeeds this time
$psql_a->query_safe(qq|SELECT evict_rel('$table')|);
$buf_id =
- $psql_b->query_safe(qq|SELECT buffer_create_toy('$table', 3)|);
+ $psql_b->query_oneval(qq|SELECT buffer_create_toy('$table', 3)|);
$psql_b->query_safe(
qq|SELECT buffer_call_start_io($buf_id, for_input=>true, wait=>true)|
);
@@ -1674,9 +1671,10 @@ sub test_read_buffers
qq|SELECT buffer_call_terminate_io($buf_id, for_input=>true, succeed=>true, io_error=>false, release_aio=>false)|
);
# Because no IO wref was assigned, block 3 should not report foreign IO
- pump_until($psql_a->{run}, $psql_a->{timeout}, \$psql_a->{stdout},
- qr/0\|1\|t\|f\|2\n2\|3\|f\|f\|1\n3\|4\|t\|f\|2/);
- ok(1,
+ like(
+ $psql_a->wait_for_async_pattern(
+ qr/0\|1\|t\|f\|2\n2\|3\|f\|f\|1\n3\|4\|t\|f\|2/),
+ qr/0\|1\|t\|f\|2\n2\|3\|f\|f\|1\n3\|4\|t\|f\|2/,
"$io_method: $persistency: IO was split due to concurrent successful IO"
);
}
@@ -1692,9 +1690,9 @@ sub test_read_buffers_inject
my $io_method = shift;
my $node = shift;
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_c = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_c = PostgreSQL::Test::Session->new(node => $node);
my $expected;
@@ -1763,12 +1761,13 @@ sub test_read_buffers_inject
# return for something with misses in sync mode.
$expected = qr/0\|1\|t\|f\|4/;
}
- pump_until($psql_a->{run}, $psql_a->{timeout}, \$psql_a->{stdout},
- $expected);
- ok(1,
+ like($psql_a->wait_for_async_pattern($expected), $expected,
"$io_method: $persistency: read 1-3, blocked on in-progress 1, see expected result"
);
- $psql_a->{stdout} = '';
+
+ # B's low-level read has completed now that C released it; drain its
+ # result before B is reused below.
+ $psql_b->wait_for_completion;
###
@@ -1829,12 +1828,12 @@ sub test_read_buffers_inject
# return for something with misses in sync mode.
$expected = qr/0\|0\|t\|f\|4/;
}
- pump_until($psql_a->{run}, $psql_a->{timeout}, \$psql_a->{stdout},
- $expected);
- ok(1,
+ like($psql_a->wait_for_async_pattern($expected), $expected,
"$io_method: $persistency: read 0-3, blocked on in-progress 2+3, see expected result"
);
- $psql_a->{stdout} = '';
+
+ # Drain B's now-completed low-level read before closing.
+ $psql_b->wait_for_completion;
$psql_a->quit();
diff --git a/src/test/modules/test_aio/t/004_read_stream.pl b/src/test/modules/test_aio/t/004_read_stream.pl
index 32311c07ac..782b62c452 100644
--- a/src/test/modules/test_aio/t/004_read_stream.pl
+++ b/src/test/modules/test_aio/t/004_read_stream.pl
@@ -5,6 +5,7 @@
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
use FindBin;
@@ -60,7 +61,7 @@ sub test_repeated_blocks
my $io_method = shift;
my $node = shift;
- my $psql = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql = PostgreSQL::Test::Session->new(node => $node);
# Preventing larger reads makes testing easier
$psql->query_safe(qq/SET io_combine_limit = 1/);
@@ -111,7 +112,7 @@ sub test_repeated_blocks
ARRAY[0, 2, 2, 4, 4]);/);
ok(1, "$io_method: temp stream hitting the same block repeatedly");
- $psql->quit();
+ $psql->close();
}
@@ -120,10 +121,10 @@ sub test_inject_foreign
my $io_method = shift;
my $node = shift;
- my $psql_a = $node->background_psql('postgres', on_error_stop => 0);
- my $psql_b = $node->background_psql('postgres', on_error_stop => 0);
+ my $psql_a = PostgreSQL::Test::Session->new(node => $node);
+ my $psql_b = PostgreSQL::Test::Session->new(node => $node);
- my $pid_a = $psql_a->query_safe(qq/SELECT pg_backend_pid();/);
+ my $pid_a = $psql_a->query_oneval(qq/SELECT pg_backend_pid();/);
###
@@ -136,9 +137,8 @@ sub test_inject_foreign
qq/SELECT inj_io_completion_wait(pid=>pg_backend_pid(),
relfilenode=>pg_relation_filenode('largeish'));/);
- $psql_b->{stdin} .= qq/SELECT read_rel_block_ll('largeish',
- blockno=>5, nblocks=>1);\n/;
- $psql_b->{run}->pump_nb();
+ $psql_b->do_async(qq/SELECT read_rel_block_ll('largeish',
+ blockno=>5, nblocks=>1);/);
$node->poll_query_until(
'postgres', qq/SELECT wait_event FROM pg_stat_activity
@@ -147,9 +147,8 @@ sub test_inject_foreign
# Block 5 is undergoing IO in session b, so session a will move on to start
# a new IO for block 7.
- $psql_a->{stdin} .= qq/SELECT array_agg(blocknum) FROM
- read_stream_for_blocks('largeish', ARRAY[0, 2, 5, 7]);\n/;
- $psql_a->{run}->pump_nb();
+ $psql_a->do_async(qq/SELECT array_agg(blocknum) FROM
+ read_stream_for_blocks('largeish', ARRAY[0, 2, 5, 7]);/);
$node->poll_query_until('postgres',
qq(SELECT wait_event FROM pg_stat_activity WHERE pid = $pid_a),
@@ -157,10 +156,10 @@ sub test_inject_foreign
$node->safe_psql('postgres', qq/SELECT inj_io_completion_continue()/);
- pump_until(
- $psql_a->{run}, $psql_a->{timeout},
- \$psql_a->{stdout}, qr/\{0,2,5,7\}/);
- $psql_a->{stdout} = '';
+ $psql_a->wait_for_async_pattern(qr/\{0,2,5,7\}/);
+
+ # Drain session b's now-completed low-level read before reusing it.
+ $psql_b->wait_for_completion;
ok(1,
qq/$io_method: read stream encounters succeeding IO by another backend/
@@ -181,9 +180,8 @@ sub test_inject_foreign
pid=>pg_backend_pid(),
relfilenode=>pg_relation_filenode('largeish'));/);
- $psql_b->{stdin} .= qq/SELECT read_rel_block_ll('largeish',
- blockno=>5, nblocks=>1);\n/;
- $psql_b->{run}->pump_nb();
+ $psql_b->do_async(qq/SELECT read_rel_block_ll('largeish',
+ blockno=>5, nblocks=>1);/);
$node->poll_query_until(
'postgres',
@@ -191,9 +189,8 @@ sub test_inject_foreign
WHERE wait_event = 'completion_wait';/,
'completion_wait');
- $psql_a->{stdin} .= qq/SELECT array_agg(blocknum) FROM
- read_stream_for_blocks('largeish', ARRAY[0, 2, 5, 7]);\n/;
- $psql_a->{run}->pump_nb();
+ $psql_a->do_async(qq/SELECT array_agg(blocknum) FROM
+ read_stream_for_blocks('largeish', ARRAY[0, 2, 5, 7]);/);
$node->poll_query_until('postgres',
qq(SELECT wait_event FROM pg_stat_activity WHERE pid = $pid_a),
@@ -201,15 +198,13 @@ sub test_inject_foreign
$node->safe_psql('postgres', qq/SELECT inj_io_completion_continue()/);
- pump_until(
- $psql_a->{run}, $psql_a->{timeout},
- \$psql_a->{stdout}, qr/\{0,2,5,7\}/);
- $psql_a->{stdout} = '';
+ $psql_a->wait_for_async_pattern(qr/\{0,2,5,7\}/);
- pump_until($psql_b->{run}, $psql_b->{timeout}, \$psql_b->{stderr},
- qr/ERROR.*could not read blocks 5\.\.5/);
- ok(1, "$io_method: injected error occurred");
- $psql_b->{stderr} = '';
+ # Session b's low-level read hits the injected error.
+ my $res_b = $psql_b->get_async_result();
+ like($res_b->{error_message}, qr/ERROR.*could not read blocks 5\.\.5/,
+ "$io_method: injected error occurred");
+ $psql_b->clear_stderr();
$psql_b->query_safe(qq/SELECT inj_io_short_read_detach();/);
ok(1,
@@ -226,9 +221,8 @@ sub test_inject_foreign
qq/SELECT inj_io_completion_wait(pid=>pg_backend_pid(),
relfilenode=>pg_relation_filenode('largeish'));/);
- $psql_b->{stdin} .= qq/SELECT read_rel_block_ll('largeish',
- blockno=>2, nblocks=>3);\n/;
- $psql_b->{run}->pump_nb();
+ $psql_b->do_async(qq/SELECT read_rel_block_ll('largeish',
+ blockno=>2, nblocks=>3);/);
$node->poll_query_until(
'postgres',
@@ -237,9 +231,8 @@ sub test_inject_foreign
'completion_wait');
# Blocks 2 and 4 are undergoing IO initiated by session b
- $psql_a->{stdin} .= qq/SELECT array_agg(blocknum) FROM
- read_stream_for_blocks('largeish', ARRAY[0, 2, 4]);\n/;
- $psql_a->{run}->pump_nb();
+ $psql_a->do_async(qq/SELECT array_agg(blocknum) FROM
+ read_stream_for_blocks('largeish', ARRAY[0, 2, 4]);/);
$node->poll_query_until('postgres',
qq(SELECT wait_event FROM pg_stat_activity WHERE pid = $pid_a),
@@ -247,15 +240,15 @@ sub test_inject_foreign
$node->safe_psql('postgres', qq/SELECT inj_io_completion_continue()/);
- pump_until(
- $psql_a->{run}, $psql_a->{timeout},
- \$psql_a->{stdout}, qr/\{0,2,4\}/);
- $psql_a->{stdout} = '';
+ $psql_a->wait_for_async_pattern(qr/\{0,2,4\}/);
+
+ # Drain session b's now-completed low-level read.
+ $psql_b->wait_for_completion;
ok(1, qq/$io_method: read stream encounters two buffer read in one IO/);
- $psql_a->quit();
- $psql_b->quit();
+ $psql_a->close();
+ $psql_b->close();
}
diff --git a/src/test/modules/test_checksums/t/002_restarts.pl b/src/test/modules/test_checksums/t/002_restarts.pl
index 1aa2c0c65e..cd9a7314c8 100644
--- a/src/test/modules/test_checksums/t/002_restarts.pl
+++ b/src/test/modules/test_checksums/t/002_restarts.pl
@@ -8,6 +8,7 @@
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
use FindBin;
@@ -44,8 +45,8 @@
#
# This is a similar test to the synthetic variant in 005_injection.pl
# which fakes this scenario.
- my $bsession = $node->background_psql('postgres');
- $bsession->query_safe('CREATE TEMPORARY TABLE tt (a integer);');
+ my $bsession = PostgreSQL::Test::Session->new(node => $node);
+ $bsession->do('CREATE TEMPORARY TABLE tt (a integer);');
# In another session, make sure we can see the blocking temp table but
# start processing anyways and check that we are blocked with a proper
@@ -85,7 +86,7 @@
# session first since the brief period between closing and stopping might
# be enough for checksums to get enabled.
$node->stop;
- $bsession->quit;
+ $bsession->close;
$node->start;
# Ensure the checksums aren't enabled across the restart. This leaves the
diff --git a/src/test/modules/test_checksums/t/003_standby_restarts.pl b/src/test/modules/test_checksums/t/003_standby_restarts.pl
index bb35ed0b32..67d4e76e7b 100644
--- a/src/test/modules/test_checksums/t/003_standby_restarts.pl
+++ b/src/test/modules/test_checksums/t/003_standby_restarts.pl
@@ -7,6 +7,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
use FindBin;
@@ -255,11 +256,11 @@
# Open a background psql connection on the primary and inject a barrier to
# block progress on to keep the state from advancing past inprogress-on
-my $node_primary_bpsql = $node_primary->background_psql('postgres');
-$node_primary_bpsql->query_safe('CREATE TEMPORARY TABLE tt (a integer);');
+my $node_primary_bpsql = PostgreSQL::Test::Session->new(node => $node_primary);
+$node_primary_bpsql->do('CREATE TEMPORARY TABLE tt (a integer);');
# Also open a background psql connection to the standby to make sure we have
# an active backend during promotion.
-my $node_standby_bpsql = $node_standby->background_psql('postgres');
+my $node_standby_bpsql = PostgreSQL::Test::Session->new(node => $node_standby);
# Start to enable checksums and wait until both primary and standby have moved
# to the inprogress-on state. Processing will block here as the temporary rel
@@ -281,7 +282,11 @@
is($result, 'off',
'ensure checksums are set to off after promotion during inprogress-on');
-$node_standby_bpsql->quit;
+# The primary's session was kept open only to hold the blocking temp table;
+# close it explicitly (its backend is already gone after the crash) so it is
+# not left to be torn down at global destruction.
+$node_primary_bpsql->close;
+$node_standby_bpsql->close;
$node_standby->stop;
done_testing();
diff --git a/src/test/modules/test_checksums/t/004_offline.pl b/src/test/modules/test_checksums/t/004_offline.pl
index 73c279e75e..be6b6b6e4c 100644
--- a/src/test/modules/test_checksums/t/004_offline.pl
+++ b/src/test/modules/test_checksums/t/004_offline.pl
@@ -8,6 +8,7 @@
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
use FindBin;
@@ -53,8 +54,8 @@
# can accomplish this by setting up an interactive psql process which keeps the
# temporary table created as we enable checksums in another psql process.
-my $bsession = $node->background_psql('postgres');
-$bsession->query_safe('CREATE TEMPORARY TABLE tt (a integer);');
+my $bsession = PostgreSQL::Test::Session->new(node => $node);
+$bsession->do('CREATE TEMPORARY TABLE tt (a integer);');
# In another session, make sure we can see the blocking temp table but start
# processing anyways and check that we are blocked with a proper wait event.
@@ -70,7 +71,7 @@
# Stop the cluster before exiting the background session since otherwise
# checksums might have time to get enabled before shutting down the cluster.
$node->stop('fast');
-$bsession->quit;
+$bsession->close;
$node->checksum_enable_offline;
$node->start;
diff --git a/src/test/modules/test_misc/t/005_timeouts.pl b/src/test/modules/test_misc/t/005_timeouts.pl
index c16b7dbf5e..d64a787a9a 100644
--- a/src/test/modules/test_misc/t/005_timeouts.pl
+++ b/src/test/modules/test_misc/t/005_timeouts.pl
@@ -6,6 +6,7 @@
use locale;
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Time::HiRes qw(usleep);
use Test::More;
@@ -42,24 +43,16 @@
$node->safe_psql('postgres',
"SELECT injection_points_attach('transaction-timeout', 'wait');");
-my $psql_session = $node->background_psql('postgres');
-
-# The following query will generate a stream of SELECT 1 queries. This is done
-# so to exercise transaction timeout in the presence of short queries.
-# Note: the interval value is parsed with locale-aware strtod()
-$psql_session->query_until(
- qr/starting_bg_psql/,
- sprintf(
- q(\echo starting_bg_psql
- SET transaction_timeout to '10ms';
- BEGIN;
- SELECT 1 \watch %g
- \q
-), 0.001));
+my $psql_session = PostgreSQL::Test::Session->new(node => $node);
+
+$psql_session->do("SET transaction_timeout to '10ms';");
+
+$psql_session->do_async("BEGIN; DO ' begin loop PERFORM pg_sleep(0.001); end loop; end ';");
# Wait until the backend enters the timeout injection point. Will get an error
# here if anything goes wrong.
$node->wait_for_event('client backend', 'transaction-timeout');
+pass("got transaction timeout event");
my $log_offset = -s $node->logfile;
@@ -70,11 +63,9 @@
# Check that the timeout was logged.
$node->wait_for_log('terminating connection due to transaction timeout',
$log_offset);
+pass("got transaction timeout log");
-# If we send \q with $psql_session->quit the command can be sent to the session
-# already closed. So \q is in initial script, here we only finish IPC::Run.
-$psql_session->{run}->finish;
-
+$psql_session->close;
#
# 2. Test of the idle in transaction timeout
@@ -85,10 +76,8 @@
);
# We begin a transaction and the hand on the line
-$psql_session = $node->background_psql('postgres');
-$psql_session->query_until(
- qr/starting_bg_psql/, q(
- \echo starting_bg_psql
+$psql_session->reconnect;
+$psql_session->do(q(
SET idle_in_transaction_session_timeout to '10ms';
BEGIN;
));
@@ -96,6 +85,7 @@
# Wait until the backend enters the timeout injection point.
$node->wait_for_event('client backend',
'idle-in-transaction-session-timeout');
+pass("got idle in transaction timeout event");
$log_offset = -s $node->logfile;
@@ -106,8 +96,9 @@
# Check that the timeout was logged.
$node->wait_for_log(
'terminating connection due to idle-in-transaction timeout', $log_offset);
+pass("got idle in transaction timeout log");
-ok($psql_session->quit);
+$psql_session->close;
#
@@ -117,15 +108,14 @@
"SELECT injection_points_attach('idle-session-timeout', 'wait');");
# We just initialize the GUC and wait. No transaction is required.
-$psql_session = $node->background_psql('postgres');
-$psql_session->query_until(
- qr/starting_bg_psql/, q(
- \echo starting_bg_psql
+$psql_session->reconnect;
+$psql_session->do(q(
SET idle_session_timeout to '10ms';
));
# Wait until the backend enters the timeout injection point.
$node->wait_for_event('client backend', 'idle-session-timeout');
+pass("got idle session timeout event");
$log_offset = -s $node->logfile;
@@ -136,7 +126,8 @@
# Check that the timeout was logged.
$node->wait_for_log('terminating connection due to idle-session timeout',
$log_offset);
+pass("got idle sesion tiemout log");
-ok($psql_session->quit);
+$psql_session->close;
done_testing();
diff --git a/src/test/modules/test_misc/t/007_catcache_inval.pl b/src/test/modules/test_misc/t/007_catcache_inval.pl
index 424556261c..e3b3fd8bae 100644
--- a/src/test/modules/test_misc/t/007_catcache_inval.pl
+++ b/src/test/modules/test_misc/t/007_catcache_inval.pl
@@ -46,12 +46,12 @@ sub randStr
CREATE FUNCTION foofunc(dummy integer) RETURNS integer AS \$\$ SELECT 1; /* $longtext */ \$\$ LANGUAGE SQL
]);
-my $psql_session = $node->background_psql('postgres');
-my $psql_session2 = $node->background_psql('postgres');
+my $psql_session = PostgreSQL::Test::Session->new(node => $node);
+my $psql_session2 = PostgreSQL::Test::Session->new(node => $node);
# Set injection point in the session, to pause while populating the
# catcache list
-$psql_session->query_safe(
+$psql_session->do(
qq[
SELECT injection_points_set_local();
SELECT injection_points_attach('catcache-list-miss-systable-scan-started', 'wait');
@@ -59,10 +59,9 @@ sub randStr
# This pauses on the injection point while populating catcache list
# for functions with name "foofunc"
-$psql_session->query_until(
- qr/starting_bg_psql/, q(
- \echo starting_bg_psql
- SELECT foofunc(1);
+$psql_session->do_async(
+ q(
+ SELECT foofunc(1);
));
# While the first session is building the catcache list, create a new
@@ -83,16 +82,19 @@ sub randStr
# trying to exercise here.)
#
# The "SELECT foofunc(1)" query will now finish.
-$psql_session2->query_safe(
+$psql_session2->do(
qq[
SELECT injection_points_wakeup('catcache-list-miss-systable-scan-started');
SELECT injection_points_detach('catcache-list-miss-systable-scan-started');
]);
# Test that the new function is visible to the session.
-$psql_session->query_safe("SELECT foofunc();");
+$psql_session->wait_for_completion;
+my $res = $psql_session->query("SELECT foofunc();");
-ok($psql_session->quit);
-ok($psql_session2->quit);
+is($res->{status}, 2, "got TUPLES_OK");
+
+$psql_session->close;
+$psql_session2->close;
done_testing();
diff --git a/src/test/modules/test_misc/t/010_index_concurrently_upsert.pl b/src/test/modules/test_misc/t/010_index_concurrently_upsert.pl
index 50a0e7db8f..a7359cb062 100644
--- a/src/test/modules/test_misc/t/010_index_concurrently_upsert.pl
+++ b/src/test/modules/test_misc/t/010_index_concurrently_upsert.pl
@@ -13,6 +13,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
use Time::HiRes qw(usleep);
@@ -51,47 +52,38 @@
############################################################################
note('Test: REINDEX CONCURRENTLY + UPSERT (wakeup at set-dead phase)');
-# Create sessions with on_error_stop => 0 so psql doesn't exit on SQL errors.
-# This allows us to collect stderr and detect errors after the test completes.
-my $s1 = $node->background_psql('postgres', on_error_stop => 0);
-my $s2 = $node->background_psql('postgres', on_error_stop => 0);
-my $s3 = $node->background_psql('postgres', on_error_stop => 0);
+# Create sessions for concurrent operations
+my $s1 = PostgreSQL::Test::Session->new(node => $node);
+my $s2 = PostgreSQL::Test::Session->new(node => $node);
+my $s3 = PostgreSQL::Test::Session->new(node => $node);
# Setup injection points for each session
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
# s3 starts REINDEX (will block on reindex-relation-concurrently-before-set-dead)
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
# Wait for s3 to hit injection point
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
# s1 starts UPSERT (will block on check-exclusion-or-unique-constraint-no-conflict)
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
# Wait for s1 to hit injection point
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
@@ -101,11 +93,7 @@
'reindex-relation-concurrently-before-set-dead');
# s2 starts UPSERT (will block on exec-insert-before-insert-speculative)
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
# Wait for s2 to hit injection point
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -125,51 +113,39 @@
############################################################################
note('Test: REINDEX CONCURRENTLY + UPSERT (wakeup at swap phase)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-swap', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
wakeup_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -184,50 +160,38 @@
############################################################################
note('Test: REINDEX CONCURRENTLY + UPSERT (s1 wakes before reindex)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
# Start s2 BEFORE waking reindex (key difference from permutation 1)
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -245,52 +209,40 @@
############################################################################
note('Test: REINDEX + UPSERT ON CONSTRAINT (set-dead phase)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
wakeup_injection_point($node,
'reindex-relation-concurrently-before-set-dead');
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -305,51 +257,39 @@
############################################################################
note('Test: REINDEX + UPSERT ON CONSTRAINT (swap phase)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-swap', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
wakeup_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -364,50 +304,38 @@
############################################################################
note('Test: REINDEX + UPSERT ON CONSTRAINT (s1 wakes before reindex)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tblpk_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tblpk_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
# Start s2 BEFORE waking reindex
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13, now()) ON CONFLICT ON CONSTRAINT tblpk_pkey DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -425,52 +353,40 @@
############################################################################
note('Test: REINDEX on partitioned table (set-dead phase)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
wakeup_injection_point($node,
'reindex-relation-concurrently-before-set-dead');
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -485,51 +401,39 @@
############################################################################
note('Test: REINDEX on partitioned table (swap phase)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-swap', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
wakeup_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -544,50 +448,38 @@
############################################################################
note('Test: REINDEX on partitioned table (s1 wakes before reindex)');
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-set-dead', 'wait');
]);
-$s3->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;
-]);
+$s3->do_async(q[REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-set-dead');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'check-exclusion-or-unique-constraint-no-conflict');
# Start s2 BEFORE waking reindex
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -607,35 +499,27 @@
'Test: REINDEX on partitioned table, cache inval between two get_partition_ancestors'
);
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-init-partition-after-get-partition-ancestors', 'wait');
]);
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('reindex-relation-concurrently-before-swap', 'wait');
]);
-$s2->query_until(
- qr/starting_reindex/, q[
-\echo starting_reindex
-REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;
-]);
+$s2->do_async(q[REINDEX INDEX CONCURRENTLY test.tbl_partition_pkey;]);
ok_injection_point($node, 'reindex-relation-concurrently-before-swap');
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblparted VALUES (13, now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node,
'exec-init-partition-after-get-partition-ancestors');
@@ -654,26 +538,24 @@
# Uses invalidate-catalog-snapshot-end to test catalog invalidation
# during UPSERT
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-my $s1_pid = $s1->query_safe('SELECT pg_backend_pid()');
+# Get the session's backend PID before attaching injection points
+my $s1_pid = $s1->query_oneval('SELECT pg_backend_pid()');
# s1 attaches BOTH injection points - the unique constraint check AND catalog snapshot
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s1->query_until(
- qr/attaching_injection_point/, q[
-\echo attaching_injection_point
-SELECT injection_points_attach('invalidate-catalog-snapshot-end', 'wait');
-]);
-
# In cases of cache clobbering, s1 may hit the injection point during attach.
+# Start attach asynchronously so we can check if it blocks.
+$s1->do_async(q[SELECT injection_points_attach('invalidate-catalog-snapshot-end', 'wait');]);
+
# Wait for that session to become idle (attach completed), or wake it up if
# it becomes stuck on injection point.
if (!wait_for_idle($node, $s1_pid))
@@ -687,34 +569,28 @@
SELECT injection_points_wakeup('invalidate-catalog-snapshot-end');
]);
}
+# Wait for async command to complete
+$s1->wait_for_completion;
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('define-index-before-set-valid', 'wait');
]);
# s3: Start CREATE INDEX CONCURRENTLY (blocks on define-index-before-set-valid)
-$s3->query_until(
- qr/starting_create_index/, q[
-\echo starting_create_index
-CREATE UNIQUE INDEX CONCURRENTLY tbl_pkey_duplicate ON test.tblpk(i);
-]);
+$s3->do_async(q[CREATE UNIQUE INDEX CONCURRENTLY tbl_pkey_duplicate ON test.tblpk(i);]);
ok_injection_point($node, 'define-index-before-set-valid');
# s1: Start UPSERT (blocks on invalidate-catalog-snapshot-end)
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'invalidate-catalog-snapshot-end');
@@ -722,11 +598,7 @@
wakeup_injection_point($node, 'define-index-before-set-valid');
# s2: Start UPSERT (blocks on exec-insert-before-insert-speculative)
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblpk VALUES (13,now()) ON CONFLICT (i) DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
@@ -747,24 +619,20 @@
note('Test: CREATE INDEX CONCURRENTLY on partial index + UPSERT');
# Uses invalidate-catalog-snapshot-end to test catalog invalidation during UPSERT
-$s1 = $node->background_psql('postgres', on_error_stop => 0);
-$s2 = $node->background_psql('postgres', on_error_stop => 0);
-$s3 = $node->background_psql('postgres', on_error_stop => 0);
+$s1 = PostgreSQL::Test::Session->new(node => $node);
+$s2 = PostgreSQL::Test::Session->new(node => $node);
+$s3 = PostgreSQL::Test::Session->new(node => $node);
-$s1_pid = $s1->query_safe('SELECT pg_backend_pid()');
+$s1_pid = $s1->query_oneval('SELECT pg_backend_pid()');
# s1 attaches BOTH injection points - the unique constraint check AND catalog snapshot
-$s1->query_safe(
+$s1->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('check-exclusion-or-unique-constraint-no-conflict', 'wait');
]);
-$s1->query_until(
- qr/attaching_injection_point/, q[
-\echo attaching_injection_point
-SELECT injection_points_attach('invalidate-catalog-snapshot-end', 'wait');
-]);
+$s1->do(q[SELECT injection_points_attach('invalidate-catalog-snapshot-end', 'wait');]);
# In cases of cache clobbering, s1 may hit the injection point during attach.
# Wait for that session to become idle (attach completed), or wake it up if
@@ -781,33 +649,25 @@
]);
}
-$s2->query_safe(
+$s2->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('exec-insert-before-insert-speculative', 'wait');
]);
-$s3->query_safe(
+$s3->do(
q[
SELECT injection_points_set_local();
SELECT injection_points_attach('define-index-before-set-valid', 'wait');
]);
# s3: Start CREATE INDEX CONCURRENTLY (blocks on define-index-before-set-valid)
-$s3->query_until(
- qr/starting_create_index/, q[
-\echo starting_create_index
-CREATE UNIQUE INDEX CONCURRENTLY tbl_pkey_special_duplicate ON test.tblexpr(abs(i)) WHERE i < 10000;
-]);
+$s3->do_async(q[CREATE UNIQUE INDEX CONCURRENTLY tbl_pkey_special_duplicate ON test.tblexpr(abs(i)) WHERE i < 10000;]);
ok_injection_point($node, 'define-index-before-set-valid');
# s1: Start UPSERT (blocks on invalidate-catalog-snapshot-end)
-$s1->query_until(
- qr/starting_upsert_s1/, q[
-\echo starting_upsert_s1
-INSERT INTO test.tblexpr VALUES(13,now()) ON CONFLICT (abs(i)) WHERE i < 100 DO UPDATE SET updated_at = now();
-]);
+$s1->do_async(q[INSERT INTO test.tblexpr VALUES(13,now()) ON CONFLICT (abs(i)) WHERE i < 100 DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'invalidate-catalog-snapshot-end');
@@ -815,11 +675,7 @@
wakeup_injection_point($node, 'define-index-before-set-valid');
# s2: Start UPSERT (blocks on exec-insert-before-insert-speculative)
-$s2->query_until(
- qr/starting_upsert_s2/, q[
-\echo starting_upsert_s2
-INSERT INTO test.tblexpr VALUES(13,now()) ON CONFLICT (abs(i)) WHERE i < 100 DO UPDATE SET updated_at = now();
-]);
+$s2->do_async(q[INSERT INTO test.tblexpr VALUES(13,now()) ON CONFLICT (abs(i)) WHERE i < 100 DO UPDATE SET updated_at = now();]);
ok_injection_point($node, 'exec-insert-before-insert-speculative');
wakeup_injection_point($node, 'invalidate-catalog-snapshot-end');
@@ -920,33 +776,23 @@ sub wakeup_injection_point
]);
}
-# Wait for any pending query to complete, capture stderr, and close the session.
-# Returns the stderr output (excluding internal markers).
+# Wait for any pending query to complete and close the session.
+# Returns empty string on success, error message on failure.
sub safe_quit
{
my ($session) = @_;
- # Send a marker and wait for it to ensure any pending query completes
- my $banner = "safe_quit_marker";
- my $banner_match = qr/(^|\n)$banner\r?\n/;
-
- $session->{stdin} .= "\\echo $banner\n\\warn $banner\n";
-
- pump_until(
- $session->{run}, $session->{timeout},
- \$session->{stdout}, $banner_match);
- pump_until(
- $session->{run}, $session->{timeout},
- \$session->{stderr}, $banner_match);
+ # Wait for any async queries to complete
+ $session->wait_for_completion;
- # Capture stderr (excluding the banner)
- my $stderr = $session->{stderr};
- $stderr =~ s/$banner_match//;
+ # Check connection status
+ my $status = $session->conn_status;
# Close the session
- $session->quit;
+ $session->close;
- return $stderr;
+ # Return empty string if connection was OK, otherwise return error
+ return ($status == PostgreSQL::PqFFI::CONNECTION_OK()) ? '' : 'connection error';
}
# Helper function: verify that the given sessions exit cleanly.
diff --git a/src/test/modules/test_misc/t/011_lock_stats.pl b/src/test/modules/test_misc/t/011_lock_stats.pl
index 45d7d26f70..00c1ab00df 100644
--- a/src/test/modules/test_misc/t/011_lock_stats.pl
+++ b/src/test/modules/test_misc/t/011_lock_stats.pl
@@ -19,6 +19,7 @@
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
plan skip_all => 'Injection points not supported by this build'
@@ -32,15 +33,12 @@
# Setup the 2 sessions
sub setup_sessions
{
- $s1 = $node->background_psql('postgres');
- $s2 = $node->background_psql('postgres');
+ $s1 = PostgreSQL::Test::Session->new(node => $node);
+ $s2 = PostgreSQL::Test::Session->new(node => $node);
# Setup injection points for the waiting session
- $s2->query_until(
- qr/attaching_injection_point/, q[
- \echo attaching_injection_point
- SELECT injection_points_attach('deadlock-timeout-fired', 'wait');
- ]);
+ $s2->do(
+ q[SELECT injection_points_attach('deadlock-timeout-fired', 'wait');]);
}
# Fetch waits and wait_time from pg_stat_lock for a given lock type
@@ -98,7 +96,7 @@ sub wait_and_detach
my $log_offset = -s $node->logfile;
-$s1->query_safe(
+$s1->do(
q[
SELECT pg_stat_reset_shared('lock');
BEGIN;
@@ -106,17 +104,13 @@ sub wait_and_detach
]);
# s2 setup
-$s2->query_safe(
+$s2->do(
q[
BEGIN;
SELECT pg_stat_force_next_flush();
]);
# s2 blocks on LOCK.
-$s2->query_until(
- qr/lock_s2/, q[
-\echo lock_s2
-LOCK TABLE test_stat_tab;
-]);
+$s2->do_async(q(LOCK TABLE test_stat_tab;));
wait_and_detach($node, 'deadlock-timeout-fired');
@@ -136,8 +130,9 @@ sub wait_and_detach
$node->wait_for_log(qr/logging memory contexts/, $log_offset);
# deadlock_timeout fired, now commit in s1 and s2
-$s1->query_safe(q(COMMIT));
-$s2->query_safe(q(COMMIT));
+$s1->do(q(COMMIT));
+$s2->wait_for_completion;
+$s2->do(q(COMMIT));
# check that pg_stat_lock has been updated
wait_for_pg_stat_lock($node, 'relation');
@@ -158,8 +153,8 @@ sub wait_and_detach
);
# close sessions
-$s1->quit;
-$s2->quit;
+$s1->close;
+$s2->close;
####### transaction lock
@@ -167,27 +162,31 @@ sub wait_and_detach
$log_offset = -s $node->logfile;
-$s1->query_safe(
+# The INSERT must autocommit before the explicit transaction is opened, so
+# that session s2 can see rows k1/k2/k3 and block on s1's row lock. Send it
+# separately from the BEGIN block: a single multi-statement query containing
+# BEGIN would run the INSERT inside the still-open transaction, leaving the
+# rows invisible to s2 (so its UPDATE would match nothing and never wait).
+$s1->do(
q[
SELECT pg_stat_reset_shared('lock');
INSERT INTO test_stat_tab(key, value) VALUES('k1', 1), ('k2', 1), ('k3', 1);
+]);
+$s1->do(
+ q[
BEGIN;
UPDATE test_stat_tab SET value = value + 1 WHERE key = 'k1';
]);
# s2 setup
-$s2->query_safe(
+$s2->do(
q[
SET log_lock_waits = on;
BEGIN;
SELECT pg_stat_force_next_flush();
]);
# s2 blocks here on UPDATE
-$s2->query_until(
- qr/lock_s2/, q[
-\echo lock_s2
-UPDATE test_stat_tab SET value = value + 1 WHERE key = 'k1';
-]);
+$s2->do_async(q(UPDATE test_stat_tab SET value = value + 1 WHERE key = 'k1';));
wait_and_detach($node, 'deadlock-timeout-fired');
@@ -196,8 +195,9 @@ sub wait_and_detach
$log_offset);
# deadlock_timeout fired, now commit in s1 and s2
-$s1->query_safe(q(COMMIT));
-$s2->query_safe(q(COMMIT));
+$s1->do(q(COMMIT));
+$s2->wait_for_completion;
+$s2->do(q(COMMIT));
# check that pg_stat_lock has been updated
wait_for_pg_stat_lock($node, 'transactionid');
@@ -208,8 +208,8 @@ sub wait_and_detach
$node->wait_for_log(qr/acquired ShareLock on transaction/, $log_offset);
# Close sessions
-$s1->quit;
-$s2->quit;
+$s1->close;
+$s2->close;
####### advisory lock
@@ -217,25 +217,21 @@ sub wait_and_detach
$log_offset = -s $node->logfile;
-$s1->query_safe(
+$s1->do(
q[
SELECT pg_stat_reset_shared('lock');
SELECT pg_advisory_lock(1);
]);
# s2 setup
-$s2->query_safe(
+$s2->do(
q[
SET log_lock_waits = on;
BEGIN;
SELECT pg_stat_force_next_flush();
]);
# s2 blocks on the advisory lock.
-$s2->query_until(
- qr/lock_s2/, q[
-\echo lock_s2
-SELECT pg_advisory_lock(1);
-]);
+$s2->do_async(q(SELECT pg_advisory_lock(1);));
wait_and_detach($node, 'deadlock-timeout-fired');
@@ -244,8 +240,9 @@ sub wait_and_detach
$log_offset);
# deadlock_timeout fired, now unlock and commit s2
-$s1->query_safe(q(SELECT pg_advisory_unlock(1)));
-$s2->query_safe(
+$s1->do(q(SELECT pg_advisory_unlock(1)));
+$s2->wait_for_completion;
+$s2->do(
q[
SELECT pg_advisory_unlock(1);
COMMIT;
@@ -260,8 +257,8 @@ sub wait_and_detach
$node->wait_for_log(qr/acquired ExclusiveLock on advisory lock/, $log_offset);
# Close sessions
-$s1->quit;
-$s2->quit;
+$s1->close;
+$s2->close;
####### Ensure log_lock_waits has no impact
@@ -269,7 +266,7 @@ sub wait_and_detach
$log_offset = -s $node->logfile;
-$s1->query_safe(
+$s1->do(
q[
SELECT pg_stat_reset_shared('lock');
BEGIN;
@@ -277,24 +274,21 @@ sub wait_and_detach
]);
# s2 setup
-$s2->query_safe(
+$s2->do(
q[
SET log_lock_waits = off;
BEGIN;
SELECT pg_stat_force_next_flush();
]);
# s2 blocks on LOCK.
-$s2->query_until(
- qr/lock_s2/, q[
-\echo lock_s2
-LOCK TABLE test_stat_tab;
-]);
+$s2->do_async(q(LOCK TABLE test_stat_tab;));
wait_and_detach($node, 'deadlock-timeout-fired');
# deadlock_timeout fired, now commit in s1 and s2
-$s1->query_safe(q(COMMIT));
-$s2->query_safe(q(COMMIT));
+$s1->do(q(COMMIT));
+$s2->wait_for_completion;
+$s2->do(q(COMMIT));
# check that pg_stat_lock has been updated
wait_for_pg_stat_lock($node, 'relation');
@@ -310,8 +304,8 @@ sub wait_and_detach
);
# close sessions
-$s1->quit;
-$s2->quit;
+$s1->close;
+$s2->close;
# cleanup
$node->safe_psql('postgres', q[DROP TABLE test_stat_tab;]);
diff --git a/src/test/modules/test_misc/t/013_temp_obj_multisession.pl b/src/test/modules/test_misc/t/013_temp_obj_multisession.pl
index 5f3cc7d2fc..0b15b0bde0 100644
--- a/src/test/modules/test_misc/t/013_temp_obj_multisession.pl
+++ b/src/test/modules/test_misc/t/013_temp_obj_multisession.pl
@@ -20,21 +20,21 @@
use warnings;
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
-use PostgreSQL::Test::BackgroundPsql;
+use PostgreSQL::Test::Session;
use Test::More;
my $node = PostgreSQL::Test::Cluster->new('temp_lock');
$node->init;
$node->start;
-# Owner session. Created via background_psql so it stays alive while
-# the second session probes its temp objects.
-my $psql1 = $node->background_psql('postgres');
+# Owner session. Created as a persistent libpq session so it stays alive
+# while the second session probes its temp objects.
+my $psql1 = PostgreSQL::Test::Session->new(node => $node);
# Initially create the table without an index, so read paths go straight
# through the read-stream / buffer-manager entry points without being
# masked by an index scan that would hit ReadBuffer_common from nbtree.
-$psql1->query_safe(q(CREATE TEMP TABLE foo AS SELECT 42 AS val;));
+$psql1->do(q(CREATE TEMP TABLE foo AS SELECT 42 AS val;));
# Resolve the owner's temp schema so the probing session can refer to
# the table by a fully-qualified name.
@@ -130,7 +130,7 @@
# Now create an index to exercise the index-scan path. nbtree calls
# ReadBuffer (which is ReadBufferExtended -> ReadBuffer_common), so
# this exercises a different chain of buffer-manager entry points.
-$psql1->query_safe(q(CREATE INDEX ON foo(val);));
+$psql1->do(q(CREATE INDEX ON foo(val);));
$node->psql(
'postgres',
@@ -156,7 +156,7 @@
# operations -- they don't read the underlying table -- which
# documents the boundary between catalog and data access for temp
# objects.
-$psql1->query_safe(
+$psql1->do(
q[CREATE FUNCTION pg_temp.foo_id(r foo) RETURNS int LANGUAGE SQL ]
. q[AS 'SELECT r.val';]);
@@ -187,7 +187,7 @@
# into the creator's pg_temp namespace with an auto-dependency on
# the borrowed type, so it disappears together with the session that
# created it.
-$psql1->query_safe(q(CREATE TEMP TABLE foo2 AS SELECT 42 AS val;));
+$psql1->do(q(CREATE TEMP TABLE foo2 AS SELECT 42 AS val;));
$node->psql(
'postgres',
@@ -216,8 +216,8 @@
# Cross-session LOCK TABLE scenario. Ensure that LockRelationOid is working
# properly for other temp tables since this mechanism is also used by
# autovacuum during orphaned tables cleanup.
-my $psql2 = $node->background_psql('postgres');
-$psql2->query_safe(
+my $psql2 = PostgreSQL::Test::Session->new(node => $node);
+$psql2->do(
qq{
BEGIN;
LOCK TABLE $tempschema.foo2 IN ACCESS SHARE MODE;
@@ -233,15 +233,15 @@
# owner will try to acquire deletion lock all its temp objects via
# findDependentObjects.
my $log_offset = -s $node->logfile;
-$psql1->quit;
+$psql1->close;
# Check whether session-exit cleanup is blocked.
$node->wait_for_log(qr/waiting for AccessExclusiveLock on relation $foo2_oid/,
$log_offset);
# Release lock on foo2 and allow session-exit cleanup to finish.
-$psql2->query_safe(q(COMMIT;));
-$psql2->quit;
+$psql2->do(q(COMMIT;));
+$psql2->close;
# After releasing the lock, the owner can finally acquire
# AccessExclusiveLock on foo2 and finish session-exit cleanup. Verify
diff --git a/src/test/modules/test_slru/t/001_multixact.pl b/src/test/modules/test_slru/t/001_multixact.pl
index f6f45895eb..2d86434d7b 100644
--- a/src/test/modules/test_slru/t/001_multixact.pl
+++ b/src/test/modules/test_slru/t/001_multixact.pl
@@ -6,6 +6,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -30,8 +31,8 @@
# lost.
# Create the first multixact
-my $bg_psql = $node->background_psql('postgres');
-my $multi1 = $bg_psql->query_safe(q(SELECT test_create_multixact();));
+my $bg_session = PostgreSQL::Test::Session->new(node => $node);
+my $multi1 = $bg_session->query_oneval(q(SELECT test_create_multixact();));
# Assign the middle multixact. Use an injection point to prevent it
# from being fully recorded.
@@ -39,11 +40,9 @@
q{SELECT injection_points_attach('multixact-create-from-members','wait');}
);
-$bg_psql->query_until(
- qr/assigning lost multi/, q(
-\echo assigning lost multi
- SELECT test_create_multixact();
-));
+# Start the second multixact creation asynchronously - it will block at
+# the injection point
+$bg_session->do_async(q(SELECT test_create_multixact();));
$node->wait_for_event('client backend', 'multixact-create-from-members');
$node->safe_psql('postgres',
@@ -52,10 +51,10 @@
# Create the third multixid
my $multi2 = $node->safe_psql('postgres', q{SELECT test_create_multixact();});
-# All set and done, it's time for hard restart
+# All set and done, it's time for hard restart. The background session
+# will be terminated by the crash.
$node->stop('immediate');
$node->start;
-$bg_psql->{run}->finish;
# Verify that the recorded multixids are readable
is( $node->safe_psql('postgres', qq{SELECT test_read_multixact('$multi1');}),
diff --git a/src/test/modules/xid_wraparound/t/001_emergency_vacuum.pl b/src/test/modules/xid_wraparound/t/001_emergency_vacuum.pl
index 213f9052ed..304076735b 100644
--- a/src/test/modules/xid_wraparound/t/001_emergency_vacuum.pl
+++ b/src/test/modules/xid_wraparound/t/001_emergency_vacuum.pl
@@ -4,6 +4,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -47,17 +48,10 @@
INSERT INTO small_trunc(data) SELECT generate_series(1,15000);
]);
-# Bump the query timeout to avoid false negatives on slow test systems.
-my $psql_timeout_secs = 4 * $PostgreSQL::Test::Utils::timeout_default;
-
# Start a background session, which holds a transaction open, preventing
# autovacuum from advancing relfrozenxid and datfrozenxid.
-my $background_psql = $node->background_psql(
- 'postgres',
- on_error_stop => 0,
- timeout => $psql_timeout_secs);
-$background_psql->set_query_timer_restart();
-$background_psql->query_safe(
+my $background_session = PostgreSQL::Test::Session->new(node => $node);
+$background_session->do(
qq[
BEGIN;
DELETE FROM large WHERE id % 2 = 0;
@@ -89,8 +83,8 @@
# Finish the old transaction, to allow vacuum freezing to advance
# relfrozenxid and datfrozenxid again.
-$background_psql->query_safe(qq[COMMIT]);
-$background_psql->quit;
+$background_session->do(qq[COMMIT;]);
+$background_session->close;
# Wait until autovacuum processed all tables and advanced the
# system-wide oldest-XID.
diff --git a/src/test/modules/xid_wraparound/t/002_limits.pl b/src/test/modules/xid_wraparound/t/002_limits.pl
index 86632a8d51..0ef67d0f4b 100644
--- a/src/test/modules/xid_wraparound/t/002_limits.pl
+++ b/src/test/modules/xid_wraparound/t/002_limits.pl
@@ -10,6 +10,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
use Time::HiRes qw(usleep);
@@ -29,6 +30,8 @@
'postgresql.conf', qq[
autovacuum_naptime = 1s
log_autovacuum_min_duration = 0
+log_connections = on
+log_statement = 'all'
]);
$node->start;
$node->safe_psql('postgres', 'CREATE EXTENSION xid_wraparound');
@@ -41,16 +44,10 @@
INSERT INTO wraparoundtest VALUES ('start');
]);
-# Bump the query timeout to avoid false negatives on slow test systems.
-my $psql_timeout_secs = 4 * $PostgreSQL::Test::Utils::timeout_default;
-
# Start a background session, which holds a transaction open, preventing
# autovacuum from advancing relfrozenxid and datfrozenxid.
-my $background_psql = $node->background_psql(
- 'postgres',
- on_error_stop => 0,
- timeout => $psql_timeout_secs);
-$background_psql->query_safe(
+my $background_session = PostgreSQL::Test::Session->new(node => $node);
+$background_session->do(
qq[
BEGIN;
INSERT INTO wraparoundtest VALUES ('oldxact');
@@ -108,8 +105,8 @@
# Finish the old transaction, to allow vacuum freezing to advance
# relfrozenxid and datfrozenxid again.
-$background_psql->query_safe(qq[COMMIT]);
-$background_psql->quit;
+$background_session->do(qq[COMMIT;]);
+$background_session->close;
# VACUUM, to freeze the tables and advance datfrozenxid.
#
@@ -122,8 +119,8 @@
# the system-wide oldest-XID.
$ret =
$node->poll_query_until('postgres',
- qq[INSERT INTO wraparoundtest VALUES ('after VACUUM')],
- 'INSERT 0 1');
+ qq[INSERT INTO wraparoundtest VALUES ('after VACUUM') RETURNING true],
+ );
# Check the table contents
$ret = $node->safe_psql('postgres', qq[SELECT * from wraparoundtest]);
diff --git a/src/test/modules/xid_wraparound/t/004_notify_freeze.pl b/src/test/modules/xid_wraparound/t/004_notify_freeze.pl
index d0a1f1fe2f..f2fa4e5a6b 100644
--- a/src/test/modules/xid_wraparound/t/004_notify_freeze.pl
+++ b/src/test/modules/xid_wraparound/t/004_notify_freeze.pl
@@ -7,6 +7,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use Test::More;
my $node = PostgreSQL::Test::Cluster->new('node');
@@ -24,9 +25,9 @@
'ALTER DATABASE template0 WITH ALLOW_CONNECTIONS true');
# Start Session 1 and leave it idle in transaction
-my $psql_session1 = $node->background_psql('postgres');
-$psql_session1->query_safe('listen s;');
-$psql_session1->query_safe('begin;');
+my $session1 = PostgreSQL::Test::Session->new(node => $node);
+$session1->do('LISTEN s');
+$session1->do('BEGIN');
# Send some notifys from other sessions
for my $i (1 .. 10)
@@ -54,18 +55,20 @@
"select min(datfrozenxid::text::bigint) from pg_database");
ok($datafronzenxid_freeze > $datafronzenxid, 'datfrozenxid advanced');
-# On Session 1, commit and ensure that the all the notifications are
+# On Session 1, commit and ensure that all the notifications are
# received. This depends on correctly freezing the XIDs in the pending
# notification entries.
-my $res = $psql_session1->query_safe('commit;');
-my $notifications_count = 0;
-foreach my $i (split('\n', $res))
+$session1->do('COMMIT');
+
+my $notifications = $session1->get_all_notifications();
+is(scalar(@$notifications), 10, 'received all committed notifications');
+
+my $expected_payload = 1;
+foreach my $notify (@$notifications)
{
- $notifications_count++;
- like($i,
- qr/Asynchronous notification "s" with payload "$notifications_count" received/
- );
+ is($notify->{channel}, 's', "notification $expected_payload has correct channel");
+ is($notify->{payload}, $expected_payload, "notification $expected_payload has correct payload");
+ $expected_payload++;
}
-is($notifications_count, 10, 'received all committed notifications');
done_testing();
diff --git a/src/test/perl/Makefile b/src/test/perl/Makefile
index fd4fdaf700..d234cc5960 100644
--- a/src/test/perl/Makefile
+++ b/src/test/perl/Makefile
@@ -25,9 +25,14 @@ install: all installdirs
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/Kerberos.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Kerberos.pm'
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/Cluster.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Cluster.pm'
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/BackgroundPsql.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/BackgroundPsql.pm'
+ $(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/Session.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Session.pm'
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/AdjustDump.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/AdjustDump.pm'
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Test/AdjustUpgrade.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/AdjustUpgrade.pm'
$(INSTALL_DATA) $(srcdir)/PostgreSQL/Version.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Version.pm'
+ $(INSTALL_DATA) $(srcdir)/PostgreSQL/FindLib.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/FindLib.pm'
+ $(INSTALL_DATA) $(srcdir)/PostgreSQL/PqFFI.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PqFFI.pm'
+ $(INSTALL_DATA) $(srcdir)/PostgreSQL/PqConstants.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PqConstants.pm'
+ $(INSTALL_DATA) $(srcdir)/PostgreSQL/PGTypes.pm '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PGTypes.pm'
uninstall:
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Utils.pm'
@@ -36,8 +41,13 @@ uninstall:
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Kerberos.pm'
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Cluster.pm'
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/BackgroundPsql.pm'
+ rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/Session.pm'
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/AdjustDump.pm'
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Test/AdjustUpgrade.pm'
rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/Version.pm'
+ rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/FindLib.pm'
+ rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PqFFI.pm'
+ rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PqConstants.pm'
+ rm -f '$(DESTDIR)$(pgxsdir)/$(subdir)/PostgreSQL/PGTypes.pm'
endif
diff --git a/src/test/perl/PostgreSQL/FindLib.pm b/src/test/perl/PostgreSQL/FindLib.pm
new file mode 100644
index 0000000000..b4290c84c4
--- /dev/null
+++ b/src/test/perl/PostgreSQL/FindLib.pm
@@ -0,0 +1,164 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::FindLib - find shared libraries for PostgreSQL TAP tests
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::FindLib;
+
+ my $libpath = find_lib_or_die(
+ lib => 'pq',
+ libpath => ['/usr/local/pgsql/lib'],
+ );
+
+=head1 DESCRIPTION
+
+This module provides a simple mechanism to locate shared libraries,
+used as a lightweight replacement for C. It searches
+for libraries in specified paths and common system locations.
+
+=head1 EXPORTED FUNCTIONS
+
+=over
+
+=item find_lib_or_die(%args)
+
+Searches for a shared library and returns its full path. Dies if the
+library cannot be found.
+
+Arguments:
+
+=over
+
+=item lib => $name
+
+Required. The library name without prefix or suffix (e.g., C<'pq'> for
+C).
+
+=item libpath => \@paths
+
+Optional. Array of directories to search first.
+
+=item systempath => \@paths
+
+Optional. If set to an empty array C<[]>, system paths will not be searched.
+
+=back
+
+=back
+
+=cut
+
+package PostgreSQL::FindLib;
+
+use strict;
+use warnings FATAL => qw(all);
+
+use Exporter qw(import);
+use File::Spec;
+use Config;
+
+our @EXPORT = qw(find_lib_or_die);
+
+sub find_lib_or_die
+{
+ my %args = @_;
+
+ my $libname = $args{lib} or die "find_lib_or_die: 'lib' argument required";
+ my $libpath = $args{libpath} // [];
+ my $systempath = $args{systempath};
+
+ my @search_paths = @$libpath;
+
+ # Add system paths unless explicitly disabled
+ unless (defined $systempath && ref($systempath) eq 'ARRAY' && @$systempath == 0)
+ {
+ push @search_paths, _get_system_lib_paths();
+ }
+
+ # Determine library file patterns based on OS
+ my @patterns = _get_lib_patterns($libname);
+
+ for my $dir (@search_paths)
+ {
+ next unless -d $dir;
+
+ for my $pattern (@patterns)
+ {
+ my @matches = glob(File::Spec->catfile($dir, $pattern));
+ for my $match (@matches)
+ {
+ return $match if -f $match && -r $match;
+ }
+ }
+ }
+
+ die "find_lib_or_die: unable to find lib$libname in: " . join(", ", @search_paths);
+}
+
+sub _get_lib_patterns
+{
+ my $libname = shift;
+
+ if ($^O eq 'darwin')
+ {
+ return ("lib$libname.dylib", "lib$libname.*.dylib");
+ }
+ elsif ($^O eq 'MSWin32' || $^O eq 'cygwin')
+ {
+ return ("$libname.dll", "lib$libname.dll");
+ }
+ else
+ {
+ # Linux and other Unix-like systems
+ return ("lib$libname.so", "lib$libname.so.*");
+ }
+}
+
+sub _get_system_lib_paths
+{
+ my @paths;
+
+ # Common system library paths
+ push @paths, '/usr/lib', '/usr/local/lib', '/lib';
+
+ # Add architecture-specific paths on Linux
+ if ($^O eq 'linux')
+ {
+ push @paths, '/usr/lib/x86_64-linux-gnu', '/usr/lib/aarch64-linux-gnu';
+ push @paths, '/usr/lib64', '/lib64';
+ }
+
+ # Add paths from LD_LIBRARY_PATH
+ if ($ENV{LD_LIBRARY_PATH})
+ {
+ push @paths, split(/:/, $ENV{LD_LIBRARY_PATH});
+ }
+
+ # macOS specific
+ if ($^O eq 'darwin')
+ {
+ push @paths, '/opt/homebrew/lib', '/usr/local/opt/libpq/lib';
+ if ($ENV{DYLD_LIBRARY_PATH})
+ {
+ push @paths, split(/:/, $ENV{DYLD_LIBRARY_PATH});
+ }
+ }
+
+ return @paths;
+}
+
+=pod
+
+=head1 SEE ALSO
+
+L
+
+=cut
+
+1;
diff --git a/src/test/perl/PostgreSQL/PGTypes.pm b/src/test/perl/PostgreSQL/PGTypes.pm
new file mode 100644
index 0000000000..2bc007c323
--- /dev/null
+++ b/src/test/perl/PostgreSQL/PGTypes.pm
@@ -0,0 +1,356 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::PGTypes - PostgreSQL backend type OID constants
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::PGTypes;
+
+ if ($type_oid == TEXTOID) { ... }
+
+ if ($type_oid == INT4ARRAYOID) { ... }
+
+=head1 DESCRIPTION
+
+This module provides constants for PostgreSQL backend type OIDs, as defined
+in C. These can be used to identify column
+types in query results via C.
+
+All constants are exported by default.
+
+=head1 EXPORTED CONSTANTS
+
+=head2 Basic Types
+
+C, C, C, C, C, C,
+C, C, C, C, C, C,
+C, C, C, C, C, C,
+C, C, C, C, C, C,
+C, C, C, C, C,
+C, C, C, C, C,
+C, C, C, C, C,
+C, C, C, C, C,
+C, C, C, C, C,
+C, C, C
+
+=head2 Range Types
+
+C, C, C, C,
+C, C
+
+=head2 Multirange Types
+
+C, C, C,
+C, C, C
+
+=head2 Pseudo Types
+
+C, C, C, C, C,
+C
+
+=head2 Array Types
+
+Array type OIDs follow the pattern C<{BASENAME}ARRAYOID>, e.g., C,
+C, C.
+
+=cut
+
+package PostgreSQL::PGTypes;
+
+use strict;
+use warnings FATAL => qw(all);
+
+use Exporter qw(import);
+
+our @EXPORT = qw(
+
+ BOOLOID
+ BYTEAOID
+ CHAROID
+ NAMEOID
+ INT8OID
+ INT2OID
+ INT2VECTOROID
+ INT4OID
+ TEXTOID
+ OIDOID
+ TIDOID
+ XIDOID
+ CIDOID
+ OIDVECTOROID
+ JSONOID
+ XMLOID
+ XID8OID
+ POINTOID
+ LSEGOID
+ PATHOID
+ BOXOID
+ POLYGONOID
+ LINEOID
+ FLOAT4OID
+ FLOAT8OID
+ UNKNOWNOID
+ CIRCLEOID
+ MONEYOID
+ MACADDROID
+ INETOID
+ CIDROID
+ MACADDR8OID
+ ACLITEMOID
+ BPCHAROID
+ VARCHAROID
+ DATEOID
+ TIMEOID
+ TIMESTAMPOID
+ TIMESTAMPTZOID
+ INTERVALOID
+ TIMETZOID
+ BITOID
+ VARBITOID
+ NUMERICOID
+ REFCURSOROID
+ UUIDOID
+ TSVECTOROID
+ GTSVECTOROID
+ TSQUERYOID
+ JSONBOID
+ JSONPATHOID
+ TXID_SNAPSHOTOID
+ INT4RANGEOID
+ NUMRANGEOID
+ TSRANGEOID
+ TSTZRANGEOID
+ DATERANGEOID
+ INT8RANGEOID
+ INT4MULTIRANGEOID
+ NUMMULTIRANGEOID
+ TSMULTIRANGEOID
+ TSTZMULTIRANGEOID
+ DATEMULTIRANGEOID
+ INT8MULTIRANGEOID
+ RECORDOID
+ RECORDARRAYOID
+ CSTRINGOID
+ VOIDOID
+ TRIGGEROID
+ EVENT_TRIGGEROID
+
+ BOOLARRAYOID
+ BYTEAARRAYOID
+ CHARARRAYOID
+ NAMEARRAYOID
+ INT8ARRAYOID
+ INT2ARRAYOID
+ INT2VECTORARRAYOID
+ INT4ARRAYOID
+ TEXTARRAYOID
+ OIDARRAYOID
+ TIDARRAYOID
+ XIDARRAYOID
+ CIDARRAYOID
+ OIDVECTORARRAYOID
+ JSONARRAYOID
+ XMLARRAYOID
+ XID8ARRAYOID
+ POINTARRAYOID
+ LSEGARRAYOID
+ PATHARRAYOID
+ BOXARRAYOID
+ POLYGONARRAYOID
+ LINEARRAYOID
+ FLOAT4ARRAYOID
+ FLOAT8ARRAYOID
+ CIRCLEARRAYOID
+ MONEYARRAYOID
+ MACADDRARRAYOID
+ INETARRAYOID
+ CIDRARRAYOID
+ MACADDR8ARRAYOID
+ ACLITEMARRAYOID
+ BPCHARARRAYOID
+ VARCHARARRAYOID
+ DATEARRAYOID
+ TIMEARRAYOID
+ TIMESTAMPARRAYOID
+ TIMESTAMPTZARRAYOID
+ INTERVALARRAYOID
+ TIMETZARRAYOID
+ BITARRAYOID
+ VARBITARRAYOID
+ NUMERICARRAYOID
+ REFCURSORARRAYOID
+ UUIDARRAYOID
+ TSVECTORARRAYOID
+ GTSVECTORARRAYOID
+ TSQUERYARRAYOID
+ JSONBARRAYOID
+ JSONPATHARRAYOID
+ TXID_SNAPSHOTARRAYOID
+ INT4RANGEARRAYOID
+ NUMRANGEARRAYOID
+ TSRANGEARRAYOID
+ TSTZRANGEARRAYOID
+ DATERANGEARRAYOID
+ INT8RANGEARRAYOID
+ INT4MULTIRANGEARRAYOID
+ NUMMULTIRANGEARRAYOID
+ TSMULTIRANGEARRAYOID
+ TSTZMULTIRANGEARRAYOID
+ DATEMULTIRANGEARRAYOID
+ INT8MULTIRANGEARRAYOID
+ CSTRINGARRAYOID
+
+);
+
+use constant {
+ BOOLOID => 16,
+ BYTEAOID => 17,
+ CHAROID => 18,
+ NAMEOID => 19,
+ INT8OID => 20,
+ INT2OID => 21,
+ INT2VECTOROID => 22,
+ INT4OID => 23,
+ TEXTOID => 25,
+ OIDOID => 26,
+ TIDOID => 27,
+ XIDOID => 28,
+ CIDOID => 29,
+ OIDVECTOROID => 30,
+ JSONOID => 114,
+ XMLOID => 142,
+ XID8OID => 5069,
+ POINTOID => 600,
+ LSEGOID => 601,
+ PATHOID => 602,
+ BOXOID => 603,
+ POLYGONOID => 604,
+ LINEOID => 628,
+ FLOAT4OID => 700,
+ FLOAT8OID => 701,
+ UNKNOWNOID => 705,
+ CIRCLEOID => 718,
+ MONEYOID => 790,
+ MACADDROID => 829,
+ INETOID => 869,
+ CIDROID => 650,
+ MACADDR8OID => 774,
+ ACLITEMOID => 1033,
+ BPCHAROID => 1042,
+ VARCHAROID => 1043,
+ DATEOID => 1082,
+ TIMEOID => 1083,
+ TIMESTAMPOID => 1114,
+ TIMESTAMPTZOID => 1184,
+ INTERVALOID => 1186,
+ TIMETZOID => 1266,
+ BITOID => 1560,
+ VARBITOID => 1562,
+ NUMERICOID => 1700,
+ REFCURSOROID => 1790,
+ UUIDOID => 2950,
+ TSVECTOROID => 3614,
+ GTSVECTOROID => 3642,
+ TSQUERYOID => 3615,
+ JSONBOID => 3802,
+ JSONPATHOID => 4072,
+ TXID_SNAPSHOTOID => 2970,
+ INT4RANGEOID => 3904,
+ NUMRANGEOID => 3906,
+ TSRANGEOID => 3908,
+ TSTZRANGEOID => 3910,
+ DATERANGEOID => 3912,
+ INT8RANGEOID => 3926,
+ INT4MULTIRANGEOID => 4451,
+ NUMMULTIRANGEOID => 4532,
+ TSMULTIRANGEOID => 4533,
+ TSTZMULTIRANGEOID => 4534,
+ DATEMULTIRANGEOID => 4535,
+ INT8MULTIRANGEOID => 4536,
+ RECORDOID => 2249,
+ RECORDARRAYOID => 2287,
+ CSTRINGOID => 2275,
+ VOIDOID => 2278,
+ TRIGGEROID => 2279,
+ EVENT_TRIGGEROID => 3838,
+
+ BOOLARRAYOID => 1000,
+ BYTEAARRAYOID => 1001,
+ CHARARRAYOID => 1002,
+ NAMEARRAYOID => 1003,
+ INT8ARRAYOID => 1016,
+ INT2ARRAYOID => 1005,
+ INT2VECTORARRAYOID => 1006,
+ INT4ARRAYOID => 1007,
+ TEXTARRAYOID => 1009,
+ OIDARRAYOID => 1028,
+ TIDARRAYOID => 1010,
+ XIDARRAYOID => 1011,
+ CIDARRAYOID => 1012,
+ OIDVECTORARRAYOID => 1013,
+ JSONARRAYOID => 199,
+ XMLARRAYOID => 143,
+ XID8ARRAYOID => 271,
+ POINTARRAYOID => 1017,
+ LSEGARRAYOID => 1018,
+ PATHARRAYOID => 1019,
+ BOXARRAYOID => 1020,
+ POLYGONARRAYOID => 1027,
+ LINEARRAYOID => 629,
+ FLOAT4ARRAYOID => 1021,
+ FLOAT8ARRAYOID => 1022,
+ CIRCLEARRAYOID => 719,
+ MONEYARRAYOID => 791,
+ MACADDRARRAYOID => 1040,
+ INETARRAYOID => 1041,
+ CIDRARRAYOID => 651,
+ MACADDR8ARRAYOID => 775,
+ ACLITEMARRAYOID => 1034,
+ BPCHARARRAYOID => 1014,
+ VARCHARARRAYOID => 1015,
+ DATEARRAYOID => 1182,
+ TIMEARRAYOID => 1183,
+ TIMESTAMPARRAYOID => 1115,
+ TIMESTAMPTZARRAYOID => 1185,
+ INTERVALARRAYOID => 1187,
+ TIMETZARRAYOID => 1270,
+ BITARRAYOID => 1561,
+ VARBITARRAYOID => 1563,
+ NUMERICARRAYOID => 1231,
+ REFCURSORARRAYOID => 2201,
+ UUIDARRAYOID => 2951,
+ TSVECTORARRAYOID => 3643,
+ GTSVECTORARRAYOID => 3644,
+ TSQUERYARRAYOID => 3645,
+ JSONBARRAYOID => 3807,
+ JSONPATHARRAYOID => 4073,
+ TXID_SNAPSHOTARRAYOID => 2949,
+ INT4RANGEARRAYOID => 3905,
+ NUMRANGEARRAYOID => 3907,
+ TSRANGEARRAYOID => 3909,
+ TSTZRANGEARRAYOID => 3911,
+ DATERANGEARRAYOID => 3913,
+ INT8RANGEARRAYOID => 3927,
+ INT4MULTIRANGEARRAYOID => 6150,
+ NUMMULTIRANGEARRAYOID => 6151,
+ TSMULTIRANGEARRAYOID => 6152,
+ TSTZMULTIRANGEARRAYOID => 6153,
+ DATEMULTIRANGEARRAYOID => 6155,
+ INT8MULTIRANGEARRAYOID => 6157,
+ CSTRINGARRAYOID => 1263,
+};
+
+=pod
+
+=head1 SEE ALSO
+
+L, L
+
+=cut
+
+1;
diff --git a/src/test/perl/PostgreSQL/PqConstants.pm b/src/test/perl/PostgreSQL/PqConstants.pm
new file mode 100644
index 0000000000..f81913b580
--- /dev/null
+++ b/src/test/perl/PostgreSQL/PqConstants.pm
@@ -0,0 +1,185 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::PqConstants - libpq constants for PostgreSQL TAP tests
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::PqConstants;
+
+ if (PQstatus($conn) == CONNECTION_OK) { ... }
+
+ if (PQresultStatus($result) == PGRES_TUPLES_OK) { ... }
+
+=head1 DESCRIPTION
+
+This module provides libpq constants used by the FFI backend
+(C). All constants are exported by default.
+
+=head1 EXPORTED CONSTANTS
+
+=head2 Connection Status (ConnStatusType)
+
+C, C, C,
+C, C, C,
+C, C, C,
+C, C, C,
+C, C, C
+
+=head2 Execution Status (ExecStatusType)
+
+C, C, C,
+C, C, C,
+C, C, C,
+C, C, C,
+C
+
+=head2 Polling Status (PostgresPollingStatusType)
+
+C, C, C,
+C, C
+
+=head2 Ping Status (PGPing)
+
+C, C, C, C
+
+=head2 Transaction Status (PGTransactionStatusType)
+
+C, C, C, C,
+C
+
+=cut
+
+package PostgreSQL::PqConstants;
+
+use strict;
+use warnings FATAL => qw(all);
+
+use Exporter qw(import);
+
+our @EXPORT = qw(
+
+ CONNECTION_OK
+ CONNECTION_BAD
+ CONNECTION_STARTED
+ CONNECTION_MADE
+ CONNECTION_AWAITING_RESPONSE
+ CONNECTION_AUTH_OK
+ CONNECTION_SETENV
+ CONNECTION_SSL_STARTUP
+ CONNECTION_NEEDED
+ CONNECTION_CHECK_WRITABLE
+ CONNECTION_CONSUME
+ CONNECTION_GSS_STARTUP
+ CONNECTION_CHECK_TARGET
+ CONNECTION_CHECK_STANDBY
+ CONNECTION_ALLOCATED
+
+ PGRES_EMPTY_QUERY
+ PGRES_COMMAND_OK
+ PGRES_TUPLES_OK
+ PGRES_COPY_OUT
+ PGRES_COPY_IN
+ PGRES_BAD_RESPONSE
+ PGRES_NONFATAL_ERROR
+ PGRES_FATAL_ERROR
+ PGRES_COPY_BOTH
+ PGRES_SINGLE_TUPLE
+ PGRES_PIPELINE_SYNC
+ PGRES_PIPELINE_ABORTED
+ PGRES_TUPLES_CHUNK
+
+ PGRES_POLLING_FAILED
+ PGRES_POLLING_READING
+ PGRES_POLLING_WRITING
+ PGRES_POLLING_OK
+ PGRES_POLLING_ACTIVE
+
+ PQPING_OK
+ PQPING_REJECT
+ PQPING_NO_RESPONSE
+ PQPING_NO_ATTEMPT
+
+ PQTRANS_IDLE
+ PQTRANS_ACTIVE
+ PQTRANS_INTRANS
+ PQTRANS_INERROR
+ PQTRANS_UNKNOWN
+
+);
+
+# ConnStatusType:
+use constant {
+ CONNECTION_OK => 0,
+ CONNECTION_BAD => 1,
+ CONNECTION_STARTED => 2,
+ CONNECTION_MADE => 3,
+ CONNECTION_AWAITING_RESPONSE => 4,
+ CONNECTION_AUTH_OK => 5,
+ CONNECTION_SETENV => 6,
+ CONNECTION_SSL_STARTUP => 7,
+ CONNECTION_NEEDED => 8,
+ CONNECTION_CHECK_WRITABLE => 9,
+ CONNECTION_CONSUME => 10,
+ CONNECTION_GSS_STARTUP => 11,
+ CONNECTION_CHECK_TARGET => 12,
+ CONNECTION_CHECK_STANDBY => 13,
+ CONNECTION_ALLOCATED => 14,
+};
+
+# ExecStatusType:
+use constant {
+ PGRES_EMPTY_QUERY => 0,
+ PGRES_COMMAND_OK => 1,
+ PGRES_TUPLES_OK => 2,
+ PGRES_COPY_OUT => 3,
+ PGRES_COPY_IN => 4,
+ PGRES_BAD_RESPONSE => 5,
+ PGRES_NONFATAL_ERROR => 6,
+ PGRES_FATAL_ERROR => 7,
+ PGRES_COPY_BOTH => 8,
+ PGRES_SINGLE_TUPLE => 9,
+ PGRES_PIPELINE_SYNC => 10,
+ PGRES_PIPELINE_ABORTED => 11,
+ PGRES_TUPLES_CHUNK => 12,
+};
+
+# PostgresPollingStatusType:
+use constant {
+ PGRES_POLLING_FAILED => 0,
+ PGRES_POLLING_READING => 1,
+ PGRES_POLLING_WRITING => 2,
+ PGRES_POLLING_OK => 3,
+ PGRES_POLLING_ACTIVE => 4,
+};
+
+# PGPing:
+use constant {
+ PQPING_OK => 0,
+ PQPING_REJECT => 1,
+ PQPING_NO_RESPONSE => 2,
+ PQPING_NO_ATTEMPT => 3,
+};
+
+# PGTransactionStatusType:
+use constant {
+ PQTRANS_IDLE => 0,
+ PQTRANS_ACTIVE => 1,
+ PQTRANS_INTRANS => 2,
+ PQTRANS_INERROR => 3,
+ PQTRANS_UNKNOWN => 4,
+};
+
+=pod
+
+=head1 SEE ALSO
+
+L, L
+
+=cut
+
+1;
diff --git a/src/test/perl/PostgreSQL/PqFFI.pm b/src/test/perl/PostgreSQL/PqFFI.pm
new file mode 100644
index 0000000000..7c2efe011a
--- /dev/null
+++ b/src/test/perl/PostgreSQL/PqFFI.pm
@@ -0,0 +1,454 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::PqFFI - FFI wrapper for libpq
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::PqFFI;
+
+ # Initialize the FFI bindings (required before use)
+ PostgreSQL::PqFFI::setup($libdir);
+
+ # Connect to database
+ my $conn = PQconnectdb("dbname=postgres");
+ die PQerrorMessage($conn) unless PQstatus($conn) == CONNECTION_OK;
+
+ # Execute query
+ my $result = PQexec($conn, "SELECT 1");
+ if (PQresultStatus($result) == PGRES_TUPLES_OK) {
+ print PQgetvalue($result, 0, 0), "\n";
+ }
+ PQclear($result);
+
+ PQfinish($conn);
+
+=head1 DESCRIPTION
+
+This module provides Perl bindings to libpq using L.
+It is the backend used by L.
+
+The module must be initialized by calling C before any libpq
+functions can be used.
+
+=head1 FUNCTIONS
+
+=head2 setup($libdir [, $use_system_path])
+
+Initialize the FFI bindings. C<$libdir> specifies where to find libpq.
+If C<$use_system_path> is false, only C<$libdir> is searched.
+
+=head2 libpq Functions
+
+All standard libpq functions are exported. See the PostgreSQL libpq
+documentation for details. Commonly used functions include:
+
+B C, C, C,
+C, C, C
+
+B C, C, C, C,
+C, C, C
+
+B C, C, C, C,
+C, C, C
+
+B C, C,
+C, C
+
+B C, C, C,
+C, C
+
+B C, C
+
+=head2 create_notice_processor($callback)
+
+Creates a notice processor closure that can be passed to
+C. The callback receives C<($arg, $message)>.
+The caller must keep a reference to the returned closure to prevent
+garbage collection.
+
+=head1 EXPORTED CONSTANTS
+
+This module re-exports all constants from L
+and L.
+
+=cut
+
+package PostgreSQL::PqFFI;
+
+use strict;
+use warnings FATAL => qw(all);
+
+use FFI::Platypus;
+use FFI::Platypus::Record;
+use PostgreSQL::FindLib;
+
+# PGnotify struct for notification support
+# typedef struct pgNotify {
+# char *relname; /* notification channel name */
+# int be_pid; /* process ID of notifying server process */
+# char *extra; /* notification payload string */
+# } PGnotify;
+package PGnotify {
+ use FFI::Platypus::Record;
+ record_layout_1(
+ 'opaque' => 'relname',
+ 'sint32' => 'be_pid',
+ 'opaque' => 'extra',
+ );
+}
+package PostgreSQL::PqFFI;
+
+# FFI::Platypus::Record keeps the record's Record::Meta object alive in a
+# package-glob closure, so it is not destroyed until global destruction.
+# Record::Meta's DESTROY is an FFI-attached function taking a custom type
+# whose marshalling is a Perl closure; during global destruction that
+# closure may already have been freed, making DESTROY die with "Can't use
+# an undefined value as a subroutine reference" (seen with FFI::Platypus
+# 2.08). The process is exiting anyway, so skip the destructor then and
+# let the OS reclaim the memory.
+{
+ my $orig_destroy = \&FFI::Platypus::Record::Meta::DESTROY;
+ no warnings 'redefine';
+ *FFI::Platypus::Record::Meta::DESTROY = sub {
+ return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
+ goto &$orig_destroy;
+ };
+}
+use PostgreSQL::PqConstants;
+use PostgreSQL::PGTypes;
+
+use Exporter qw(import);
+
+our @EXPORT = (
+ @PostgreSQL::PqConstants::EXPORT,
+ @PostgreSQL::PGTypes::EXPORT,
+);
+
+
+
+my @procs = qw(
+
+ PQnotifies
+ PQfreemem
+ PQnotify_channel
+ PQnotify_payload
+ PQnotify_be_pid
+ PQnotify_free
+
+ PQconnectdb
+ PQconnectdbParams
+ PQsetdbLogin
+ PQfinish
+ PQreset
+ PQdb
+ PQuser
+ PQpass
+ PQhost
+ PQhostaddr
+ PQport
+ PQtty
+ PQoptions
+ PQstatus
+ PQtransactionStatus
+ PQparameterStatus
+ PQping
+ PQpingParams
+
+ PQexec
+ PQexecParams
+ PQprepare
+ PQexecPrepared
+
+ PQdescribePrepared
+ PQdescribePortal
+
+ PQclosePrepared
+ PQclosePortal
+ PQclear
+
+ PQsendQuery
+ PQgetResult
+ PQisBusy
+ PQconsumeInput
+
+ PQprotocolVersion
+ PQserverVersion
+ PQerrorMessage
+ PQsocket
+ PQsocketPoll
+ PQgetCurrentTimeUSec
+ PQbackendPID
+ PQconnectionNeedsPassword
+ PQconnectionUsedPassword
+ PQconnectionUsedGSSAPI
+ PQclientEncoding
+ PQsetClientEncoding
+
+ PQresultStatus
+ PQresStatus
+ PQresultErrorMessage
+ PQresultErrorField
+ PQntuples
+ PQnfields
+ PQbinaryTuples
+ PQfname
+ PQfnumber
+ PQftable
+ PQftablecol
+ PQfformat
+ PQftype
+ PQfsize
+ PQfmod
+ PQcmdStatus
+ PQoidValue
+ PQcmdTuples
+ PQgetvalue
+ PQgetlength
+ PQgetisnull
+ PQnparams
+ PQparamtype
+ PQchangePassword
+
+ PQpipelineStatus
+ PQenterPipelineMode
+ PQexitPipelineMode
+ PQpipelineSync
+ PQsendFlushRequest
+ PQsendPipelineSync
+ PQsendQueryParams
+
+ PQsetnonblocking
+ PQisnonblocking
+ PQflush
+
+ PQconnectStart
+ PQconnectStartParams
+ PQconnectPoll
+
+ PQsetNoticeProcessor
+ create_notice_processor
+
+);
+
+push(@EXPORT, @procs);
+
+sub setup
+{
+ my $libdir = shift;
+ my $use_system_path = shift;
+
+ my $ffi = FFI::Platypus->new(api => 1);
+
+ my @system_path;
+ @system_path = (systempath => []) unless $use_system_path;
+
+ $ffi->type('opaque' => 'PGconn');
+ $ffi->type('opaque' => 'PGresult');
+ $ffi->type('uint32' => 'Oid');
+ $ffi->type('int' => 'ExecStatusType');
+
+ # Register the PGnotify record type for struct access
+ $ffi->type('record(PGnotify)' => 'PGnotify_record');
+
+ my $lib = find_lib_or_die(
+ lib => 'pq',
+ libpath => [$libdir],
+ @system_path,
+ );
+ $ffi->lib($lib);
+
+ $ffi->attach('PQconnectdb' => ['string'] => 'PGconn');
+ $ffi->attach(
+ 'PQconnectdbParams' => [ 'string[]', 'string[]', 'int' ] => 'PGconn');
+ $ffi->attach(
+ 'PQsetdbLogin' => [
+ 'string', 'string', 'string', 'string',
+ 'string', 'string', 'string',
+ ] => 'PGconn');
+ $ffi->attach('PQfinish' => ['PGconn'] => 'void');
+ $ffi->attach('PQreset' => ['PGconn'] => 'void');
+ $ffi->attach('PQdb' => ['PGconn'] => 'string');
+ $ffi->attach('PQuser' => ['PGconn'] => 'string');
+ $ffi->attach('PQpass' => ['PGconn'] => 'string');
+ $ffi->attach('PQhost' => ['PGconn'] => 'string');
+ $ffi->attach('PQhostaddr' => ['PGconn'] => 'string');
+ $ffi->attach('PQport' => ['PGconn'] => 'string');
+ $ffi->attach('PQtty' => ['PGconn'] => 'string');
+ $ffi->attach('PQoptions' => ['PGconn'] => 'string');
+ $ffi->attach('PQstatus' => ['PGconn'] => 'int');
+ $ffi->attach('PQtransactionStatus' => ['PGconn'] => 'int');
+ $ffi->attach('PQparameterStatus' => [ 'PGconn', 'string' ] => 'string');
+ $ffi->attach('PQping' => ['string'] => 'int');
+ $ffi->attach(
+ 'PQpingParams' => [ 'string[]', 'string[]', 'int' ] => 'int');
+
+ $ffi->attach('PQprotocolVersion' => ['PGconn'] => 'int');
+ $ffi->attach('PQserverVersion' => ['PGconn'] => 'int');
+ $ffi->attach('PQerrorMessage' => ['PGconn'] => 'string');
+ $ffi->attach('PQsocket' => ['PGconn'] => 'int');
+ $ffi->attach('PQsocketPoll' => ['int', 'int', 'int', 'sint64'] => 'int');
+ $ffi->attach('PQgetCurrentTimeUSec' => [] => 'sint64');
+ $ffi->attach('PQbackendPID' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionNeedsPassword' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionUsedPassword' => ['PGconn'] => 'int');
+ $ffi->attach('PQconnectionUsedGSSAPI' => ['PGconn'] => 'int');
+ $ffi->attach('PQclientEncoding' => ['PGconn'] => 'int');
+ $ffi->attach('PQsetClientEncoding' => [ 'PGconn', 'string' ] => 'int');
+
+ $ffi->attach('PQexec' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach(
+ 'PQexecParams' => [
+ 'PGconn', 'string', 'int', 'int[]',
+ 'string[]', 'int[]', 'int[]', 'int'
+ ] => 'PGresult');
+ $ffi->attach(
+ 'PQprepare' => [ 'PGconn', 'string', 'string', 'int', 'int[]' ] =>
+ 'PGresult');
+ $ffi->attach(
+ 'PQexecPrepared' => [ 'PGconn', 'string', 'int',
+ 'string[]', 'int[]', 'int[]', 'int' ] => 'PGresult');
+
+ $ffi->attach('PQresultStatus' => ['PGresult'] => 'ExecStatusType');
+ $ffi->attach('PQresStatus' => ['ExecStatusType'] => 'string');
+ $ffi->attach('PQresultErrorMessage' => ['PGresult'] => 'string');
+ $ffi->attach('PQresultErrorField' => [ 'PGresult', 'int' ] => 'string');
+ $ffi->attach('PQntuples' => ['PGresult'] => 'int');
+ $ffi->attach('PQnfields' => ['PGresult'] => 'int');
+ $ffi->attach('PQbinaryTuples' => ['PGresult'] => 'int');
+ $ffi->attach('PQfname' => [ 'PGresult', 'int' ] => 'string');
+ $ffi->attach('PQfnumber' => [ 'PGresult', 'string' ] => 'int');
+ $ffi->attach('PQftable' => [ 'PGresult', 'int' ] => 'Oid');
+ $ffi->attach('PQftablecol' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQfformat' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQftype' => [ 'PGresult', 'int' ] => 'Oid');
+ $ffi->attach('PQfsize' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQfmod' => [ 'PGresult', 'int' ] => 'int');
+ $ffi->attach('PQcmdStatus' => ['PGresult'] => 'string');
+ $ffi->attach('PQoidValue' => ['PGresult'] => 'Oid');
+ $ffi->attach('PQcmdTuples' => ['PGresult'] => 'string');
+ $ffi->attach('PQgetvalue' => [ 'PGresult', 'int', 'int' ] => 'string');
+ $ffi->attach('PQgetlength' => [ 'PGresult', 'int', 'int' ] => 'int');
+ $ffi->attach('PQgetisnull' => [ 'PGresult', 'int', 'int' ] => 'int');
+ $ffi->attach('PQnparams' => ['PGresult'] => 'int');
+ $ffi->attach('PQparamtype' => [ 'PGresult', 'int' ] => 'Oid');
+
+
+ $ffi->attach(
+ 'PQdescribePrepared' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQdescribePortal' => [ 'PGconn', 'string' ] => 'PGresult');
+
+ $ffi->attach('PQclosePrepared' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQclosePortal' => [ 'PGconn', 'string' ] => 'PGresult');
+ $ffi->attach('PQclear' => ['PGresult'] => 'void');
+
+ $ffi->attach('PQconnectStart' => [ 'string' ] => 'PGconn');
+ $ffi->attach(
+ 'PQconnectStartParams' => [ 'string[]', 'string[]', 'int' ] => 'PGconn');
+ $ffi->attach('PQconnectPoll' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQresetStart' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQresetPoll' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQsendQuery' => [ 'PGconn', 'string' ] => 'int');
+ $ffi->attach('PQsendQueryParams' => [
+ 'PGconn', 'string', 'int', 'Oid*', 'string*',
+ 'int*', 'int*', 'int' ] => 'int');
+ $ffi->attach('PQsendPrepare' => [ 'PGconn', 'string', 'string', 'int', 'Oid[]' ] => 'int');
+ $ffi->attach('PQgetResult' => [ 'PGconn' ] => 'PGresult');
+
+ $ffi->attach('PQisBusy' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQconsumeInput' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQchangePassword' => [ 'PGconn', 'string', 'string' ] => 'PGresult');
+
+ $ffi->attach('PQpipelineStatus' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQenterPipelineMode' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQexitPipelineMode' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQpipelineSync' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQsendFlushRequest' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQsendPipelineSync' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQsetnonblocking' => [ 'PGconn', 'int' ] => 'int');
+ $ffi->attach('PQisnonblocking' => [ 'PGconn' ] => 'int');
+ $ffi->attach('PQflush' => [ 'PGconn' ] => 'int');
+
+ # Notification support - PQnotifies returns a pointer to PGnotify struct
+ # We return opaque to preserve the original pointer for freeing with PQfreemem
+ $ffi->attach('PQnotifies' => [ 'PGconn' ] => 'opaque');
+ $ffi->attach('PQfreemem' => [ 'opaque' ] => 'void');
+
+ # Notice processor callback support
+ # typedef void (*PQnoticeProcessor)(void *arg, const char *message);
+ $ffi->type('(opaque,string)->void' => 'PQnoticeProcessor');
+ $ffi->attach('PQsetNoticeProcessor' => [ 'PGconn', 'PQnoticeProcessor', 'opaque' ] => 'opaque');
+
+ # Store the $ffi instance for use by helper functions
+ $PostgreSQL::PqFFI::_ffi = $ffi;
+}
+
+# Helper functions to extract values from PGnotify struct
+# The opaque pointer is cast to the record type to access fields
+
+sub _cast_to_pgnotify
+{
+ my $ptr = shift;
+ return undef unless $ptr;
+ return $PostgreSQL::PqFFI::_ffi->cast('opaque', 'record(PGnotify)*', $ptr);
+}
+
+sub PQnotify_channel
+{
+ my $ptr = shift;
+ return undef unless $ptr;
+ my $notify = _cast_to_pgnotify($ptr);
+ my $str_ptr = $notify->relname;
+ return undef unless $str_ptr;
+ return $PostgreSQL::PqFFI::_ffi->cast('opaque', 'string', $str_ptr);
+}
+
+sub PQnotify_payload
+{
+ my $ptr = shift;
+ return undef unless $ptr;
+ my $notify = _cast_to_pgnotify($ptr);
+ my $str_ptr = $notify->extra;
+ return undef unless $str_ptr;
+ return $PostgreSQL::PqFFI::_ffi->cast('opaque', 'string', $str_ptr);
+}
+
+sub PQnotify_be_pid
+{
+ my $ptr = shift;
+ return undef unless $ptr;
+ my $notify = _cast_to_pgnotify($ptr);
+ return $notify->be_pid;
+}
+
+# Free a PGnotify struct using the original pointer
+sub PQnotify_free
+{
+ my $ptr = shift;
+ return unless $ptr;
+ PQfreemem($ptr);
+}
+
+# Create a notice processor closure that can be passed to PQsetNoticeProcessor.
+# The callback will be invoked with (arg, message) where arg is opaque and message is string.
+# Returns the closure - caller must keep a reference to prevent garbage collection.
+sub create_notice_processor
+{
+ my $callback = shift; # sub { my ($arg, $message) = @_; ... }
+ return $PostgreSQL::PqFFI::_ffi->closure($callback);
+}
+
+=pod
+
+=head1 SEE ALSO
+
+L,
+L, L, L
+
+=cut
+
+1;
diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 529f49efee..93005db4f0 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);
@@ -2070,20 +2071,51 @@ 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);
+ # For now only use a Session object for single statement sql without any
+ # special params. Also fall back to psql when PGOPTIONS is set: it injects
+ # connection-time GUCs that the caller is relying on (e.g. compute_query_id
+ # for auto_explain), and a libpq loaded via FFI does not reliably see a
+ # PGOPTIONS that was set in %ENV at run time on Windows (separate C runtime
+ # from perl), whereas a spawned psql inherits it.
+ if ( $sql =~ /\w/
+ && $sql !~ /\\bind|;.*\w/s
+ && !scalar(keys(%params))
+ && !$ENV{PGOPTIONS})
+ {
+
+ my $session = PostgreSQL::Test::Session->new(node=> $self,
+ dbname => $dbname);
+ defined $session
+ or die "connection failure: "
+ . ($PostgreSQL::Test::Session::connect_error // '')
+ . "while running '$sql'";
+ 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
- # psql can emit stderr from NOTICEs etc
- if ($stderr ne "")
+ }
+ else
{
- print "#### Begin standard error\n";
- print $stderr;
- print "\n#### End standard error\n";
+ # 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;
@@ -2187,6 +2219,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};
@@ -2760,33 +2795,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);
@@ -2801,9 +2823,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/Session.pm b/src/test/perl/PostgreSQL/Test/Session.pm
new file mode 100644
index 0000000000..36263842c5
--- /dev/null
+++ b/src/test/perl/PostgreSQL/Test/Session.pm
@@ -0,0 +1,1107 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+=pod
+
+=head1 NAME
+
+PostgreSQL::Test::Session - class for a PostgreSQL libpq session
+
+=head1 SYNOPSIS
+
+ use PostgreSQL::Test::Session;
+
+ use PostgreSQL::Test::Cluster;
+
+ my $node = PostgreSQL::Test::Cluster->new('mynode');
+
+ # create a new session. defult dbname is 'postgres'
+ my $session = PostgreSQL::Test::Session->new(node => $node
+ [, dbname => $dbname] );
+
+ # close the session
+ $session->close;
+
+ # reopen the session, after closing it if not closed
+ $session->reconnect;
+
+ # check if the session is ok
+ # my $status = $session->conn_status;
+
+ # run some SQL, not producing tuples
+ my $result = $session->do($sql, ...);
+
+ # run an SQL statement asynchronously
+ my $result = $session->do_async($sql);
+
+ # wait for and async SQL to complete
+ $session->wait_for_completion;
+
+ # set a password for a user
+ my $result = $session->set_password($user, $password);
+
+ # get some data
+ my $result = $session->query($sql);
+
+ # get a single value, default croaks if no value found
+ my $val = $session->query_oneval($sql [, $missing_ok ]);
+
+ #return lines of tuples like "psql -A -t"
+ my @lines = $session->query_tuples($sql, ...);
+
+=head1 DESCRIPTION
+
+C encapsulates a C session for use in
+PostgreSQL TAP tests, allowing the test to connect without having to spawn
+C in a child process.
+
+The session object is automatically closed when the object goes out of scope,
+including at script end.
+
+Several methods return a hashref as a result, which will have the following
+fields:
+
+=over
+
+=item * status
+
+=item * error_message (only if there is an error)
+
+=item * names
+
+=item * types
+
+=item * rows
+
+=item * psqlout
+
+=back
+
+The last 4 will be empty unless the SQL produces tuples.
+
+=cut
+
+package PostgreSQL::Test::Session;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Carp;
+
+my $setup_ok;
+
+# Last connection error. new() returns undef on a failed connection (callers
+# such as poll_until_connection() rely on that), which loses the libpq error
+# message; stash it here so callers that treat a failed connection as fatal can
+# report why.
+our $connect_error;
+
+BEGIN
+{
+ # Use the FFI libpq wrapper. This will fail if the FFI libraries are not
+ # available.
+ #
+ # The actual setup is done per session, because we get the libdir from
+ # the node object (in most cases).
+ require PostgreSQL::PqFFI;
+ PostgreSQL::PqFFI->import;
+}
+
+sub _setup
+{
+ return if $setup_ok;
+ my $libdir = shift;
+ PostgreSQL::PqFFI::setup($libdir);
+ $setup_ok = 1;
+}
+
+=pod
+
+=head1 METHODS
+
+=over
+
+=item PostgreSQL::Test::Session->new(node=> $node [, dbname=> $dbname ])
+
+Set up a new session for the node, which must be a C
+instance. The default dbame is C.
+
+=item PostgreSQL::Test::Session->new(connstr => $connstr [, libdir => $libdir])
+
+Set up a new session for the connection string. If using the FFI libpq wrapper,
+C<$libdir> must point to the directory where the libpq library is installed.
+
+=cut
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless $self, $class;
+ my %args = @_;
+ my $node = $args{node};
+ my $dbname = $args{dbname} || 'postgres';
+ my $libdir = $args{libdir};
+ my $connstr = $args{connstr};
+ my $user = $args{user};
+ my $wait = $args{wait} // 1;
+ unless ($setup_ok)
+ {
+ unless ($libdir)
+ {
+ croak "bad node" unless $node->isa("PostgreSQL::Test::Cluster");
+ $libdir = $node->config_data($^O eq 'MSWin32' ? '--bindir' : '--libdir');
+ }
+ _setup($libdir);
+ }
+ unless ($connstr)
+ {
+ croak "bad node" unless $node->isa("PostgreSQL::Test::Cluster");
+ $connstr = $node->connstr($dbname);
+ }
+
+ # Pin the connecting role unless the connection string already names one.
+ # With no "user" in the connection string, libpq falls back to PGUSER (and
+ # only then to the operating-system user). A stray PGUSER in the
+ # environment -- as set on the buildfarm -- would then select a role that
+ # the cluster's authentication setup does not recognize; in particular the
+ # SSPI usermap used on Windows is built around the OS user by
+ # "pg_regress --config-auth", so a PGUSER of e.g. "buildfarm" fails
+ # authentication. Default to the OS user, which is how the rest of the
+ # test framework connects, unless the caller (or the connection string)
+ # requested a specific user.
+ if ($connstr !~ /\buser\s*=/)
+ {
+ $user //= $^O eq 'MSWin32' ? $ENV{USERNAME} : (getpwuid($<))[0];
+ $connstr .= " user='$user'" if defined $user && $user ne '';
+ }
+ $self->{connstr} = $connstr;
+ $self->{notices} = [];
+
+ if ($wait)
+ {
+ $self->{conn} = PQconnectdb($connstr);
+ # The destructor will clean up for us even if we fail
+ unless (PQstatus($self->{conn}) == CONNECTION_OK)
+ {
+ $connect_error = PQerrorMessage($self->{conn});
+ return undef;
+ }
+ $self->_setup_notice_processor();
+ return $self;
+ }
+ else
+ {
+ $self->{conn} = PQconnectStart($connstr);
+ if (PQstatus($self->{conn}) == CONNECTION_BAD)
+ {
+ $connect_error = PQerrorMessage($self->{conn});
+ return undef;
+ }
+ return $self;
+ }
+}
+
+# Set up a notice processor to capture notices/warnings
+sub _setup_notice_processor
+{
+ my $self = shift;
+
+ # Only available with FFI backend
+ return unless defined &create_notice_processor;
+
+ my $notices = $self->{notices};
+
+ # Create closure that captures notices into our array
+ $self->{_notice_closure} = create_notice_processor(sub {
+ my ($arg, $message) = @_;
+ push @$notices, $message;
+ });
+
+ PQsetNoticeProcessor($self->{conn}, $self->{_notice_closure}, undef);
+}
+
+
+# for a connection started with PQconnectStart, wait until it is in CONNECTION_OK state.
+# Uses PQconnectPoll to drive the async connection forward.
+sub wait_connect
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ my $timeout = $PostgreSQL::Test::Utils::timeout_default;
+ my $start = time;
+ while (1)
+ {
+ my $poll_res = PQconnectPoll($conn);
+ my $status = PQstatus($conn);
+
+ # Connection is complete
+ if ($poll_res == PGRES_POLLING_OK || $status == CONNECTION_OK)
+ {
+ $self->_setup_notice_processor();
+ return;
+ }
+
+ # Connection failed
+ if ($poll_res == PGRES_POLLING_FAILED || $status == CONNECTION_BAD)
+ {
+ die "connection failed: " . PQerrorMessage($conn);
+ }
+
+ die "timed out waiting for connection" if time - $start > $timeout;
+
+ # Wait on socket based on what PQconnectPoll needs
+ my $socket = PQsocket($conn);
+ if ($socket >= 0)
+ {
+ my $forRead = ($poll_res == PGRES_POLLING_READING) ? 1 : 0;
+ my $forWrite = ($poll_res == PGRES_POLLING_WRITING) ? 1 : 0;
+ my $end_time = PQgetCurrentTimeUSec() + 1_000_000; # 1 second
+ PQsocketPoll($socket, $forRead, $forWrite, $end_time);
+ }
+ }
+}
+
+# Single step of async connection polling - drives the connection state machine
+# forward without blocking. Returns the poll result (PGRES_POLLING_* constant).
+sub poll_connect
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ return PQconnectPoll($conn);
+}
+
+=pod
+
+=item $session->close()
+
+Close the connection
+
+=cut
+
+sub close
+{
+ my $self = shift;
+ PQfinish($self->{conn});
+ delete $self->{conn};
+}
+
+# Alias for compatibility with BackgroundPsql
+*quit = \&close;
+
+# close the session if the object goes out of scope
+sub DESTROY
+{
+ my $self = shift;
+
+ # During global destruction the FFI::Platypus bindings (and any notice
+ # processor closure registered with libpq) may already have been torn
+ # down in an unpredictable order. Calling PQfinish() then can invoke a
+ # freed notice callback or a freed FFI thunk, dying with "Can't use an
+ # undefined value as a subroutine reference". The process is exiting
+ # anyway, so just let the OS reclaim the socket.
+ return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
+
+ $self->close if exists $self->{conn};
+}
+
+=pod
+
+=item $session->reconnect()
+
+Reopen the session using the original connstr. If the session is still open,
+close it before reopening.
+
+=cut
+
+sub reconnect
+{
+ my $self = shift;
+ $self->close if exists $self->{conn};
+ $self->{conn} = PQconnectdb($self->{connstr});
+ my $status = PQstatus($self->{conn});
+ if ($status == CONNECTION_OK)
+ {
+ $self->_setup_notice_processor();
+ }
+ return $status;
+}
+
+=pod
+
+=item $session->reconnect_and_clear()
+
+Reconnect and clear all captured notices. Returns the connection status.
+
+=cut
+
+sub reconnect_and_clear
+{
+ my $self = shift;
+ my $status = $self->reconnect();
+ $self->clear_notices();
+ return $status;
+}
+
+=pod
+
+=item $session->get_notices()
+
+Return an arrayref of all captured notices/warnings since the last clear.
+
+=cut
+
+sub get_notices
+{
+ my $self = shift;
+ return $self->{notices};
+}
+
+=pod
+
+=item $session->get_notices_str()
+
+Return all captured notices/warnings as a single string (joined by empty string).
+This is similar to how BackgroundPsql's {stderr} field works.
+
+=cut
+
+sub get_notices_str
+{
+ my $self = shift;
+ return join('', @{$self->{notices}});
+}
+
+=pod
+
+=item $session->clear_notices()
+
+Clear all captured notices/warnings.
+
+=cut
+
+sub clear_notices
+{
+ my $self = shift;
+ # Clear in place - don't replace the array, as the notice processor
+ # closure has a reference to it
+ @{$self->{notices}} = ();
+}
+
+=pod
+
+=item $session->get_stderr()
+
+Return a stderr-like string containing all notices plus any error message
+from the last query. This mimics BackgroundPsql's {stderr} behavior.
+
+=cut
+
+sub get_stderr
+{
+ my $self = shift;
+ my $stderr = $self->get_notices_str();
+ if (exists $self->{last_error} && defined $self->{last_error})
+ {
+ $stderr .= $self->{last_error};
+ }
+ return $stderr;
+}
+
+=pod
+
+=item $session->clear_stderr()
+
+Clear notices and last error, like setting $psql->{stderr} = ''.
+
+=cut
+
+sub clear_stderr
+{
+ my $self = shift;
+ $self->clear_notices();
+ delete $self->{last_error};
+}
+
+=pod
+
+=item $session->conn_status()
+
+Return the connection status. This will be a libpq status value like
+C.
+
+=cut
+
+sub conn_status
+{
+ my $self = shift;
+ return exists $self->{conn} ? PQstatus($self->{conn}) : undef;
+}
+
+=pod
+
+=item $session->backend_pid()
+
+Return the backend process ID for this connection.
+
+=cut
+
+sub backend_pid
+{
+ my $self = shift;
+ return PQbackendPID($self->{conn});
+}
+
+=pod
+
+=item $session->do($sql, ...)
+
+Run one or more SQL statements synchronously (using C). The statements
+should not return any tuples. Returns the status, which will be
+C (i.e. 1) in the case of success.
+
+=cut
+
+sub do
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ my $status;
+ foreach my $sql (@_)
+ {
+ my $result = PQexec($conn, $sql);
+ $status = PQresultStatus($result);
+ PQclear($result);
+ return $status unless $status == PGRES_COMMAND_OK;
+ }
+ return $status;
+}
+
+=pod
+
+=item $session->do_async($sql)
+
+Run a single statement asynchronously, using C. The return value
+is a boolean indicating success.
+
+=cut
+
+sub do_async
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ my $sql = shift;
+ my $result = PQsendQuery($conn, $sql);
+ return $result; # 1 or 0
+}
+
+# get the next resultset from some async commands
+# wait if necessary using PQsocketPoll
+# c.f. libpqsrv_get_result
+sub _get_result
+{
+ my $conn = shift;
+ my $socket = PQsocket($conn);
+ while (PQisBusy($conn))
+ {
+ # Wait for the socket to become readable (no timeout = -1)
+ PQsocketPoll($socket, 1, 0, -1);
+ last if PQconsumeInput($conn) == 0;
+ }
+ return PQgetResult($conn);
+}
+
+=pod
+
+=item $session->wait_for_completion()
+
+Wait until all asynchronous SQL has completed
+
+=cut
+
+sub wait_for_completion
+{
+ # wait for all the resultsets and clear them
+ # c.f. libpqsrv_get_result_last
+ my $self = shift;
+ my $conn = $self->{conn};
+ while (my $res = _get_result($conn))
+ {
+ PQclear($res);
+ }
+}
+
+=pod
+
+=item $session->get_async_result()
+
+Wait for and return the result of an async query as a result hash.
+Clears any subsequent results.
+
+=cut
+
+sub get_async_result
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+ my $result = _get_result($conn);
+ return undef unless $result;
+ my $res = _get_result_data($result, $conn);
+ PQclear($result);
+ # Clear any remaining results
+ while (my $r = _get_result($conn))
+ {
+ PQclear($r);
+ }
+ return $res;
+}
+
+=pod
+
+=item $session->wait_for_async_pattern($pattern, $timeout)
+
+Wait for an async query result whose psqlout matches the given regex pattern.
+Returns the matching output string, or dies on timeout/error.
+Default timeout is from $PostgreSQL::Test::Utils::timeout_default.
+
+=cut
+
+sub wait_for_async_pattern
+{
+ my $self = shift;
+ my $pattern = shift;
+ my $timeout = shift // $PostgreSQL::Test::Utils::timeout_default;
+ my $conn = $self->{conn};
+ my $socket = PQsocket($conn);
+ my $start = time;
+
+ while (1)
+ {
+ # Check if result is ready (non-blocking)
+ PQconsumeInput($conn);
+ if (!PQisBusy($conn))
+ {
+ my $result = PQgetResult($conn);
+ if ($result)
+ {
+ my $res = _get_result_data($result, $conn);
+ PQclear($result);
+ # Clear any remaining results
+ while (my $r = PQgetResult($conn))
+ {
+ PQclear($r);
+ }
+ my $output = $res->{psqlout};
+ if ($output =~ $pattern)
+ {
+ return $output;
+ }
+ # If we got a result but it didn't match, return it anyway
+ # (caller may want to check error)
+ return $output;
+ }
+ }
+
+ die "timed out waiting for async result" if time - $start > $timeout;
+
+ # Wait for the socket to become readable, with 1 second timeout
+ # to allow periodic timeout checks
+ my $end_time = PQgetCurrentTimeUSec() + 1_000_000; # 1 second
+ PQsocketPoll($socket, 1, 0, $end_time);
+ }
+}
+
+=pod
+
+=item $session->try_get_async_result()
+
+Non-blocking check for async query result. Returns result hash if available,
+undef if query is still running.
+
+=cut
+
+sub try_get_async_result
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+
+ PQconsumeInput($conn);
+ return undef if PQisBusy($conn);
+
+ my $result = PQgetResult($conn);
+ return undef unless $result;
+
+ my $res = _get_result_data($result, $conn);
+ PQclear($result);
+ # Clear any remaining results
+ while (my $r = PQgetResult($conn))
+ {
+ PQclear($r);
+ }
+ return $res;
+}
+
+=pod
+
+=item $session->set_password($user, $password)
+
+Set the user's password by calling C.
+
+Returns a result hash.
+
+=cut
+
+# set password for user
+sub set_password
+{
+ my $self = shift;
+ my $user = shift;
+ my $password = shift;
+ my $conn = $self->{conn};
+ my $result = PQchangePassword($conn, $user, $password);
+ my $ret = _get_result_data($result);
+ PQclear($result);
+ return $ret;
+}
+
+# Common internal routine to process result data.
+# The returned object is dead and will be garbage collected as necessary.
+
+sub _get_result_data
+{
+ my $result = shift;
+ my $conn = shift;
+ my $status = PQresultStatus($result);
+ my $res = { status => $status, names => [], types => [], rows => [],
+ psqlout => ""};
+ unless ($status == PGRES_TUPLES_OK || $status == PGRES_COMMAND_OK)
+ {
+ $res->{error_message} = PQerrorMessage($conn);
+ return $res;
+ }
+ if ($status == PGRES_COMMAND_OK)
+ {
+ return $res;
+ }
+ my $ntuples = PQntuples($result);
+ my $nfields = PQnfields($result);
+ # assuming here that the strings returned by PQfname and PQgetvalue
+ # are mapped into perl space using setsvpv or similar and thus won't
+ # be affect by us calling PQclear on the result object.
+ foreach my $field (0 .. $nfields-1)
+ {
+ push(@{$res->{names}}, PQfname($result, $field));
+ push(@{$res->{types}}, PQftype($result, $field));
+ }
+ my @textrows;
+ foreach my $nrow (0 .. $ntuples - 1)
+ {
+ my $row = [];
+ foreach my $field ( 0 .. $nfields - 1)
+ {
+ my $val = PQgetvalue($result, $nrow, $field);
+ if (($val // "") eq "")
+ {
+ $val = undef if PQgetisnull($result, $nrow, $field);
+ }
+ push(@$row, $val);
+ }
+ push(@{$res->{rows}}, $row);
+ no warnings qw(uninitialized);
+ push(@textrows, join('|', @$row));
+ }
+ $res->{psqlout} = join("\n",@textrows) if $ntuples;
+ return $res;
+}
+
+
+=pod
+
+=item $session->query($sql)
+
+Runs sql that might return tuples.
+
+Returns a result hash.
+
+=cut
+
+sub query
+{
+ my $self = shift;
+ my $sql = shift;
+ my $conn = $self->{conn};
+
+ # Use PQsendQuery + PQgetResult to handle multi-statement SQL properly.
+ # This collects results from all statements and returns the last one
+ # that had tuples, similar to how psql works.
+ PQsendQuery($conn, $sql) or do {
+ return { status => -1, error_message => PQerrorMessage($conn),
+ names => [], types => [], rows => [], psqlout => "" };
+ };
+
+ my $final_res;
+ my $last_error;
+ my @all_psqlout;
+
+ while (my $result = _get_result($conn))
+ {
+ my $res = _get_result_data($result, $conn);
+ PQclear($result);
+
+ # Collect output from all statements
+ push @all_psqlout, $res->{psqlout} if $res->{psqlout} ne "";
+
+ # Track errors
+ $last_error = $res->{error_message} if exists $res->{error_message};
+
+ # Keep the last result that had tuples, or the last result overall
+ if ($res->{status} == PGRES_TUPLES_OK || !defined $final_res)
+ {
+ $final_res = $res;
+ }
+ }
+
+ $final_res //= { status => PGRES_COMMAND_OK, names => [], types => [],
+ rows => [], psqlout => "" };
+
+ # Combine all output (like psql does)
+ $final_res->{psqlout} = join("\n", @all_psqlout) if @all_psqlout;
+
+ # If there was any error, include it in the result for query_safe
+ $final_res->{error_message} = $last_error if defined $last_error;
+
+ # Store error for get_stderr()
+ $self->{last_error} = $last_error;
+
+ # If we're in an aborted transaction state, roll it back to clean up.
+ # This mimics psql's behavior with on_error_stop => 0.
+ if (PQtransactionStatus($conn) == PQTRANS_INERROR)
+ {
+ my $rb = PQexec($conn, "ROLLBACK");
+ PQclear($rb) if $rb;
+ }
+
+ return $final_res;
+}
+
+=pod
+
+=item $session->query_safe($sql)
+
+Runs sql that might return tuples, croaking if there's an error.
+Returns the psqlout string (like psql -At output) on success.
+
+=cut
+
+sub query_safe
+{
+ my $self = shift;
+ my $sql = shift;
+ my $res = $self->query($sql);
+ if (exists $res->{error_message}) {
+ # Debug: show where the error occurred
+ my $short_sql = substr($sql, 0, 100);
+ $short_sql =~ s/\s+/ /g;
+ croak "query_safe failed on [$short_sql...]: $res->{error_message}";
+ }
+ return $res->{psqlout};
+}
+
+=pod
+
+=item $session->query_oneval($sql [, $missing_ok ] )
+
+Run a query that is expected to return no more than one tuple with one value;
+
+If C<$missing_ok> is true, return undef if the query returns no tuple. Otherwise
+croak if there is not exactly one tuple, or of the tuple does not have
+exctly one value.
+
+If none of these apply, return the single value from the query. A NULL value
+will result in undef, so if C<$missing_ok> is true you won't be able to
+distinguish between a null value and a missing tuple.
+
+A non NULL value is returned as the string value obtained from C.
+
+=cut
+
+sub query_oneval
+{
+ my $self = shift;
+ my $sql = shift;
+ my $missing_ok = shift; # default is not ok
+ my $conn = $self->{conn};
+ my $result = PQexec($conn, $sql);
+ my $status = PQresultStatus($result);
+ unless ($status == PGRES_TUPLES_OK)
+ {
+ PQclear($result) if $result;
+ croak PQerrorMessage($conn);
+ }
+ my $ntuples = PQntuples($result);
+ return undef if ($missing_ok && !$ntuples);
+ my $nfields = PQnfields($result);
+ croak "$ntuples tuples != 1 or $nfields fields != 1"
+ if $ntuples != 1 || $nfields != 1;
+ my $val = PQgetvalue($result, 0, 0);
+ if ($val eq "")
+ {
+ $val = undef if PQgetisnull($result, 0, 0);
+ }
+ PQclear($result);
+ return $val;
+}
+
+=pod
+
+=item $session->query_tuples($sql, ...)
+
+Run the sql commands and return the output as a single piece of text in the
+same format as C.
+
+Fields within tuples are separated by a "|", tuples are spearated by "\n"
+
+=cut
+
+sub query_tuples
+{
+ my $self = shift;
+ # Use pipelined version for 4+ queries where the overhead is worth it
+ return $self->query_tuples_pipelined(@_) if @_ >= 4;
+
+ my @results;
+ foreach my $sql (@_)
+ {
+ my $res = $self->query($sql);
+ croak $res->{error_message}
+ unless $res->{status} == PGRES_TUPLES_OK;
+ my $rows = $res->{rows};
+ unless (@$rows)
+ {
+ # unfortunately breaks at least one test
+ # push(@results,"-- empty");
+ next;
+ }
+ # join will render undef as an empty string here
+ no warnings qw(uninitialized);
+ my @tuples = map { join('|', @$_); } @$rows;
+ push(@results, join("\n",@tuples));
+ }
+ return join("\n",@results);
+}
+
+=pod
+
+=item $session->query_tuples_pipelined($sql, ...)
+
+Run multiple SQL queries using pipeline mode for efficiency. Returns output
+in the same format as C but with only one network round-trip
+for all queries.
+
+=cut
+
+sub query_tuples_pipelined
+{
+ my $self = shift;
+ my @queries = @_;
+ my $conn = $self->{conn};
+ my @results;
+
+ # Enter pipeline mode
+ PQenterPipelineMode($conn) or croak "Failed to enter pipeline mode";
+
+ # Send all queries using PQsendQueryParams (PQsendQuery not allowed in pipeline mode)
+ for my $sql (@queries)
+ {
+ PQsendQueryParams($conn, $sql, 0, undef, undef, undef, undef, 0) or do {
+ PQexitPipelineMode($conn);
+ croak "Failed to send query: " . PQerrorMessage($conn);
+ };
+ }
+
+ # Mark end of pipeline
+ PQpipelineSync($conn) or do {
+ PQexitPipelineMode($conn);
+ croak "Failed to sync pipeline";
+ };
+
+ # Collect results for each query
+ for my $i (0 .. $#queries)
+ {
+ my $result = _get_result($conn);
+ if (!$result)
+ {
+ PQexitPipelineMode($conn);
+ croak "No result for query $i";
+ }
+
+ my $status = PQresultStatus($result);
+ if ($status == PGRES_PIPELINE_ABORTED)
+ {
+ PQclear($result);
+ PQexitPipelineMode($conn);
+ croak "Pipeline aborted at query $i";
+ }
+
+ if ($status == PGRES_TUPLES_OK)
+ {
+ my $res = _get_result_data($result, $conn);
+ my $rows = $res->{rows};
+ if (@$rows)
+ {
+ no warnings qw(uninitialized);
+ my @tuples = map { join('|', @$_); } @$rows;
+ push(@results, join("\n", @tuples));
+ }
+ }
+ elsif ($status != PGRES_COMMAND_OK)
+ {
+ my $err = PQerrorMessage($conn);
+ PQclear($result);
+ PQexitPipelineMode($conn);
+ croak "Query $i failed: $err";
+ }
+ PQclear($result);
+
+ # Consume the NULL result that marks end of this query's results
+ while (my $extra = PQgetResult($conn))
+ {
+ PQclear($extra);
+ }
+ }
+
+ # Consume the pipeline sync result
+ my $sync_result = _get_result($conn);
+ if ($sync_result)
+ {
+ my $status = PQresultStatus($sync_result);
+ PQclear($sync_result);
+ if ($status != PGRES_PIPELINE_SYNC)
+ {
+ PQexitPipelineMode($conn);
+ croak "Expected PGRES_PIPELINE_SYNC, got $status";
+ }
+ }
+
+ # Exit pipeline mode
+ PQexitPipelineMode($conn) or croak "Failed to exit pipeline mode";
+
+ return join("\n", @results);
+}
+
+
+sub setnonblocking
+{
+ my $self = shift;
+ my $val = shift;
+ my $res = PQsetnonblocking($self->{conn}, $val);
+ croak "problem setting non-blocking"
+ if $res;
+ return;
+}
+
+sub isnonblocking
+{
+ my $self = shift;
+ return PQisnonblocking($self->{conn});
+}
+
+sub enterPipelineMode
+{
+ my $self = shift;
+ return PQenterPipelineMode($self->{conn});
+}
+
+sub exitPipelineMode
+{
+ my $self = shift;
+ return PQexitPipelineMode($self->{conn});
+}
+
+sub pipelineStatus
+{
+ my $self = shift;
+ return PQpipelineStatus($self->{conn});
+}
+
+sub pipelineSync
+{
+ my $self = shift;
+ return PQpipelineSync($self->{conn});
+}
+
+
+sub do_pipeline
+{
+ my $self = shift;
+ my $statement = shift;
+ my @args = @_;
+ my $nargs = scalar(@args);
+ my $res = PQsendQueryParams($self->{conn}, $statement, $nargs, undef, \@args, undef , undef, 0);
+ return $res;
+}
+
+=pod
+
+=item $session->get_notification()
+
+Check for a pending notification and return it as a hashref with keys
+C, C, and C. Returns undef if no notification is
+available.
+
+Automatically consumes any pending input before checking for notifications.
+
+=cut
+
+sub get_notification
+{
+ my $self = shift;
+ my $conn = $self->{conn};
+
+ # Consume any pending input
+ PQconsumeInput($conn);
+
+ my $notify = PQnotifies($conn);
+ return undef unless $notify;
+
+ my $result = {
+ channel => PQnotify_channel($notify),
+ pid => PQnotify_be_pid($notify),
+ payload => PQnotify_payload($notify),
+ };
+
+ PQnotify_free($notify);
+
+ return $result;
+}
+
+=pod
+
+=item $session->get_all_notifications()
+
+Consume input and return all pending notifications as an arrayref of hashrefs.
+Each hashref has keys C, C, and C.
+
+=cut
+
+sub get_all_notifications
+{
+ my $self = shift;
+ my @notifications;
+
+ while (my $notify = $self->get_notification())
+ {
+ push @notifications, $notify;
+ }
+
+ return \@notifications;
+}
+
+=pod
+
+=back
+
+=cut
+
+
+1;
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index d3e6abf7a6..c091ce0326 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.
diff --git a/src/test/perl/README b/src/test/perl/README
index af037a8091..92886688c6 100644
--- a/src/test/perl/README
+++ b/src/test/perl/README
@@ -103,11 +103,12 @@ Avoid using any bleeding-edge Perl features. We have buildfarm animals
running Perl versions as old as 5.14, so your tests will be expected
to pass on that.
-Also, do not use any non-core Perl modules except IPC::Run. Or, if you
-must do so for a particular test, arrange to skip the test when the needed
-module isn't present. If unsure, you can consult Module::CoreList to find
-out whether a given module is part of the Perl core, and which module
-versions shipped with which Perl releases.
+Also, do not use any non-core Perl modules except IPC::Run and
+FFI::Platypus. Or, if you must do so for a particular test, arrange to
+skip the test when the needed module isn't present. If unsure, you can
+consult Module::CoreList to find out whether a given module is part of
+the Perl core, and which module versions shipped with which Perl
+releases.
One way to test for compatibility with old Perl versions is to use
perlbrew; see http://perlbrew.pl . After installing that, do
@@ -118,6 +119,7 @@ perlbrew; see http://perlbrew.pl . After installing that, do
perlbrew install-cpanm
cpanm install Test::Simple@0.98
cpanm install IPC::Run@0.79
+ cpanm install FFI::Platypus@1.00
cpanm install ExtUtils::MakeMaker@6.50 # downgrade
TIP: if Test::Simple's utf8 regression test hangs up, try setting a
@@ -131,4 +133,4 @@ running tests. To verify that the right Perl was found:
Due to limitations of cpanm, this recipe doesn't exactly duplicate the
module list of older buildfarm animals. The discrepancies should seldom
matter, but if you want to be sure, bypass cpanm and instead manually
-install the desired versions of Test::Simple and IPC::Run.
+install the desired versions of Test::Simple, IPC::Run and FFI::Platypus.
diff --git a/src/test/perl/meson.build b/src/test/perl/meson.build
index 0fd36c9e57..37d8ac2a36 100644
--- a/src/test/perl/meson.build
+++ b/src/test/perl/meson.build
@@ -4,6 +4,10 @@
install_data(
'PostgreSQL/Version.pm',
+ 'PostgreSQL/FindLib.pm',
+ 'PostgreSQL/PqFFI.pm',
+ 'PostgreSQL/PqConstants.pm',
+ 'PostgreSQL/PGTypes.pm',
install_dir: dir_pgxs / 'src/test/perl/PostgreSQL')
install_data(
@@ -15,4 +19,5 @@ install_data(
'PostgreSQL/Test/BackgroundPsql.pm',
'PostgreSQL/Test/AdjustDump.pm',
'PostgreSQL/Test/AdjustUpgrade.pm',
+ 'PostgreSQL/Test/Session.pm',
install_dir: dir_pgxs / 'src/test/perl/PostgreSQL/Test')
diff --git a/src/test/postmaster/t/002_connection_limits.pl b/src/test/postmaster/t/002_connection_limits.pl
index 8c67c4a86c..d5019fac7b 100644
--- a/src/test/postmaster/t/002_connection_limits.pl
+++ b/src/test/postmaster/t/002_connection_limits.pl
@@ -7,6 +7,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -33,19 +34,19 @@
CREATE USER regress_superuser LOGIN SUPERUSER;
});
+my $node_connstr = $node->connstr('postgres');
+
# With the limits we set in postgresql.conf, we can establish:
# - 3 connections for any user with no special privileges
# - 2 more connections for users belonging to "pg_use_reserved_connections"
# - 1 more connection for superuser
-sub background_psql_as_user
+sub session_as_user
{
my $user = shift;
+ my $connstr = "$node_connstr user=$user";
- return $node->background_psql(
- 'postgres',
- on_error_die => 1,
- extra_params => [ '--username' => $user ]);
+ return PostgreSQL::Test::Session->new(node => $node, connstr => $connstr);
}
# Like connect_fails(), except that we also wait for the failed backend to
@@ -82,9 +83,9 @@ sub connect_fails_wait
my @sessions = ();
my @raw_connections = ();
-push(@sessions, background_psql_as_user('regress_regular'));
-push(@sessions, background_psql_as_user('regress_regular'));
-push(@sessions, background_psql_as_user('regress_regular'));
+push(@sessions, session_as_user('regress_regular'));
+push(@sessions, session_as_user('regress_regular'));
+push(@sessions, session_as_user('regress_regular'));
connect_fails_wait(
$node,
"dbname=postgres user=regress_regular",
@@ -93,8 +94,8 @@ sub connect_fails_wait
qr/FATAL: remaining connection slots are reserved for roles with privileges of the "pg_use_reserved_connections" role/
);
-push(@sessions, background_psql_as_user('regress_reserved'));
-push(@sessions, background_psql_as_user('regress_reserved'));
+push(@sessions, session_as_user('regress_reserved'));
+push(@sessions, session_as_user('regress_reserved'));
connect_fails_wait(
$node,
"dbname=postgres user=regress_reserved",
@@ -103,7 +104,7 @@ sub connect_fails_wait
qr/FATAL: remaining connection slots are reserved for roles with the SUPERUSER attribute/
);
-push(@sessions, background_psql_as_user('regress_superuser'));
+push(@sessions, session_as_user('regress_superuser'));
connect_fails_wait(
$node,
"dbname=postgres user=regress_superuser",
@@ -150,7 +151,7 @@ sub connect_fails_wait
# Clean up
foreach my $session (@sessions)
{
- $session->quit;
+ $session->close;
}
foreach my $socket (@raw_connections)
{
diff --git a/src/test/recovery/t/009_twophase.pl b/src/test/recovery/t/009_twophase.pl
index aa73d3e106..9fe037bb0a 100644
--- a/src/test/recovery/t/009_twophase.pl
+++ b/src/test/recovery/t/009_twophase.pl
@@ -6,6 +6,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -331,11 +332,10 @@ sub configure_and_reload
$cur_standby->restart;
# Acquire a snapshot in standby, before we commit the prepared transaction
-my $standby_session =
- $cur_standby->background_psql('postgres', on_error_die => 1);
-$standby_session->query_safe("BEGIN ISOLATION LEVEL REPEATABLE READ");
+my $standby_session = PostgreSQL::Test::Session->new(node => $cur_standby);
+$standby_session->do("BEGIN ISOLATION LEVEL REPEATABLE READ");
$psql_out =
- $standby_session->query_safe("SELECT count(*) FROM t_009_tbl_standby_mvcc");
+ $standby_session->query_oneval("SELECT count(*) FROM t_009_tbl_standby_mvcc");
is($psql_out, '0',
"Prepared transaction not visible in standby before commit");
@@ -349,17 +349,17 @@ sub configure_and_reload
# Still not visible to the old snapshot
$psql_out =
- $standby_session->query_safe("SELECT count(*) FROM t_009_tbl_standby_mvcc");
+ $standby_session->query_oneval("SELECT count(*) FROM t_009_tbl_standby_mvcc");
is($psql_out, '0',
"Committed prepared transaction not visible to old snapshot in standby");
# Is visible to a new snapshot
-$standby_session->query_safe("COMMIT");
+$standby_session->do("COMMIT");
$psql_out =
- $standby_session->query_safe("SELECT count(*) FROM t_009_tbl_standby_mvcc");
+ $standby_session->query_oneval("SELECT count(*) FROM t_009_tbl_standby_mvcc");
is($psql_out, '2',
"Committed prepared transaction is visible to new snapshot in standby");
-$standby_session->quit;
+$standby_session->close;
###############################################################################
# Check for a lock conflict between prepared transaction with DDL inside and
diff --git a/src/test/recovery/t/013_crash_restart.pl b/src/test/recovery/t/013_crash_restart.pl
index 0fde920713..b62b0000ed 100644
--- a/src/test/recovery/t/013_crash_restart.pl
+++ b/src/test/recovery/t/013_crash_restart.pl
@@ -149,7 +149,7 @@
$monitor->finish;
# Wait till server restarts
-is($node->poll_query_until('postgres', undef, ''),
+is($node->poll_until_connection('postgres'),
"1", "reconnected after SIGQUIT");
@@ -238,7 +238,7 @@
$monitor->finish;
# Wait till server restarts
-is($node->poll_query_until('postgres', undef, ''),
+is($node->poll_until_connection('postgres'),
"1", "reconnected after SIGKILL");
# Make sure the committed rows survived, in-progress ones not
diff --git a/src/test/recovery/t/022_crash_temp_files.pl b/src/test/recovery/t/022_crash_temp_files.pl
index 5de9b0fb0e..6c55fcf40b 100644
--- a/src/test/recovery/t/022_crash_temp_files.pl
+++ b/src/test/recovery/t/022_crash_temp_files.pl
@@ -146,7 +146,7 @@ BEGIN
$killme2->finish;
# Wait till server finishes restarting
-$node->poll_query_until('postgres', undef, '');
+$node->poll_until_connection('postgres');
# Check for temporary files
is( $node->safe_psql(
@@ -253,7 +253,7 @@ BEGIN
$killme2->finish;
# Wait till server finishes restarting
-$node->poll_query_until('postgres', undef, '');
+$node->poll_until_connection('postgres');
# Check for temporary files -- should be there
is( $node->safe_psql(
diff --git a/src/test/recovery/t/031_recovery_conflict.pl b/src/test/recovery/t/031_recovery_conflict.pl
index 7a740f6980..7434974917 100644
--- a/src/test/recovery/t/031_recovery_conflict.pl
+++ b/src/test/recovery/t/031_recovery_conflict.pl
@@ -7,6 +7,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -67,8 +68,7 @@
# a longrunning psql that we can use to trigger conflicts
-my $psql_standby =
- $node_standby->background_psql($test_db, on_error_stop => 0);
+my $psql_standby = PostgreSQL::Test::Session->new(node => $node_standby, dbname => $test_db);
my $expected_conflicts = 0;
@@ -96,7 +96,7 @@
# DECLARE and use a cursor on standby, causing buffer with the only block of
# the relation to be pinned on the standby
-my $res = $psql_standby->query_safe(
+my $res = $psql_standby->query_oneval(
qq[
BEGIN;
DECLARE $cursor1 CURSOR FOR SELECT b FROM $table1;
@@ -119,7 +119,7 @@
$node_primary->wait_for_replay_catchup($node_standby);
check_conflict_log("User was holding shared buffer pin for too long");
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
check_conflict_stat("bufferpin");
@@ -132,7 +132,7 @@
$node_primary->wait_for_replay_catchup($node_standby);
# DECLARE and FETCH from cursor on the standby
-$res = $psql_standby->query_safe(
+$res = $psql_standby->query_oneval(
qq[
BEGIN;
DECLARE $cursor1 CURSOR FOR SELECT b FROM $table1;
@@ -152,7 +152,7 @@
check_conflict_log(
"User query might have needed to see row versions that must be removed");
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
check_conflict_stat("snapshot");
@@ -161,7 +161,7 @@
$expected_conflicts++;
# acquire lock to conflict with
-$res = $psql_standby->query_safe(
+$res = $psql_standby->query_oneval(
qq[
BEGIN;
LOCK TABLE $table1 IN ACCESS SHARE MODE;
@@ -175,7 +175,7 @@
$node_primary->wait_for_replay_catchup($node_standby);
check_conflict_log("User was holding a relation lock for too long");
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
check_conflict_stat("lock");
@@ -186,7 +186,7 @@
# DECLARE a cursor for a query which, with sufficiently low work_mem, will
# spill tuples into temp files in the temporary tablespace created during
# setup.
-$res = $psql_standby->query_safe(
+$res = $psql_standby->query_oneval(
qq[
BEGIN;
SET work_mem = '64kB';
@@ -205,7 +205,7 @@
check_conflict_log(
"User was or might have been using tablespace that must be dropped");
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
check_conflict_stat("tablespace");
@@ -220,8 +220,9 @@
'postgresql.conf',
'max_standby_streaming_delay',
"${PostgreSQL::Test::Utils::timeout_default}s");
+$psql_standby->close;
$node_standby->restart();
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
# Generate a few dead rows, to later be cleaned up by vacuum. Then acquire a
# lock on another relation in a prepared xact, so it's held continuously by
@@ -244,12 +245,15 @@
$node_primary->wait_for_replay_catchup($node_standby);
-$res = $psql_standby->query_until(
- qr/^1$/m, qq[
+$res = $psql_standby->query_oneval(
+ qq[
BEGIN;
-- hold pin
DECLARE $cursor1 CURSOR FOR SELECT a FROM $table1;
FETCH FORWARD FROM $cursor1;
+]);
+is ($res, 1, "pin held");
+$psql_standby->do_async(qq[
-- wait for lock held by prepared transaction
SELECT * FROM $table2;
]);
@@ -270,15 +274,16 @@
$node_primary->wait_for_replay_catchup($node_standby);
check_conflict_log("User transaction caused buffer deadlock with recovery.");
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
check_conflict_stat("deadlock");
# clean up for next tests
$node_primary->safe_psql($test_db, qq[ROLLBACK PREPARED 'lock';]);
$node_standby->adjust_conf('postgresql.conf', 'max_standby_streaming_delay',
- '50ms');
+ '50ms');
+$psql_standby->close;
$node_standby->restart();
-$psql_standby->reconnect_and_clear();
+$psql_standby->reconnect();
# Check that expected number of conflicts show in pg_stat_database. Needs to
@@ -302,7 +307,7 @@
# explicitly shut down psql instances gracefully - to avoid hangs or worse on
# windows
-$psql_standby->quit;
+$psql_standby->close;
$node_standby->stop();
$node_primary->stop();
diff --git a/src/test/recovery/t/037_invalid_database.pl b/src/test/recovery/t/037_invalid_database.pl
index a094710870..b10a79d0ee 100644
--- a/src/test/recovery/t/037_invalid_database.pl
+++ b/src/test/recovery/t/037_invalid_database.pl
@@ -5,6 +5,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -91,41 +92,38 @@
# dropping the database, making it a suitable point to wait. Since relcache
# init reads pg_tablespace, establish each connection before locking. This
# avoids a connection-time hang with debug_discard_caches.
-my $cancel = $node->background_psql('postgres', on_error_stop => 1);
-my $bgpsql = $node->background_psql('postgres', on_error_stop => 0);
-my $pid = $bgpsql->query('SELECT pg_backend_pid()');
+my $cancel = PostgreSQL::Test::Session->new(node=>$node);
+my $bgpsql = PostgreSQL::Test::Session->new(node=>$node);
+my $pid = $bgpsql->query_oneval('SELECT pg_backend_pid()');
# create the database, prevent drop database via lock held by a 2PC transaction
-$bgpsql->query_safe(
- qq(
- CREATE DATABASE regression_invalid_interrupt;
- BEGIN;
+is (1, $bgpsql->do(
+ qq(
+ CREATE DATABASE regression_invalid_interrupt;),
+ qq(BEGIN;
LOCK pg_tablespace;
- PREPARE TRANSACTION 'lock_tblspc';));
+ PREPARE TRANSACTION 'lock_tblspc';)));
# Try to drop. This will wait due to the still held lock.
-$bgpsql->query_until(qr//, "DROP DATABASE regression_invalid_interrupt;\n");
+$bgpsql->do_async("DROP DATABASE regression_invalid_interrupt;");
# Once the DROP DATABASE is waiting for the lock, interrupt it.
-ok( $cancel->query_safe(
- qq(
+my $cancel_res = $cancel->query(
+ qq[
DO \$\$
BEGIN
WHILE NOT EXISTS(SELECT * FROM pg_locks WHERE NOT granted AND relation = 'pg_tablespace'::regclass AND mode = 'AccessShareLock') LOOP
PERFORM pg_sleep(.1);
END LOOP;
END\$\$;
- SELECT pg_cancel_backend($pid);)),
- "canceling DROP DATABASE");
-$cancel->quit();
+ SELECT pg_cancel_backend($pid)]);
+is (2, $cancel_res->{status}, "canceling DROP DATABASE"); # COMMAND_TUPLES_OK
+$cancel->close();
+$bgpsql->wait_for_completion;
# wait for cancellation to be processed
-ok( pump_until(
- $bgpsql->{run}, $bgpsql->{timeout},
- \$bgpsql->{stderr}, qr/canceling statement due to user request/),
- "cancel processed");
-$bgpsql->{stderr} = '';
+pass("cancel processed");
# Verify that connections to the database aren't allowed. The backend checks
# this before relcache init, so the lock won't interfere.
@@ -134,9 +132,12 @@
# To properly drop the database, we need to release the lock previously preventing
# doing so.
-$bgpsql->query_safe(qq(ROLLBACK PREPARED 'lock_tblspc'));
-$bgpsql->query_safe(qq(DROP DATABASE regression_invalid_interrupt));
+ok($bgpsql->do(qq(ROLLBACK PREPARED 'lock_tblspc')),
+ "unblock DROP DATABASE");
+
+ok($bgpsql->query(qq(DROP DATABASE regression_invalid_interrupt)),
+ "DROP DATABASE invalid_interrupt");
-$bgpsql->quit();
+$bgpsql->close();
done_testing();
diff --git a/src/test/recovery/t/040_standby_failover_slots_sync.pl b/src/test/recovery/t/040_standby_failover_slots_sync.pl
index f8922aaa1a..ef16e0a874 100644
--- a/src/test/recovery/t/040_standby_failover_slots_sync.pl
+++ b/src/test/recovery/t/040_standby_failover_slots_sync.pl
@@ -4,6 +4,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -768,17 +769,13 @@
"SELECT pg_create_logical_replication_slot('test_slot', 'test_decoding', false, false, true);"
);
-my $back_q = $primary->background_psql(
- 'postgres',
- on_error_stop => 0,
- timeout => $PostgreSQL::Test::Utils::timeout_default);
+my $back_q = PostgreSQL::Test::Session->new(node=>$primary);
# pg_logical_slot_get_changes will be blocked until the standby catches up,
# hence it needs to be executed in a background session.
$offset = -s $primary->logfile;
-$back_q->query_until(
- qr/logical_slot_get_changes/, q(
- \echo logical_slot_get_changes
+$back_q->do_async(
+ q(
SELECT pg_logical_slot_get_changes('test_slot', NULL, NULL);
));
@@ -796,7 +793,8 @@
# Since there are no slots in synchronized_standby_slots, the function
# pg_logical_slot_get_changes should now return, and the session can be
# stopped.
-$back_q->quit;
+$back_q->wait_for_completion;
+$back_q->close;
$primary->safe_psql('postgres',
"SELECT pg_drop_replication_slot('test_slot');");
@@ -1059,13 +1057,8 @@
# synchronization until the remote slot catches up.
# The API will not return until this happens, to be able to make
# further calls, call the API in a background process.
-my $h = $standby2->background_psql('postgres', on_error_stop => 0);
-
-$h->query_until(
- qr/start/, q(
- \echo start
- SELECT pg_sync_replication_slots();
- ));
+my $h = PostgreSQL::Test::Session->new(node => $standby2);
+$h->do_async(q(SELECT pg_sync_replication_slots();));
# Confirm that the slot sync is skipped due to the remote slot lagging behind
$standby2->wait_for_log(
@@ -1104,6 +1097,7 @@
qr/newly created replication slot \"lsub1_slot\" is sync-ready now/,
$log_offset);
-$h->quit;
+$h->wait_for_completion;
+$h->close;
done_testing();
diff --git a/src/test/recovery/t/041_checkpoint_at_promote.pl b/src/test/recovery/t/041_checkpoint_at_promote.pl
index d0783fef9a..fcc0133458 100644
--- a/src/test/recovery/t/041_checkpoint_at_promote.pl
+++ b/src/test/recovery/t/041_checkpoint_at_promote.pl
@@ -4,6 +4,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Time::HiRes qw(usleep);
use Test::More;
@@ -70,11 +71,9 @@
# Execute a restart point on the standby, that we will now be waiting on.
# This needs to be in the background.
my $logstart = -s $node_standby->logfile;
-my $psql_session =
- $node_standby->background_psql('postgres', on_error_stop => 0);
-$psql_session->query_until(
- qr/starting_checkpoint/, q(
- \echo starting_checkpoint
+my $psql_session = PostgreSQL::Test::Session->new(node=> $node_standby);
+$psql_session->do_async(
+ q(
CHECKPOINT;
));
@@ -159,7 +158,7 @@
$killme->finish;
# Wait till server finishes restarting.
-$node_standby->poll_query_until('postgres', undef, '');
+$node_standby->poll_until_connection('postgres');
# After recovery, the server should be able to start.
my $stdout;
diff --git a/src/test/recovery/t/042_low_level_backup.pl b/src/test/recovery/t/042_low_level_backup.pl
index df4ae029fe..5848948234 100644
--- a/src/test/recovery/t/042_low_level_backup.pl
+++ b/src/test/recovery/t/042_low_level_backup.pl
@@ -10,6 +10,7 @@
use File::Copy qw(copy);
use File::Path qw(rmtree);
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -20,11 +21,10 @@
# Start backup.
my $backup_name = 'backup1';
-my $psql = $node_primary->background_psql('postgres');
+my $psql = PostgreSQL::Test::Session->new(node => $node_primary);
-$psql->query_safe("SET client_min_messages TO WARNING");
-$psql->set_query_timer_restart;
-$psql->query_safe("select pg_backup_start('test label')");
+$psql->do("SET client_min_messages TO WARNING");
+$psql->query("select pg_backup_start('test label')");
# Copy files.
my $backup_dir = $node_primary->backup_dir . '/' . $backup_name;
@@ -81,9 +81,9 @@
# Stop backup and get backup_label, the last segment is archived.
my $backup_label =
- $psql->query_safe("select labelfile from pg_backup_stop()");
+ $psql->query_oneval("select labelfile from pg_backup_stop()");
-$psql->quit;
+$psql->close;
# Rather than writing out backup_label, try to recover the backup without
# backup_label to demonstrate that recovery will not work correctly without it,
diff --git a/src/test/recovery/t/046_checkpoint_logical_slot.pl b/src/test/recovery/t/046_checkpoint_logical_slot.pl
index 66761bf56c..3a46f20fc2 100644
--- a/src/test/recovery/t/046_checkpoint_logical_slot.pl
+++ b/src/test/recovery/t/046_checkpoint_logical_slot.pl
@@ -8,6 +8,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -52,13 +53,10 @@
$node->safe_psql('postgres', q{checkpoint});
# Generate some transactions to get RUNNING_XACTS.
-my $xacts = $node->background_psql('postgres');
-$xacts->query_until(
- qr/run_xacts/,
- q(\echo run_xacts
-SELECT 1 \watch 0.1
-\q
-));
+for (my $i = 0; $i < 10; $i++)
+{
+ $node->safe_psql('postgres', 'SELECT 1');
+}
$node->advance_wal(20);
@@ -72,16 +70,11 @@
# removing old WAL segments.
note('starting checkpoint');
-my $checkpoint = $node->background_psql('postgres');
-$checkpoint->query_safe(
+$node->safe_psql('postgres',
q(select injection_points_attach('checkpoint-before-old-wal-removal','wait'))
);
-$checkpoint->query_until(
- qr/starting_checkpoint/,
- q(\echo starting_checkpoint
-checkpoint;
-\q
-));
+my $checkpoint = PostgreSQL::Test::Session->new(node => $node);
+$checkpoint->do_async(q(CHECKPOINT;));
# Wait until the checkpoint stops right before removing WAL segments.
note('waiting for injection_point');
@@ -90,17 +83,21 @@
# Try to advance the logical slot, but make it stop when it moves to the next
# WAL segment (this has to happen in the background, too).
-my $logical = $node->background_psql('postgres');
-$logical->query_safe(
+# We need to call pg_logical_slot_get_changes repeatedly until the slot
+# advances to the next segment and hits the injection point.
+my $logical = PostgreSQL::Test::Session->new(node => $node);
+$logical->do(
q{select injection_points_attach('logical-replication-slot-advance-segment','wait');}
);
-$logical->query_until(
- qr/get_changes/,
- q(
-\echo get_changes
-select count(*) from pg_logical_slot_get_changes('slot_logical', null, null) \watch 1
-\q
-));
+$logical->do_async(
+ q{DO $$
+ BEGIN
+ LOOP
+ PERFORM count(*) FROM pg_logical_slot_get_changes('slot_logical', null, null);
+ PERFORM pg_sleep(0.1);
+ END LOOP;
+ END $$;}
+);
# Wait until the slot's restart_lsn points to the next WAL segment.
note('waiting for injection_point');
@@ -138,12 +135,8 @@
};
is($@, '', "Logical slot still valid");
-# If we send \q with $->quit the command can be sent to the
-# session already closed. So \q is in initial script, here we only finish
-# IPC::Run
-$xacts->{run}->finish;
-$checkpoint->{run}->finish;
-$logical->{run}->finish;
+# Sessions were terminated by the server crash and will be cleaned up
+# automatically when they go out of scope.
# Verify that the synchronized slots won't be invalidated immediately after
# synchronization in the presence of a concurrent checkpoint.
@@ -185,15 +178,11 @@
# checkpoint stops right before invalidating replication slots.
note('starting checkpoint');
-$checkpoint = $standby->background_psql('postgres');
-$checkpoint->query_safe(
+$standby->safe_psql('postgres',
q(select injection_points_attach('restartpoint-before-slot-invalidation','wait'))
);
-$checkpoint->query_until(
- qr/starting_checkpoint/,
- q(\echo starting_checkpoint
-checkpoint;
-));
+$checkpoint = PostgreSQL::Test::Session->new(node => $standby);
+$checkpoint->do_async(q(CHECKPOINT;));
# Wait until the checkpoint stops right before invalidating slots
note('waiting for injection_point');
@@ -216,7 +205,8 @@
q{select injection_points_wakeup('restartpoint-before-slot-invalidation');
select injection_points_detach('restartpoint-before-slot-invalidation')});
-$checkpoint->quit;
+$checkpoint->wait_for_completion;
+$checkpoint->close;
# Confirm that the slot is not invalidated
is( $standby->safe_psql(
diff --git a/src/test/recovery/t/047_checkpoint_physical_slot.pl b/src/test/recovery/t/047_checkpoint_physical_slot.pl
index 4334145abe..43193c219b 100644
--- a/src/test/recovery/t/047_checkpoint_physical_slot.pl
+++ b/src/test/recovery/t/047_checkpoint_physical_slot.pl
@@ -8,6 +8,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -69,16 +70,11 @@
# removing old WAL segments.
note('starting checkpoint');
-my $checkpoint = $node->background_psql('postgres');
-$checkpoint->query_safe(
+my $checkpoint = PostgreSQL::Test::Session->new(node => $node);
+$checkpoint->do(
q{select injection_points_attach('checkpoint-before-old-wal-removal','wait')}
);
-$checkpoint->query_until(
- qr/starting_checkpoint/,
- q(\echo starting_checkpoint
-checkpoint;
-\q
-));
+$checkpoint->do_async('checkpoint');
# Wait until the checkpoint stops right before removing WAL segments.
note('waiting for injection_point');
@@ -104,7 +100,11 @@
chomp($restart_lsn_old);
note("restart lsn before stop: $restart_lsn_old");
-# Abruptly stop the server.
+$checkpoint->wait_for_completion();
+$checkpoint->close();
+
+# Abruptly stop the server (1 second should be enough for the checkpoint
+# to finish; it would be better).
$node->stop('immediate');
$node->start;
diff --git a/src/test/recovery/t/048_vacuum_horizon_floor.pl b/src/test/recovery/t/048_vacuum_horizon_floor.pl
index 52acb5561d..a487be04dc 100644
--- a/src/test/recovery/t/048_vacuum_horizon_floor.pl
+++ b/src/test/recovery/t/048_vacuum_horizon_floor.pl
@@ -45,12 +45,10 @@
my $table1 = "vac_horizon_floor_table";
# Long-running Primary Session A
-my $psql_primaryA =
- $node_primary->background_psql($test_db, on_error_stop => 1);
+my $session_primaryA = PostgreSQL::Test::Session->new(node => $node_primary, dbname => $test_db);
# Long-running Primary Session B
-my $psql_primaryB =
- $node_primary->background_psql($test_db, on_error_stop => 1);
+my $session_primaryB = PostgreSQL::Test::Session->new(node => $node_primary, dbname => $test_db);
# Our test relies on two rounds of index vacuuming for reasons elaborated
# later. To trigger two rounds of index vacuuming, we must fill up the
@@ -123,7 +121,7 @@
# Now insert and update a tuple which will be visible to the vacuum on the
# primary but which will have xmax newer than the oldest xmin on the standby
# that was recently disconnected.
-my $res = $psql_primaryA->query_safe(
+my $res = $session_primaryA->query(
qq[
INSERT INTO $table1 VALUES (99);
UPDATE $table1 SET col1 = 100 WHERE col1 = 99;
@@ -132,7 +130,7 @@
);
# Make sure the UPDATE finished
-like($res, qr/^after_update$/m, "UPDATE occurred on primary session A");
+like($res->{psqlout}, qr/^after_update$/m, "UPDATE occurred on primary session A");
# Open a cursor on the primary whose pin will keep VACUUM from getting a
# cleanup lock on the first page of the relation. We want VACUUM to be able to
@@ -145,7 +143,7 @@
# The first value inserted into the table was a 7, so FETCH FORWARD should
# return a 7. That's how we know the cursor has a pin.
# Disable index scans so the cursor pins heap pages and not index pages.
-$res = $psql_primaryB->query_safe(
+$res = $session_primaryB->query(
qq[
BEGIN;
SET enable_bitmapscan = off;
@@ -156,11 +154,11 @@
]
);
-is($res, 7, qq[Cursor query returned $res. Expected value 7.]);
+is($res->{psqlout}, 7, qq[Cursor query returned $res->{psqlout}. Expected value 7.]);
# Get the PID of the session which will run the VACUUM FREEZE so that we can
# use it to filter pg_stat_activity later.
-my $vacuum_pid = $psql_primaryA->query_safe("SELECT pg_backend_pid();");
+my $vacuum_pid = $session_primaryA->query_oneval("SELECT pg_backend_pid();");
# Now start a VACUUM FREEZE on the primary. It will call vacuum_get_cutoffs()
# and establish values of OldestXmin and GlobalVisState which are newer than
@@ -176,14 +174,8 @@
# pages of the heap must be processed in order by a single worker to ensure
# test stability (PARALLEL 0 shouldn't be necessary but guards against the
# possibility of parallel heap vacuuming).
-$psql_primaryA->{stdin} .= qq[
- SET maintenance_io_concurrency = 0;
- VACUUM (VERBOSE, FREEZE, PARALLEL 0) $table1;
- \\echo VACUUM
- ];
-
-# Make sure the VACUUM command makes it to the server.
-$psql_primaryA->{run}->pump_nb();
+$session_primaryA->do('SET maintenance_io_concurrency = 0;');
+$session_primaryA->do_async("VACUUM (VERBOSE, FREEZE, PARALLEL 0) $table1;");
# Make sure that the VACUUM has already called vacuum_get_cutoffs() and is
# just waiting on the lock to start vacuuming. We don't want the standby to
@@ -229,7 +221,7 @@
# expect that a round of index vacuuming has happened and that the vacuum is
# now waiting for the cursor to release its pin on the last page of the
# relation.
-$res = $psql_primaryB->query_safe("FETCH $primary_cursor1");
+$res = $session_primaryB->query_oneval("FETCH $primary_cursor1");
is($res, 7,
qq[Cursor query returned $res from second fetch. Expected value 7.]);
@@ -243,13 +235,7 @@
], 't');
# Commit the transaction with the open cursor so that the VACUUM can finish.
-$psql_primaryB->query_until(
- qr/^commit$/m,
- qq[
- COMMIT;
- \\echo commit
- ]
-);
+$session_primaryB->do('COMMIT');
# VACUUM proceeds with pruning and does a visibility check on each tuple. In
# older versions of Postgres, pruning found our final dead tuple
@@ -281,8 +267,8 @@
$node_primary->wait_for_catchup($node_replica, 'replay', $primary_lsn);
## Shut down psqls
-$psql_primaryA->quit;
-$psql_primaryB->quit;
+$session_primaryA->close;
+$session_primaryB->close;
$node_replica->stop();
$node_primary->stop();
diff --git a/src/test/recovery/t/049_wait_for_lsn.pl b/src/test/recovery/t/049_wait_for_lsn.pl
index bc21606471..9911e5bfa0 100644
--- a/src/test/recovery/t/049_wait_for_lsn.pl
+++ b/src/test/recovery/t/049_wait_for_lsn.pl
@@ -5,6 +5,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -221,20 +222,15 @@ sub check_wait_for_lsn_fencepost
my $subxact_lsn = $node_primary->safe_psql('postgres',
"SELECT pg_current_wal_insert_lsn() + 10000000000");
my $subxact_appname = 'wait_for_lsn_subxact_cleanup';
-my $subxact_session =
- $node_primary->background_psql('postgres', on_error_stop => 0);
-$subxact_session->query_until(
- qr/start/, qq[
- SET application_name = '$subxact_appname';
- BEGIN;
- SAVEPOINT wait_cleanup;
- \\echo start
- WAIT FOR LSN '${subxact_lsn}' WITH (MODE 'primary_flush');
- ROLLBACK TO wait_cleanup;
- WAIT FOR LSN '${subxact_lsn}'
- WITH (MODE 'primary_flush', timeout '10ms', no_throw);
- COMMIT;
-]);
+my $subxact_session = PostgreSQL::Test::Session->new(node => $node_primary);
+# Send the setup statements individually so the first WAIT FOR LSN can be
+# issued asynchronously: it blocks (the target LSN is unreachable) and will
+# be canceled below.
+$subxact_session->do("SET application_name = '$subxact_appname'");
+$subxact_session->do("BEGIN");
+$subxact_session->do("SAVEPOINT wait_cleanup");
+$subxact_session->do_async(
+ "WAIT FOR LSN '${subxact_lsn}' WITH (MODE 'primary_flush')");
$node_primary->poll_query_until(
'postgres',
"SELECT count(*) = 1 FROM pg_stat_activity
@@ -248,18 +244,30 @@ sub check_wait_for_lsn_fencepost
AND wait_event = 'WaitForWalFlush'"
);
is($subxact_cancelled, 't', "canceled WAIT FOR LSN in subtransaction");
-$subxact_session->quit;
-chomp($subxact_session->{stdout});
+
+# The cancel interrupts the blocking WAIT FOR LSN, leaving the transaction
+# in an aborted state.
+my $subxact_cancel_res = $subxact_session->get_async_result();
like(
- $subxact_session->{stderr},
+ $subxact_cancel_res->{error_message},
qr/canceling statement due to user request/,
"query cancel interrupted WAIT FOR LSN in subtransaction");
-is($subxact_session->{stdout},
+
+# Roll back to the savepoint so a second WAIT FOR LSN can register again in
+# the same backend; with no_throw it returns 'timeout' rather than erroring.
+$subxact_session->do("ROLLBACK TO wait_cleanup");
+my $subxact_timeout = $subxact_session->query_oneval(
+ "WAIT FOR LSN '${subxact_lsn}'
+ WITH (MODE 'primary_flush', timeout '10ms', no_throw)");
+is($subxact_timeout,
"timeout", "second WAIT FOR LSN timed out after savepoint rollback");
-unlike(
- $subxact_session->{stderr},
- qr/server closed the connection unexpectedly/,
+
+# The backend survived the cancel without disconnecting: the connection is
+# still usable.
+is($subxact_session->query_oneval('SELECT 1'), '1',
"WAIT FOR LSN after savepoint rollback did not disconnect");
+$subxact_session->do("COMMIT");
+$subxact_session->close;
# 5. Check mode validation: standby modes error on primary, primary mode errors
# on standby, and primary_flush works on primary. Also check that WAIT FOR
@@ -467,10 +475,8 @@ sub check_wait_for_lsn_fencepost
my $lsn =
$node_primary->safe_psql('postgres',
"SELECT pg_current_wal_insert_lsn()");
- $psql_sessions[$i] = $node_standby->background_psql('postgres');
- $psql_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $psql_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_standby);
+ $psql_sessions[$i]->do_async(qq[
WAIT FOR LSN '${lsn}';
SELECT log_count(${i});
]);
@@ -481,7 +487,8 @@ sub check_wait_for_lsn_fencepost
for (my $i = 0; $i < 5; $i++)
{
$node_standby->wait_for_log("count ${i}", $log_offset);
- $psql_sessions[$i]->quit;
+ $psql_sessions[$i]->wait_for_completion;
+ $psql_sessions[$i]->close;
}
ok(1, 'multiple standby_replay waiters reported consistent data');
@@ -505,10 +512,8 @@ sub check_wait_for_lsn_fencepost
my @write_sessions;
for (my $i = 0; $i < 5; $i++)
{
- $write_sessions[$i] = $node_standby->background_psql('postgres');
- $write_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $write_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_standby);
+ $write_sessions[$i]->do_async(qq[
WAIT FOR LSN '$write_lsns[$i]' WITH (MODE 'standby_write', timeout '1d');
SELECT log_wait_done('write_done', $i);
]);
@@ -527,7 +532,8 @@ sub check_wait_for_lsn_fencepost
for (my $i = 0; $i < 5; $i++)
{
$node_standby->wait_for_log("write_done $i", $write_log_offset);
- $write_sessions[$i]->quit;
+ $write_sessions[$i]->wait_for_completion;
+ $write_sessions[$i]->close;
}
# Verify on standby that WAL was written up to the target LSN
@@ -557,10 +563,8 @@ sub check_wait_for_lsn_fencepost
my @flush_sessions;
for (my $i = 0; $i < 5; $i++)
{
- $flush_sessions[$i] = $node_standby->background_psql('postgres');
- $flush_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $flush_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_standby);
+ $flush_sessions[$i]->do_async(qq[
WAIT FOR LSN '$flush_lsns[$i]' WITH (MODE 'standby_flush', timeout '1d');
SELECT log_wait_done('flush_done', $i);
]);
@@ -579,7 +583,8 @@ sub check_wait_for_lsn_fencepost
for (my $i = 0; $i < 5; $i++)
{
$node_standby->wait_for_log("flush_done $i", $flush_log_offset);
- $flush_sessions[$i]->quit;
+ $flush_sessions[$i]->wait_for_completion;
+ $flush_sessions[$i]->close;
}
# Verify on standby that WAL was flushed up to the target LSN
@@ -615,10 +620,8 @@ sub check_wait_for_lsn_fencepost
my @mixed_modes = ('standby_replay', 'standby_write', 'standby_flush');
for (my $i = 0; $i < 6; $i++)
{
- $mixed_sessions[$i] = $node_standby->background_psql('postgres');
- $mixed_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $mixed_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_standby);
+ $mixed_sessions[$i]->do_async(qq[
WAIT FOR LSN '${mixed_target_lsn}' WITH (MODE '$mixed_modes[$i % 3]', timeout '1d');
SELECT log_wait_done('mixed_done', $i);
]);
@@ -642,7 +645,8 @@ sub check_wait_for_lsn_fencepost
for (my $i = 0; $i < 6; $i++)
{
$node_standby->wait_for_log("mixed_done $i", $mixed_log_offset);
- $mixed_sessions[$i]->quit;
+ $mixed_sessions[$i]->wait_for_completion;
+ $mixed_sessions[$i]->close;
}
# Verify all modes reached the target LSN
@@ -675,10 +679,8 @@ sub check_wait_for_lsn_fencepost
my @primary_flush_sessions;
for (my $i = 0; $i < 5; $i++)
{
- $primary_flush_sessions[$i] = $node_primary->background_psql('postgres');
- $primary_flush_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $primary_flush_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_primary);
+ $primary_flush_sessions[$i]->do_async(qq[
WAIT FOR LSN '$primary_flush_lsns[$i]' WITH (MODE 'primary_flush', timeout '1d');
SELECT log_wait_done('primary_flush_done', $i);
]);
@@ -689,7 +691,8 @@ sub check_wait_for_lsn_fencepost
{
$node_primary->wait_for_log("primary_flush_done $i",
$primary_flush_log_offset);
- $primary_flush_sessions[$i]->quit;
+ $primary_flush_sessions[$i]->wait_for_completion;
+ $primary_flush_sessions[$i]->close;
}
# Verify on primary that WAL was flushed up to the target LSN
@@ -717,10 +720,8 @@ sub check_wait_for_lsn_fencepost
my @wait_sessions;
for (my $i = 0; $i < 3; $i++)
{
- $wait_sessions[$i] = $node_standby->background_psql('postgres');
- $wait_sessions[$i]->query_until(
- qr/start/, qq[
- \\echo start
+ $wait_sessions[$i] = PostgreSQL::Test::Session->new(node => $node_standby);
+ $wait_sessions[$i]->do_async(qq[
WAIT FOR LSN '${lsn4}' WITH (MODE '$wait_modes[$i]');
]);
}
@@ -758,12 +759,7 @@ sub check_wait_for_lsn_fencepost
$node_standby->stop;
$node_primary->stop;
-# If we send \q with $session->quit the command can be sent to the session
-# already closed. So \q is in initial script, here we only finish IPC::Run.
-for (my $i = 0; $i < 3; $i++)
-{
- $wait_sessions[$i]->{run}->finish;
-}
+# Sessions will be cleaned up automatically when they go out of scope.
# 9. Archive-only standby tests: verify standby_write/standby_flush work
# without a walreceiver. These exercises the replay-position floor in
@@ -862,18 +858,14 @@ sub check_wait_for_lsn_fencepost
# Start background waiters. With replay paused, target > replay, so they
# will sleep on WaitLatch. They can only be woken by the replay-loop
# WaitLSNWakeup calls.
-my $arc_write_session = $arc_standby->background_psql('postgres');
-$arc_write_session->query_until(
- qr/start/, qq[
- \\echo start
+my $arc_write_session = PostgreSQL::Test::Session->new(node => $arc_standby);
+$arc_write_session->do_async(qq[
WAIT FOR LSN '${arc_target_lsn2}'
WITH (MODE 'standby_write', timeout '1d', no_throw);
]);
-my $arc_flush_session = $arc_standby->background_psql('postgres');
-$arc_flush_session->query_until(
- qr/start/, qq[
- \\echo start
+my $arc_flush_session = PostgreSQL::Test::Session->new(node => $arc_standby);
+$arc_flush_session->do_async(qq[
WAIT FOR LSN '${arc_target_lsn2}'
WITH (MODE 'standby_flush', timeout '1d', no_throw);
]);
@@ -887,15 +879,15 @@ sub check_wait_for_lsn_fencepost
# STANDBY_FLUSH waiters as it replays past arc_target_lsn2.
$arc_standby->safe_psql('postgres', "SELECT pg_wal_replay_resume()");
-$arc_write_session->quit;
-$arc_flush_session->quit;
-chomp($arc_write_session->{stdout});
-chomp($arc_flush_session->{stdout});
+my $arc_write_out = $arc_write_session->get_async_result();
+my $arc_flush_out = $arc_flush_session->get_async_result();
+$arc_write_session->close;
+$arc_flush_session->close;
-is($arc_write_session->{stdout},
+is($arc_write_out->{psqlout},
'success',
"standby_write waiter woken by replay on archive-only standby");
-is($arc_flush_session->{stdout},
+is($arc_flush_out->{psqlout},
'success',
"standby_flush waiter woken by replay on archive-only standby");
@@ -1035,10 +1027,8 @@ sub check_wait_for_lsn_fencepost
$rcv_primary->safe_psql('postgres',
"INSERT INTO rcv_test VALUES (generate_series(200, 210))");
-my $boundary_session = $rcv_standby->background_psql('postgres');
-$boundary_session->query_until(
- qr/start/, qq[
- \\echo start
+my $boundary_session = PostgreSQL::Test::Session->new(node => $rcv_standby);
+$boundary_session->do_async(qq[
WAIT FOR LSN '${replay_lsn_plus}'
WITH (MODE 'standby_replay', timeout '1d', no_throw);
]);
@@ -1049,9 +1039,9 @@ sub check_wait_for_lsn_fencepost
$rcv_standby->safe_psql('postgres', "SELECT pg_wal_replay_resume()");
resume_walreceiver($rcv_standby);
-$boundary_session->quit;
-chomp($boundary_session->{stdout});
-is($boundary_session->{stdout},
+my $boundary_out = $boundary_session->get_async_result();
+$boundary_session->close;
+is($boundary_out->{psqlout},
'success',
"standby_replay: waiter at current + 1 wakes when replay advances");
@@ -1101,10 +1091,8 @@ sub check_wait_for_lsn_fencepost
"SELECT pg_get_wal_replay_pause_state() = 'paused'")
or die "Timed out waiting for tl_standby2 replay to pause";
-my $tl_session = $tl_standby2->background_psql('postgres');
-$tl_session->query_until(
- qr/start/, qq[
- \\echo start
+my $tl_session = PostgreSQL::Test::Session->new(node => $tl_standby2);
+$tl_session->do_async(qq[
WAIT FOR LSN '${tl_target}'
WITH (MODE 'standby_replay', timeout '1d', no_throw);
]);
@@ -1126,9 +1114,9 @@ sub check_wait_for_lsn_fencepost
"SELECT received_tli > 1 FROM pg_stat_wal_receiver")
or die "tl_standby2 did not follow upstream timeline switch";
-$tl_session->quit;
-chomp($tl_session->{stdout});
-is($tl_session->{stdout}, 'success',
+my $tl_out = $tl_session->get_async_result();
+$tl_session->close;
+is($tl_out->{psqlout}, 'success',
"WAIT FOR LSN survives upstream promotion and timeline switch on cascade standby"
);
diff --git a/src/test/recovery/t/050_redo_segment_missing.pl b/src/test/recovery/t/050_redo_segment_missing.pl
index e07ff0c72f..b492db4468 100644
--- a/src/test/recovery/t/050_redo_segment_missing.pl
+++ b/src/test/recovery/t/050_redo_segment_missing.pl
@@ -7,6 +7,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -44,15 +45,11 @@
$node->safe_psql('postgres',
q{select injection_points_attach('create-checkpoint-run', 'wait')});
-# Start a psql session to run the checkpoint in the background and make
+# Start a session to run the checkpoint in the background and make
# the test wait on the injection point so the checkpoint stops just after
# it starts.
-my $checkpoint = $node->background_psql('postgres');
-$checkpoint->query_until(
- qr/starting_checkpoint/,
- q(\echo starting_checkpoint
-checkpoint;
-));
+my $checkpoint = PostgreSQL::Test::Session->new(node => $node);
+$checkpoint->do_async(q(CHECKPOINT;));
# Wait for the initial point to finish, the checkpointer is still
# outside its critical section. Then release to reach the second
@@ -76,7 +73,8 @@
q{select injection_points_wakeup('create-checkpoint-run')});
$node->wait_for_log(qr/checkpoint complete/, $log_offset);
-$checkpoint->quit;
+$checkpoint->wait_for_completion;
+$checkpoint->close;
# Retrieve the WAL file names for the redo record and checkpoint record.
my $redo_lsn = $node->safe_psql('postgres',
diff --git a/src/test/recovery/t/051_effective_wal_level.pl b/src/test/recovery/t/051_effective_wal_level.pl
index c45eddc738..20c00b89a2 100644
--- a/src/test/recovery/t/051_effective_wal_level.pl
+++ b/src/test/recovery/t/051_effective_wal_level.pl
@@ -6,6 +6,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -382,20 +383,15 @@ sub wait_for_logical_decoding_disabled
test_wal_level($primary, "replica|replica",
"effective_wal_level got decreased to 'replica' on primary");
- # Start a psql session to test the case where the activation process is
+ # Start a session to test the case where the activation process is
# interrupted.
- my $psql_create_slot = $primary->background_psql('postgres');
-
- # Start the logical decoding activation process upon creating the logical
- # slot, but it will wait due to the injection point.
- $psql_create_slot->query_until(
- qr/create_slot_canceled/,
- q(\echo create_slot_canceled
-select injection_points_set_local();
-select injection_points_attach('logical-decoding-activation', 'wait');
-select pg_create_logical_replication_slot('slot_canceled', 'pgoutput');
-\q
-));
+ my $psql_create_slot = PostgreSQL::Test::Session->new(node => $primary);
+
+ # Set up the injection point in this session (using set_local so it only
+ # affects this session), then start the slot creation which will block.
+ $psql_create_slot->do(q{select injection_points_set_local()});
+ $psql_create_slot->do(q{select injection_points_attach('logical-decoding-activation', 'wait')});
+ $psql_create_slot->do_async(q{select pg_create_logical_replication_slot('slot_canceled', 'pgoutput')});
$primary->wait_for_event('client backend', 'logical-decoding-activation');
note("injection_point 'logical-decoding-activation' is reached");
@@ -413,19 +409,17 @@ sub wait_for_logical_decoding_disabled
wait_for_logical_decoding_disabled($primary);
pass("the activation process aborted");
+ # Clean up the session (the async query was cancelled, so we just close)
+ $psql_create_slot->close;
+
# Test concurrent activation processes run and one is interrupted.
- $psql_create_slot = $primary->background_psql('postgres');
+ $psql_create_slot = PostgreSQL::Test::Session->new(node => $primary);
+
+ # Start a session and stop in the middle of the activation process.
+ $psql_create_slot->do(q{select injection_points_set_local()});
+ $psql_create_slot->do(q{select injection_points_attach('logical-decoding-activation', 'wait')});
+ $psql_create_slot->do_async(q{select pg_create_logical_replication_slot('slot_canceled2', 'pgoutput')});
- # Start a psql session and stops in the middle of the activation
- # process.
- $psql_create_slot->query_until(
- qr/create_slot_canceled/,
- q(\echo create_slot_canceled
-select injection_points_set_local();
-select injection_points_attach('logical-decoding-activation', 'wait');
-select pg_create_logical_replication_slot('slot_canceled2', 'pgoutput');
-\q
-));
$primary->wait_for_event('client backend', 'logical-decoding-activation');
note("injection_point 'logical-decoding-activation' is reached");
@@ -453,6 +447,9 @@ sub wait_for_logical_decoding_disabled
test_wal_level($primary, "replica|logical",
"effective_wal_level remains 'logical' even after the concurrent activation is interrupted"
);
+
+ # Clean up the session (the async query was cancelled, so we just close)
+ $psql_create_slot->close;
}
$primary->stop;
diff --git a/src/test/subscription/t/015_stream.pl b/src/test/subscription/t/015_stream.pl
index ac96bc3f00..41765faea3 100644
--- a/src/test/subscription/t/015_stream.pl
+++ b/src/test/subscription/t/015_stream.pl
@@ -5,6 +5,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -30,18 +31,17 @@ sub test_streaming
# Interleave a pair of transactions, each exceeding the 64kB limit.
my $offset = 0;
- my $h = $node_publisher->background_psql('postgres', on_error_stop => 0);
+ my $h = PostgreSQL::Test::Session->new(node=>$node_publisher);
# Check the subscriber log from now on.
$offset = -s $node_subscriber->logfile;
- $h->query_safe(
- q{
- BEGIN;
- INSERT INTO test_tab SELECT i, sha256(i::text::bytea) FROM generate_series(3, 5000) s(i);
- UPDATE test_tab SET b = sha256(b) WHERE mod(a,2) = 0;
- DELETE FROM test_tab WHERE mod(a,3) = 0;
- });
+ $h->do(
+ 'BEGIN',
+ 'INSERT INTO test_tab SELECT i, sha256(i::text::bytea) FROM generate_series(3, 5000) s(i)',
+ 'UPDATE test_tab SET b = sha256(b) WHERE mod(a,2) = 0',
+ 'DELETE FROM test_tab WHERE mod(a,3) = 0',
+ );
$node_publisher->safe_psql(
'postgres', q{
@@ -51,9 +51,9 @@ sub test_streaming
COMMIT;
});
- $h->query_safe('COMMIT');
+ $h->do('COMMIT');
# errors make the next test fail, so ignore them here
- $h->quit;
+ $h->close;
$node_publisher->wait_for_catchup($appname);
@@ -211,14 +211,14 @@ sub test_streaming
$node_subscriber->safe_psql('postgres', q{SELECT 1});
# Interleave a pair of transactions, each exceeding the 64kB limit.
-my $h = $node_publisher->background_psql('postgres', on_error_stop => 0);
+my $h = PostgreSQL::Test::Session->new(node => $node_publisher);
# Confirm if a deadlock between the leader apply worker and the parallel apply
# worker can be detected.
my $offset = -s $node_subscriber->logfile;
-$h->query_safe(
+$h->do(
q{
BEGIN;
INSERT INTO test_tab_2 SELECT i FROM generate_series(1, 5000) s(i);
@@ -232,8 +232,8 @@ sub test_streaming
$node_publisher->safe_psql('postgres', "INSERT INTO test_tab_2 values(1)");
-$h->query_safe('COMMIT');
-$h->quit;
+$h->do('COMMIT');
+$h->close;
$node_subscriber->wait_for_log(qr/ERROR: ( [A-Z0-9]+:)? deadlock detected/,
$offset);
@@ -260,7 +260,8 @@ sub test_streaming
# Check the subscriber log from now on.
$offset = -s $node_subscriber->logfile;
-$h->query_safe(
+$h->reconnect;
+$h->do(
q{
BEGIN;
INSERT INTO test_tab_2 SELECT i FROM generate_series(1, 5000) s(i);
@@ -275,8 +276,8 @@ sub test_streaming
$node_publisher->safe_psql('postgres',
"INSERT INTO test_tab_2 SELECT i FROM generate_series(1, 5000) s(i)");
-$h->query_safe('COMMIT');
-$h->quit;
+$h->do('COMMIT');
+$h->close;
$node_subscriber->wait_for_log(qr/ERROR: ( [A-Z0-9]+:)? deadlock detected/,
$offset);
diff --git a/src/test/subscription/t/035_conflicts.pl b/src/test/subscription/t/035_conflicts.pl
index f23fe6af2a..8058beeb68 100644
--- a/src/test/subscription/t/035_conflicts.pl
+++ b/src/test/subscription/t/035_conflicts.pl
@@ -4,6 +4,7 @@
use strict;
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
use PostgreSQL::Test::Utils;
use Test::More;
@@ -455,17 +456,14 @@
# Start a background session on the publisher node to perform an update and
# pause at the injection point.
- my $pub_session = $node_B->background_psql('postgres');
- $pub_session->query_until(
- qr/starting_bg_psql/,
- q{
- \echo starting_bg_psql
- BEGIN;
- UPDATE tab SET b = 2 WHERE a = 1;
- PREPARE TRANSACTION 'txn_with_later_commit_ts';
- COMMIT PREPARED 'txn_with_later_commit_ts';
- }
+ my $pub_session = PostgreSQL::Test::Session->new(node => $node_B);
+ $pub_session->do(
+ q{BEGIN},
+ q{UPDATE tab SET b = 2 WHERE a = 1},
+ q{PREPARE TRANSACTION 'txn_with_later_commit_ts'}
);
+ # COMMIT PREPARED will block on the injection point
+ $pub_session->do_async(q{COMMIT PREPARED 'txn_with_later_commit_ts'});
# Wait until the backend enters the injection point
$node_B->wait_for_event('client backend',
@@ -516,8 +514,9 @@
SELECT injection_points_detach('commit-after-delay-checkpoint');"
);
- # Close the background session on the publisher node
- ok($pub_session->quit, "close publisher session");
+ # Wait for the async query to complete and close the background session
+ $pub_session->wait_for_completion;
+ $pub_session->close;
# Confirm that the transaction committed
$result = $node_B->safe_psql('postgres', 'SELECT * FROM tab WHERE a = 1');
diff --git a/src/test/subscription/t/038_walsnd_shutdown_timeout.pl b/src/test/subscription/t/038_walsnd_shutdown_timeout.pl
index f4ed5d9785..48caf8e3da 100644
--- a/src/test/subscription/t/038_walsnd_shutdown_timeout.pl
+++ b/src/test/subscription/t/038_walsnd_shutdown_timeout.pl
@@ -8,6 +8,7 @@
use warnings FATAL => 'all';
use PostgreSQL::Test::Cluster;
use PostgreSQL::Test::Utils;
+use PostgreSQL::Test::Session;
use Test::More;
use Time::HiRes qw(usleep);
@@ -45,7 +46,7 @@
# Start a background session on the subscriber to run a transaction later
# that will block the logical apply worker on a lock.
-my $sub_session = $node_subscriber->background_psql('postgres');
+my $sub_session = PostgreSQL::Test::Session->new(node => $node_subscriber);
# Test that when the logical apply worker is blocked on a lock and replication
# is stalled, shutting down the publisher causes the logical walsender to exit
@@ -53,7 +54,7 @@
# Cause the logical apply worker to block on a lock by running conflicting
# transactions on the publisher and subscriber.
-$sub_session->query_safe("BEGIN; INSERT INTO test_tab VALUES (0);");
+$sub_session->do("BEGIN; INSERT INTO test_tab VALUES (0);");
$node_publisher->safe_psql('postgres', "INSERT INTO test_tab VALUES (0);");
my $log_offset = -s $node_publisher->logfile;
@@ -65,7 +66,7 @@
$log_offset),
"walsender exits due to wal_sender_shutdown_timeout");
-$sub_session->query_safe("ABORT;");
+$sub_session->do("ABORT;");
$node_publisher->start;
$node_publisher->wait_for_catchup('test_sub');
@@ -79,7 +80,7 @@
# Run a transaction on the subscriber that blocks the logical apply worker
# on a lock.
-$sub_session->query_safe("BEGIN; LOCK TABLE test_tab IN EXCLUSIVE MODE;");
+$sub_session->do("BEGIN; LOCK TABLE test_tab IN EXCLUSIVE MODE;");
# Generate enough data to fill the logical walsender's output buffer.
$node_publisher->safe_psql('postgres',
@@ -117,7 +118,7 @@
"walsender with full output buffer exits due to wal_sender_shutdown_timeout"
);
-$sub_session->query_safe("ABORT;");
+$sub_session->do("ABORT;");
# The next test depends on Perl's `kill`, which apparently is not
# portable to Windows. (It would be nice to use Test::More's `subtest`,
@@ -167,7 +168,7 @@
# Cause the logical apply worker to block on a lock by running conflicting
# transactions on the publisher and subscriber, stalling logical replication.
$node_publisher->wait_for_catchup('test_sub');
-$sub_session->query_safe("BEGIN; LOCK TABLE test_tab IN EXCLUSIVE MODE;");
+$sub_session->do("BEGIN; LOCK TABLE test_tab IN EXCLUSIVE MODE;");
$node_publisher->safe_psql('postgres', "INSERT INTO test_tab VALUES (-1); ");
# Cause the standby's walreceiver to be blocked with SIGSTOP signal,
@@ -193,7 +194,7 @@
);
kill 'CONT', $receiverpid;
-$sub_session->quit;
+$sub_session->close;
$node_subscriber->stop('fast');
$node_standby->stop('fast');