v14-0001-Introduce-TAP-test-for-CIC.patch

From c776952049b52b484cf11e2db24233882adc5493 Mon Sep 17 00:00:00 2001
From: Andrey Borodin <amborodin@acm.org>
Date: Mon, 26 Jul 2021 15:46:01 +0500
Subject: [PATCH v14 1/6] Introduce TAP test for CIC

Implement some pgbench probablistic testing to stress out CREATE INDEX CONCURRENTLY.
---
 contrib/amcheck/t/002_cic.pl  |  82 ++++++++++++++++++++++
 src/test/perl/PostgresNode.pm | 126 ++++++++++++++++++++++++++++++++++
 2 files changed, 208 insertions(+)
 create mode 100644 contrib/amcheck/t/002_cic.pl

diff --git a/contrib/amcheck/t/002_cic.pl b/contrib/amcheck/t/002_cic.pl
new file mode 100644
index 0000000000..31ce1a9a9c
--- /dev/null
+++ b/contrib/amcheck/t/002_cic.pl
@@ -0,0 +1,82 @@
+
+# Copyright (c) 2021, PostgreSQL Global Development Group
+
+# Test for CREATE INDEX CONCURRENTLY
+use strict;
+use warnings;
+
+use Config;
+use PostgresNode;
+use TestLib;
+
+use Test::More tests => 4;
+
+my ($node, $result);
+
+#
+# Test set-up
+#
+$node = PostgresNode->new('CIC_test');
+$node->init;
+$node->append_conf('postgresql.conf', 'lock_timeout = 5000');
+$node->start;
+$node->safe_psql('postgres', q(CREATE EXTENSION amcheck));
+$node->safe_psql('postgres', q(CREATE TABLE tbl(i int)));
+$node->safe_psql('postgres', q(CREATE INDEX idx on tbl(i)));
+
+#
+# Stress CIC with pgbench
+#
+
+# Run background pgbench with CIC. We cannot mix-in this script into single pgbench:
+# CIC will deadlock with itself occasionally.
+my $pgbench_in  = '';
+my $pgbench_out = '';
+my $pgbench_timer = IPC::Run::timeout(180);
+my $pgbench_h = $node->background_pgbench('postgres', \$pgbench_in, \$pgbench_out, $pgbench_timer,
+	{
+		'002_pgbench_concurrent_cic' =>
+		  q(
+			REINDEX INDEX CONCURRENTLY idx;
+			SELECT bt_index_check('idx',true);
+		   )
+	},
+	'--no-vacuum --client=1 --transactions=200');
+
+# Run pgbench.
+$node->pgbench(
+	'--no-vacuum --client=5 --transactions=200',
+	0,
+	[qr{actually processed}],
+	[qr{^$}],
+	'concurrent transactions',
+	{
+		'002_pgbench_concurrent_transaction' =>
+		  q(
+			BEGIN;
+			SELECT pg_sleep(0.001);
+			INSERT INTO tbl VALUES(0);
+			COMMIT;
+		  ),
+		'002_pgbench_concurrent_transaction_savepoints' =>
+		  q(
+			BEGIN;
+			SELECT pg_sleep(0.001);
+			SAVEPOINT s1;
+			SELECT pg_sleep(0.001);
+			INSERT INTO tbl VALUES(0);
+			COMMIT;
+		  )
+	});
+
+$pgbench_h->pump_nb;
+$pgbench_h->finish();
+$result = ($Config{osname} eq "MSWin32")
+	  ? ($pgbench_h->full_results)[0]
+	  : $pgbench_h->result(0);
+is($result, 0, "pgbench with CIC works");
+
+# done
+$node->safe_psql('postgres', q(DROP TABLE tbl;));
+$node->stop;
+done_testing();
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 8158ea5b2f..631eb5618e 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -1912,6 +1912,132 @@ sub background_psql
 
 =pod
 
+=item $node->pgbench($opts, $stat, $out, $err, $name, $files, @args)
+
+Invoke pgbench, with parameters and files.
+
+=over
+
+=item $opts
+
+Options as a string to be split on spaces.
+
+=item $stat
+
+Expected exit status.
+
+=item $out
+
+Reference to a regexp list that must match stdout.
+
+=item $err
+
+Reference to a regexp list that must match stderr.
+
+=item $name
+
+Name of test for error messages.
+
+=item $files
+
+Reference to filename/contents dictionary.
+
+=item @args
+
+Further raw options or arguments.
+
+=back
+
+=cut
+sub pgbench
+{
+	my ($self, $opts, $stat, $out, $err, $name, $files, @args) = @_;
+	my @cmd = ('pgbench', split /\s+/, $opts);
+	my @filenames = ();
+	if (defined $files)
+	{
+
+		# note: files are ordered for determinism
+		for my $fn (sort keys %$files)
+		{
+			my $filename = $self->basedir . '/' . $fn;
+			push @cmd, '-f', $filename;
+
+			# cleanup file weight
+			$filename =~ s/\@\d+$//;
+
+			#push @filenames, $filename;
+			# filenames are expected to be unique on a test
+			if (-e $filename)
+			{
+				ok(0, "$filename must not already exist");
+				unlink $filename or die "cannot unlink $filename: $!";
+			}
+			TestLib::append_to_file($filename, $$files{$fn});
+		}
+	}
+
+	push @cmd, @args;
+
+	$self->command_checks_all(\@cmd, $stat, $out, $err, $name);
+
+	# cleanup?
+	#unlink @filenames or die "cannot unlink files (@filenames): $!";
+
+	return;
+}
+=pod
+
+=item $node->background_pgbench($dbname, \$stdin, \$stdout, $timer, $files, %opts) => harness
+
+Invoke B<pgbench> in background alike background_psql.
+
+=cut
+sub background_pgbench
+{
+	my ($self, $dbname, $stdin, $stdout, $timer, $files, $opts) = @_;
+
+	my @cmd = ('pgbench', split /\s+/, $opts);
+	my @filenames = ();
+	if (defined $files)
+	{
+
+		# note: files are ordered for determinism
+		for my $fn (sort keys %$files)
+		{
+			my $filename = $self->basedir . '/' . $fn;
+			push @cmd, '-f', $filename;
+
+			# cleanup file weight
+			$filename =~ s/\@\d+$//;
+
+			#push @filenames, $filename;
+			# filenames are expected to be unique on a test
+			if (-e $filename)
+			{
+				ok(0, "$filename must not already exist");
+				unlink $filename or die "cannot unlink $filename: $!";
+			}
+			TestLib::append_to_file($filename, $$files{$fn});
+		}
+	}
+
+	local %ENV = $self->_get_env();
+
+	# Ensure there is no data waiting to be sent:
+	$$stdin = "" if ref($stdin);
+	# IPC::Run would otherwise append to existing contents:
+	$$stdout = "" if ref($stdout);
+
+	my $harness = IPC::Run::start \@cmd,
+	  '<', $stdin, '>', $stdout, $timer;
+
+	# Not checking actual input unlike in background_psql
+
+	return $harness;
+}
+=pod
+
 =item $node->interactive_psql($dbname, \$stdin, \$stdout, $timer, %params) => harness
 
 Invoke B<psql> on B<$dbname> and return an IPC::Run harness object,
-- 
2.24.3 (Apple Git-128)