Testpq/tap pq session/v15

.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}}

config/check_modules.pl

@@ -13,13 +13,18 @@
 
 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;
 use Time::HiRes 1.52;
 
 # 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");
 

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

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)])

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,19 +148,16 @@ 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
 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);
 }
 

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();

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,37 +37,51 @@
 # 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]]');
 ));
 
 $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,18 +124,18 @@
 ));
 $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;
 CREATE INDEX CONCURRENTLY ginidx ON tbl USING gin(j);
 ));
 
 $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')));