Add basic TAP tests for psql's tab-completion logic.

Up to now, psql's tab-complete.c has had exactly no regression test
coverage.  This patch is an experimental attempt to add some.

This needs Perl's IO::Pty module, which isn't installed everywhere,
so the test script just skips all tests if that's not present.
There may be other portability gotchas too, so I await buildfarm
results with interest.

So far this just covers a few very basic keyword-completion and
query-driven-completion scenarios, which should be enough to let us
get a feel for whether this is practical at all from a portability
standpoint.  If it is, there's lots more that can be done.

Discussion: https://postgr.es/m/10967.1577562752@sss.pgh.pa.us

5 files changed, 201 insertions, 1 deletions

diff --git a/src/Makefile.global.in b/src/Makefile.global.in
index 05b66380e0..5002c47764 100644
--- a/src/Makefile.global.in
+++ b/src/Makefile.global.in
@@ -185,6 +185,7 @@ with_perl	= @with_perl@
 with_python	= @with_python@
 with_tcl	= @with_tcl@
 with_openssl	= @with_openssl@
+with_readline	= @with_readline@
 with_selinux	= @with_selinux@
 with_systemd	= @with_systemd@
 with_gssapi	= @with_gssapi@
diff --git a/src/bin/psql/.gitignore b/src/bin/psql/.gitignore
index c2862b12d6..10b6dd3a6b 100644
--- a/src/bin/psql/.gitignore
+++ b/src/bin/psql/.gitignore
@@ -1,5 +1,5 @@
 /psqlscanslash.c
 /sql_help.h
 /sql_help.c
-
 /psql
+/tmp_check/
diff --git a/src/bin/psql/Makefile b/src/bin/psql/Makefile
index 8a39092f8a..2305d93e39 100644
--- a/src/bin/psql/Makefile
+++ b/src/bin/psql/Makefile
@@ -16,6 +16,9 @@ subdir = src/bin/psql
 top_builddir = ../../..
 include $(top_builddir)/src/Makefile.global
 
+# make this available to TAP test scripts
+export with_readline
+
 REFDOCDIR= $(top_srcdir)/doc/src/sgml/ref
 
 override CPPFLAGS := -I. -I$(srcdir) -I$(libpq_srcdir) $(CPPFLAGS)
@@ -73,8 +76,15 @@ uninstall:
 
 clean distclean:
 	rm -f psql$(X) $(OBJS) lex.backup
+	rm -rf tmp_check
 
 # files removed here are supposed to be in the distribution tarball,
 # so do not clean them in the clean/distclean rules
 maintainer-clean: distclean
 	rm -f sql_help.h sql_help.c psqlscanslash.c
