Subject: Re: Using LibPq in TAP tests via FFI

From: Andrew Dunstan <[email-masked]>
Date: Fri, 14 Jun 2024 11:11:38 -0400

On 2024-06-14 Fr 11:09, Andrew Dunstan wrote:
> Over at [1] Andres expressed enthusiasm for enabling TAP tests to call 
> LibPQ directly via FFI, and there was some support from others as 
> well. Attached is a very rough POC for just that.There are two perl 
> modules, one which wraps libpq (or almost all of it) in perl, and 
> another which uses that module to create a session object that can be 
> used to run SQL. Also in the patch is a modification of one TAP test 
> (arbitrarily chosen as src/bin/pg_amcheck/t/004_verify_heapam.p) to 
> use the new interface, so it doesn't use psql at all.
>
> There's a bunch of work to do here, but for a morning's work it's not 
> too bad :-) Luckily I had most of the first file already to hand.
>
> Next I plan to look at some of the recovery tests and other uses of 
> background_psql, which might be more challenging,a dn require 
> extension of the session API. Also there's a lot of error checking and 
> documentation that need to be added.
>
>
> cheers
>
>
> andrew
>
>
> [1] 
> https://postgr.es/m/[email-masked]
>
>

And here's the patch

cheers

andrew

--
Andrew Dunstan
EDB: https://www.enterprisedb.com
diff --git a/src/bin/pg_amcheck/t/004_verify_heapam.pl b/src/bin/pg_amcheck/t/004_verify_heapam.pl
index f6d2c5f787..c47ff3f939 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 strict;
 use warnings FATAL => 'all';
 
 use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Session;
 use PostgreSQL::Test::Utils;
 
 use Test::More;
@@ -190,16 +191,17 @@ $node->append_conf('postgresql.conf', 'max_prepared_transactions=10');
 $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 @@ $node->safe_psql(
 # 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 @@ my $ROWCOUNT_BASIC = 16;
 
 # 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 @@ $node->safe_psql(
 	));
 
 # 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,29 @@ $node->safe_psql(
 	));
 
 # 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