+
+check:
+	$(prove_check)
+
+installcheck:
+	$(prove_installcheck)
diff --git a/src/bin/psql/t/010_tab_completion.pl b/src/bin/psql/t/010_tab_completion.pl
new file mode 100644
index 0000000000..1c7610ffac
--- /dev/null
+++ b/src/bin/psql/t/010_tab_completion.pl
@@ -0,0 +1,122 @@
+use strict;
+use warnings;
+
+use PostgresNode;
+use TestLib;
+use Test::More;
+use IPC::Run qw(pump finish timer);
+
+if ($ENV{with_readline} ne 'yes')
+{
+	plan skip_all => 'readline is not supported by this build';
+}
+
+# If we don't have IO::Pty, forget it, because IPC::Run depends on that
+# to support pty connections
+eval { require IO::Pty; };
+if ($@)
+{
+	plan skip_all => 'IO::Pty is needed to run this test';
+}
+
+# start a new server
+my $node = get_new_node('main');
+$node->init;
+$node->start;
+
+# set up a few database objects
+$node->safe_psql('postgres',
+	    "CREATE TABLE tab1 (f1 int, f2 text);\n"
+	  . "CREATE TABLE mytab123 (f1 int, f2 text);\n"
+	  . "CREATE TABLE mytab246 (f1 int, f2 text);\n");
+
+# Developers would not appreciate this test adding a bunch of junk to
+# their ~/.psql_history, so be sure to redirect history into a temp file.
+# We might as well put it in the test log directory, so that buildfarm runs
+# capture the result for possible debugging purposes.
+my $historyfile = "${TestLib::log_path}/010_psql_history.txt";
+$ENV{PSQL_HISTORY} = $historyfile;
+
+# fire up an interactive psql session
+my $in  = '';
+my $out = '';
+
+my $timer = timer(5);
+
+my $h = $node->interactive_psql('postgres', \$in, \$out, $timer);
+
+ok($out =~ /psql/, "print startup banner");
+
+# Simple test case: type something and see if psql responds as expected
+sub check_completion
+{
+	my ($send, $pattern, $annotation) = @_;
+
+	# reset output collector
+	$out = "";
+	# restart per-command timer
+	$timer->start(5);
+	# send the data to be sent
+	$in .= $send;
+	# wait ...
+	pump $h until ($out =~ m/$pattern/ || $timer->is_expired);
+	my $okay = ($out =~ m/$pattern/ && !$timer->is_expired);
+	ok($okay, $annotation);
+	# for debugging, log actual output if it didn't match
+	note 'Actual output was "' . $out . "\"\n" if !$okay;
+}
+
+# Clear query buffer to start over
+# (won't work if we are inside a string literal!)
+sub clear_query
+{
+	check_completion("\\r\n", "postgres=# ", "\\r works");
+}
+
+# check basic command completion: SEL<tab> produces SELECT<space>
+check_completion("SEL\t", "SELECT ", "complete SEL<tab> to SELECT");
+
+clear_query();
+
+# check case variation is honored
+check_completion("sel\t", "select ", "complete sel<tab> to select");
+
+# check basic table name completion
+check_completion("* from t\t", "\\* from tab1 ", "complete t<tab> to tab1");
+
+clear_query();
+
+# check table name completion with multiple alternatives
+# note: readline might print a bell before the completion
+check_completion(
+	"select * from my\t",
+	"select \\* from my\a?tab",
+	"complete my<tab> to mytab when there are multiple choices");
+
+# some versions of readline/libedit require two tabs here, some only need one
+check_completion("\t\t", "mytab123 +mytab246",
+	"offer multiple table choices");
+
+check_completion("2\t", "246 ",
+	"finish completion of one of multiple table choices");
+
+clear_query();
+
+# check case-sensitive keyword replacement
+# XXX the output here might vary across readline versions
+check_completion(
+	"\\DRD\t",
+	"\\DRD\b\b\bdrds ",
+	"complete \\DRD<tab> to \\drds");
+
+clear_query();
+
+# send psql an explicit \q to shut it down, else pty won't close properly
+$timer->start(5);
+$in .= "\\q\n";
+finish $h or die "psql returned $?";
+$timer->reset;
+
+# done
+$node->stop;
+done_testing();
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 270bd6c856..2e0cf4a2f3 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -1534,6 +1534,73 @@ sub psql
 
 =pod
 
+=item $node->interactive_psql($dbname, \$stdin, \$stdout, $timer, %params) => harness
+
+Invoke B<psql> on B<$dbname> and return an IPC::Run harness object,
+which the caller may use to send interactive input to B<psql>.
+The process's stdin is sourced from the $stdin scalar reference,
+and its stdout and stderr go to the $stdout scalar reference.
+ptys are used so that psql thinks it's being called interactively.
+
+The specified timer object is attached to the harness, as well.
+It's caller's responsibility to select the timeout length, and to
+restart the timer after each command if the timeout is per-command.
+
+psql is invoked in tuples-only unaligned mode with reading of B<.psqlrc>
+disabled.  That may be overridden by passing extra psql parameters.
+
+Dies on failure to invoke psql, or if psql fails to connect.
+Errors occurring later are the caller's problem.
+
+Be sure to "finish" the harness when done with it.
+
+The only extra parameter currently accepted is
+
+=over
+
+=item extra_params => ['--single-transaction']
+
+If given, it must be an array reference containing additional parameters to B<psql>.
+
+=back
+
+This requires IO::Pty in addition to IPC::Run.
+
+=cut
+
+sub interactive_psql
+{
+	my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_;
+
+	my @psql_params = ('psql', '-XAt', '-d', $self->connstr($dbname));
+
+	push @psql_params, @{ $params{extra_params} }
+	  if defined $params{extra_params};
+
+	# 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 \@psql_params,
+	  '<pty<', $stdin, '>pty>', $stdout, $timer;
+
+	# Pump until we see psql's help banner.  This ensures that callers
+	# won't write anything to the pty before it's ready, avoiding an
+	# implementation issue in IPC::Run.  Also, it means that psql
+	# connection failures are caught here, relieving callers of
+	# the need to handle those.  (Right now, we have no particularly
+	# good handling for errors anyway, but that might be added later.)
+	pump $harness
+	  until $$stdout =~ /Type "help" for help/ || $timer->is_expired;
+
+	die "psql startup timed out" if $timer->is_expired;
+
+	return $harness;
+}
+
+=pod
+
 =item $node->poll_query_until($dbname, $query [, $expected ])
 
 Run B<$query> repeatedly, until it returns the B<$expected> result