+        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 +301,12 @@ $node->safe_psql(
 		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 +315,19 @@ $node->safe_psql(
 # 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 +335,7 @@ my $datfrozenxid = $node->safe_psql('postgres',
 # 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 +344,21 @@ if ($datfrozenxid <= 3 || $datfrozenxid >= $relfrozenxid)
 
 # 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)
@@ -750,17 +764,19 @@ for (my $tupidx = 0; $tupidx < $ROWCOUNT; $tupidx++)
 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', '-p', $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/test/perl/PostgreSQL/PqFFI.pm b/src/test/perl/PostgreSQL/PqFFI.pm
new file mode 100644
index 0000000000..fac544d32c
--- /dev/null
+++ b/src/test/perl/PostgreSQL/PqFFI.pm
@@ -0,0 +1,564 @@
+
+############################################
+#
+# FFI wrapper for libpq
+#
+############################################
+package PostgreSQL::PqFFI;
+
+use strict;
+use warnings FATAL => 'all';
+
+use FFI::Platypus;
+use FFI::CheckLib;
+
+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
+
+  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
+
+  PQPING_OK
+  PQPING_REJECT
+  PQPING_NO_RESPONSE
+  PQPING_NO_ATTEMPT
+
+  PQTRANS_IDLE
+  PQTRANS_ACTIVE
+  PQTRANS_INTRANS
+  PQTRANS_INERROR
+  PQTRANS_UNKNOWN
+
+  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
+
+);
+
+# connection status
+
+use constant {
+	CONNECTION_OK => 0,
+	CONNECTION_BAD => 1,
+	# Non-blocking mode only below here
+
+	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,
+};
+
+# exec status
+
+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,
+};
+
+# ping status
+
+use constant {
+	PQPING_OK => 0,
+	PQPING_REJECT => 1,
+	PQPING_NO_RESPONSE => 2,
+	PQPING_NO_ATTEMPT => 3,
+};
+
+# txn status
+use constant {
+	PQTRANS_IDLE => 0,
+	PQTRANS_ACTIVE => 1,
+	PQTRANS_INTRANS => 2,
+	PQTRANS_INERROR => 3,
+	PQTRANS_UNKNOWN => 4,
+};
+
+# type oids
+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,
+};
+
+
+
+my @procs = qw(
+
+  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
+
+  PQprotocolVersion
+  PQserverVersion
+  PQerrorMessage
+  PQsocket
+  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
+
+);
+
+push(@EXPORT, @procs);
+
+sub setup
+{
+	my $libdir = shift;
+
+	my $ffi = FFI::Platypus->new(api => 1);
+
+	$ffi->type('opaque' => 'PGconn');
+	$ffi->type('opaque' => 'PGresult');
+	$ffi->type('uint32' => 'Oid');
+	$ffi->type('int' => 'ExecStatusType');
+
+	my $lib = find_lib_or_die(
+		lib => 'pq',
+		libpath => [$libdir],
+		systempath => [],);
+	$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('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');
+}
+
+
+1;
diff --git a/src/test/perl/PostgreSQL/Test/Session.pm b/src/test/perl/PostgreSQL/Test/Session.pm
new file mode 100644
index 0000000000..74443a9ee5
--- /dev/null
+++ b/src/test/perl/PostgreSQL/Test/Session.pm
@@ -0,0 +1,143 @@
+package PostgreSQL::Test::Session;
+
+use strict;
+use warnings FATAL => 'all';
+
+
+use PostgreSQL::PqFFI;
+
+my $setup_ok;
+
+sub setup
+{
+	return if $setup_ok;
+	my $libdir = shift;
+	PostgreSQL::PqFFI::setup($libdir);
+	$setup_ok = 1;
+}
+
+sub new
+{
+	my $class = shift;
+	my $self = {};
+	bless $self, $class;
+	my %args = @_;
+	my $node = $args{node};
+	my $dbname = $args{dbname} || 'postgres';
+	die "bad node" unless $node->isa("PostgreSQL::Test::Cluster");
+	unless ($setup_ok)
+	{
+		my $libdir = $node->config_data('--libdir');
+		setup($libdir);
+	}
+	$self->{connstr} = $node->connstr($dbname);
+	$self->{conn} = PQconnectdb($self->{connstr});
+	return $self;
+}
+
+sub close
+{
+	my $self = shift;
+	PQfinish($self->{conn});
+	delete $self->{conn};
+}
+
+sub DESTROY
+{
+	my $self = shift;
+	$self->close if $self->{conn};
+}
+
+sub reconnect
+{
+	my $self = shift;
+	$self->close if $self->{conn};
+	$self->{conn} = PQconnectdb($self->{connstr});	
+}
+
+# run some sql which doesn't return tuples
+
+sub do
+{
+	my $self = shift;
+	my $conn = $self->{conn};
+	foreach my $sql (@_)
+	{
+		my $result = PQexec($conn, $sql);
+		my $ok = $result && (PQresultStatus($result) == PGRES_COMMAND_OK);
+		PQclear($result);
+		return undef unless $ok;
+	}
+	return 1;
+}
+
+# run some sql that does return tuples
+
+sub query
+{
+	my $self = shift;
+	my $sql = shift;
+	my $conn = $self->{conn};
+	my $result = PQexec($conn, $sql);
+	my $ok = $result && (PQresultStatus($result) == PGRES_TUPLES_OK);
+	unless  ($ok)
+	{
+		PQclear($result);
+		return undef;
+	}
+	my $ntuples = PQntuples($result);
+	my $nfields = PQnfields($result);
+	my $res = {	names => [], types => [], rows => [], };
+	# 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));
+	}
+	foreach my $nrow (0.. $ntuples - 1)
+	{
+		my $row = [];
+		foreach my $field ( 0 .. $nfields)
+		{
+			my $val = PQgetvalue($result, $nrow, $field);
+			if (($val // "") eq "")
+			{
+				$val = undef if PQgetisnull($result, $nrow, $field);
+			}
+			push(@$row, $val);
+		}
+		push(@{$res->{rows}}, $row);
+	}
+	PQclear($result);
+	return $res;
+}
+
+sub query_oneval
+{
+	my $self = shift;
+	my $sql = shift;
+	my $conn = $self->{conn};
+	my $result = PQexec($conn, $sql);
+	my $ok = $result && (PQresultStatus($result) == PGRES_TUPLES_OK);
+	unless  ($ok)
+	{
+		PQclear($result);
+		return undef;
+	}
+	my $ntuples = PQntuples($result);
+	my $nfields = PQnfields($result);
+	die "$ntuples tuples != 1 or $nfields fields != 1"
+	  if $ntuples != 1 || $nfields != 1;
+	my $val = PQgetvalue($result, 0, 0);
+	if ($val eq "")
+	{
+		$val = undef if PGgetisnull($result, 0, 0);
+	}
+	PQclear($result);
+	return $val;
+	
+}
+
+1;