Refactor Perl test code

The original code was a bit clunky; make it more amenable for further
reuse by creating a new Perl package PostgresNode, which is an
object-oriented representation of a single server, with some support
routines such as init, start, stop, psql.  This serves as a better basis
on which to build further test code, and enables writing tests that use
more than one server without too much complication.

This commit modifies a lot of the existing test files, mostly to remove
explicit calls to system commands (pg_ctl) replacing them with method
calls of a PostgresNode object.  The result is quite a bit more
straightforward.

Also move some initialization code to BEGIN and INIT blocks instead of
having it straight in as top-level code.

This commit also introduces package RecursiveCopy so that we can copy
whole directories without having to depend on packages that may not be
present on vanilla Perl 5.8 installations.

I also ran perltidy on the modified files, which changes some code sites
that are not otherwise touched by this patch.  I tried to avoid this,
but it ended up being more trouble than it's worth.

Authors: Michael Paquier, Álvaro Herrera
Review: Noah Misch

1 files changed, 108 insertions, 211 deletions

diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 02533ebde53..af46dc8c7a2 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -1,3 +1,10 @@
+# TestLib, low-level routines and actions regression tests.
+#
+# This module contains a set of routines dedicated to environment setup for
+# a PostgreSQL regression test tun, and includes some low-level routines
+# aimed at controlling command execution, logging and test functions. This
+# module should never depend on any other PostgreSQL regression test modules.
+
 package TestLib;
 
 use strict;
@@ -5,16 +12,17 @@ use warnings;
 
 use Config;
 use Exporter 'import';
+use File::Basename;
+use File::Spec;
+use File::Temp ();
+use IPC::Run;
+use SimpleTee;
+use Test::More;
+
 our @EXPORT = qw(
-  tempdir
-  tempdir_short
-  standard_initdb
-  configure_hba_for_replication
-  start_test_server
-  restart_test_server
-  psql
   slurp_dir
   slurp_file
+  append_to_file
   system_or_bail
   system_log
   run_log
@@ -26,88 +34,82 @@ our @EXPORT = qw(
   program_version_ok
   program_options_handling_ok
   command_like
-  issues_sql_like
 
-  $tmp_check
-  $log_path
   $windows_os
 );
 
-use Cwd;
-use File::Basename;
-use File::Spec;
-use File::Temp ();
-use IPC::Run qw(run start);
+our ($windows_os, $tmp_check, $log_path, $test_logfile);
 
-use SimpleTee;
-
-use Test::More;
-
-our $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
-
-# Open log file. For each test, the log file name uses the name of the
-# file launching this module, without the .pl suffix.
-our ($tmp_check, $log_path);
-$tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check";
-$log_path = "$tmp_check/log";
-mkdir $tmp_check;
-mkdir $log_path;
-my $test_logfile = basename($0);
-$test_logfile =~ s/\.[^.]+$//;
-$test_logfile = "$log_path/regress_log_$test_logfile";
-open TESTLOG, '>', $test_logfile or die "Cannot open STDOUT to logfile: $!";
-
-# Hijack STDOUT and STDERR to the log file
-open(ORIG_STDOUT, ">&STDOUT");
-open(ORIG_STDERR, ">&STDERR");
-open(STDOUT, ">&TESTLOG");
-open(STDERR, ">&TESTLOG");
-
-# The test output (ok ...) needs to be printed to the original STDOUT so
-# that the 'prove' program can parse it, and display it to the user in
-# real time. But also copy it to the log file, to provide more context
-# in the log.
-my $builder = Test::More->builder;
-my $fh = $builder->output;
-tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG;
-$fh = $builder->failure_output;
-tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG;
-
-# Enable auto-flushing for all the file handles. Stderr and stdout are
-# redirected to the same file, and buffering causes the lines to appear
-# in the log in confusing order.
-autoflush STDOUT 1;
-autoflush STDERR 1;
-autoflush TESTLOG 1;
-
-# Set to untranslated messages, to be able to compare program output
-# with expected strings.
-delete $ENV{LANGUAGE};
-delete $ENV{LC_ALL};
-$ENV{LC_MESSAGES} = 'C';
-
-delete $ENV{PGCONNECT_TIMEOUT};
-delete $ENV{PGDATA};
-delete $ENV{PGDATABASE};
-delete $ENV{PGHOSTADDR};
-delete $ENV{PGREQUIRESSL};
-delete $ENV{PGSERVICE};
-delete $ENV{PGSSLMODE};
-delete $ENV{PGUSER};
-
-if (!$ENV{PGPORT})
+BEGIN
 {
-	$ENV{PGPORT} = 65432;
+
+	# Set to untranslated messages, to be able to compare program output
+	# with expected strings.
+	delete $ENV{LANGUAGE};
+	delete $ENV{LC_ALL};
+	$ENV{LC_MESSAGES} = 'C';
+
+	delete $ENV{PGCONNECT_TIMEOUT};
+	delete $ENV{PGDATA};
+	delete $ENV{PGDATABASE};
+	delete $ENV{PGHOSTADDR};
+	delete $ENV{PGREQUIRESSL};
+	delete $ENV{PGSERVICE};
+	delete $ENV{PGSSLMODE};
+	delete $ENV{PGUSER};
+	delete $ENV{PGPORT};
+	delete $ENV{PGHOST};
+
+	# Must be set early
+	$windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
 }
 
-$ENV{PGPORT} = int($ENV{PGPORT}) % 65536;
+INIT
+{
 
+	# Determine output directories, and create them.  The base path is the
+	# TESTDIR environment variable, which is normally set by the invoking
+	# Makefile.
+	$tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check";
+	$log_path = "$tmp_check/log";
+
+	mkdir $tmp_check;
+	mkdir $log_path;
+
+	# Open the test log file, whose name depends on the test name.
+	$test_logfile = basename($0);
+	$test_logfile =~ s/\.[^.]+$//;
+	$test_logfile = "$log_path/regress_log_$test_logfile";
+	open TESTLOG, '>', $test_logfile
+	  or die "could not open STDOUT to logfile \"$test_logfile\": $!";
+
+	# Hijack STDOUT and STDERR to the log file
+	open(ORIG_STDOUT, ">&STDOUT");
+	open(ORIG_STDERR, ">&STDERR");
+	open(STDOUT,      ">&TESTLOG");
+	open(STDERR,      ">&TESTLOG");
+
+	# The test output (ok ...) needs to be printed to the original STDOUT so
+	# that the 'prove' program can parse it, and display it to the user in
+	# real time. But also copy it to the log file, to provide more context
+	# in the log.
+	my $builder = Test::More->builder;
+	my $fh      = $builder->output;
+	tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG;
+	$fh = $builder->failure_output;
+	tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG;
+
+	# Enable auto-flushing for all the file handles. Stderr and stdout are
+	# redirected to the same file, and buffering causes the lines to appear
+	# in the log in confusing order.
+	autoflush STDOUT 1;
+	autoflush STDERR 1;
+	autoflush TESTLOG 1;
+}
 
 #
 # Helper functions
 #
-
-
 sub tempdir
 {
 	return File::Temp::tempdir(
@@ -124,117 +126,31 @@ sub tempdir_short
 	return File::Temp::tempdir(CLEANUP => 1);
 }
 
-# Initialize a new cluster for testing.
-#
-# The PGHOST environment variable is set to connect to the new cluster.
-#
-# Authentication is set up so that only the current OS user can access the
-# cluster. On Unix, we use Unix domain socket connections, with the socket in
-# a directory that's only accessible to the current user to ensure that.
-# On Windows, we use SSPI authentication to ensure the same (by pg_regress
-# --config-auth).
-sub standard_initdb
-{
-	my $pgdata = shift;
-	system_or_bail('initdb', '-D', "$pgdata", '-A' , 'trust', '-N');
-	system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
-
-	my $tempdir_short = tempdir_short;
-
-	open CONF, ">>$pgdata/postgresql.conf";
-	print CONF "\n# Added by TestLib.pm)\n";
-	print CONF "fsync = off\n";
-	if ($windows_os)
-	{
-		print CONF "listen_addresses = '127.0.0.1'\n";
-	}
-	else
-	{
-		print CONF "unix_socket_directories = '$tempdir_short'\n";
-		print CONF "listen_addresses = ''\n";
-	}
-	close CONF;
-
-	$ENV{PGHOST}         = $windows_os ? "127.0.0.1" : $tempdir_short;
-}
-
-# Set up the cluster to allow replication connections, in the same way that
-# standard_initdb does for normal connections.
-sub configure_hba_for_replication
-{
-	my $pgdata = shift;
-
-	open HBA, ">>$pgdata/pg_hba.conf";
-	print HBA "\n# Allow replication (set up by TestLib.pm)\n";
-	if (! $windows_os)
-	{
-		print HBA "local replication all trust\n";
-	}
-	else
-	{
-		print HBA "host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n";
-	}
-	close HBA;
-}
-
-my ($test_server_datadir, $test_server_logfile);
-
-
-# Initialize a new cluster for testing in given directory, and start it.
-sub start_test_server
-{
-	my ($tempdir) = @_;
-	my $ret;
-
-	print("### Starting test server in $tempdir\n");
-	standard_initdb "$tempdir/pgdata";
-
-	$ret = system_log('pg_ctl', '-D', "$tempdir/pgdata", '-w', '-l',
-	  "$log_path/postmaster.log", '-o', "--log-statement=all",
-	  'start');
-
-	if ($ret != 0)
-	{
-		print "# pg_ctl failed; logfile:\n";
-		system('cat', "$log_path/postmaster.log");
-		BAIL_OUT("pg_ctl failed");
-	}
-
-	$test_server_datadir = "$tempdir/pgdata";
-	$test_server_logfile = "$log_path/postmaster.log";
-}
-
-sub restart_test_server
+sub system_log
 {
-	print("### Restarting test server\n");
-	system_log('pg_ctl', '-D', $test_server_datadir, '-w', '-l',
-	  $test_server_logfile, 'restart');
+	print("# Running: " . join(" ", @_) . "\n");
+	return system(@_);
 }
 
-END
+sub system_or_bail
 {
-	if ($test_server_datadir)
+	if (system_log(@_) != 0)
 	{
-		system_log('pg_ctl', '-D', $test_server_datadir, '-m',
-		  'immediate', 'stop');
+		BAIL_OUT("system $_[0] failed");
 	}
 }
 
-sub psql
+sub run_log
 {
-	my ($dbname, $sql) = @_;
-	my ($stdout, $stderr);
-	print("# Running SQL command: $sql\n");
-	run [ 'psql', '-X', '-A', '-t', '-q', '-d', $dbname, '-f', '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr or die;
-	chomp $stdout;
-	$stdout =~ s/\r//g if $Config{osname} eq 'msys';
-	return $stdout;
+	print("# Running: " . join(" ", @{ $_[0] }) . "\n");
+	return run(@_);
 }
 
 sub slurp_dir
 {
 	my ($dir) = @_;
-	opendir(my $dh, $dir) or die;
+	opendir(my $dh, $dir)
+	  or die "could not opendir \"$dir\": $!";
 	my @direntries = readdir $dh;
 	closedir $dh;
 	return @direntries;
@@ -249,32 +165,18 @@ sub slurp_file
 	return $contents;
 }
 
-sub system_or_bail
-{
-	if (system_log(@_) != 0)
-	{
-		BAIL_OUT("system $_[0] failed: $?");
-	}
-}
-
-sub system_log
+sub append_to_file
 {
-	print("# Running: " . join(" ", @_) ."\n");
-	return system(@_);
-}
+	my ($filename, $str) = @_;
 
-sub run_log
-{
-	print("# Running: " . join(" ", @{$_[0]}) ."\n");
-	return run (@_);
+	open my $fh, ">>", $filename or die "could not open \"$filename\": $!";
+	print $fh $str;
+	close $fh;
 }
 
-
 #
 # Test functions
 #
-
-
 sub command_ok
 {
 	my ($cmd, $test_name) = @_;
@@ -292,8 +194,8 @@ sub command_fails
 sub command_exit_is
 {
 	my ($cmd, $expected, $test_name) = @_;
-	print("# Running: " . join(" ", @{$cmd}) ."\n");
-	my $h = start $cmd;
+	print("# Running: " . join(" ", @{$cmd}) . "\n");
+	my $h = IPC::Run::start $cmd;
 	$h->finish();
 
 	# On Windows, the exit status of the process is returned directly as the
@@ -303,8 +205,10 @@ sub command_exit_is
 	# assuming the Unix convention, which will always return 0 on Windows as
 	# long as the process was not terminated by an exception. To work around
 	# that, use $h->full_result on Windows instead.
-	my $result = ($Config{osname} eq "MSWin32") ?
-		($h->full_results)[0] : $h->result(0);
+	my $result =
+	    ($Config{osname} eq "MSWin32")
+	  ? ($h->full_results)[0]
+	  : $h->result(0);
 	is($result, $expected, $test_name);
 }
 
@@ -313,7 +217,8 @@ sub program_help_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --help\n");
-	my $result = run [ $cmd, '--help' ], '>', \$stdout, '2>', \$stderr;
+	my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>',
+	  \$stderr;
 	ok($result, "$cmd --help exit code 0");
 	isnt($stdout, '', "$cmd --help goes to stdout");
 	is($stderr, '', "$cmd --help nothing to stderr");
@@ -324,7 +229,8 @@ sub program_version_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --version\n");
-	my $result = run [ $cmd, '--version' ], '>', \$stdout, '2>', \$stderr;
+	my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>',
+	  \$stderr;
 	ok($result, "$cmd --version exit code 0");
 	isnt($stdout, '', "$cmd --version goes to stdout");
 	is($stderr, '', "$cmd --version nothing to stderr");
@@ -335,8 +241,9 @@ sub program_options_handling_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --not-a-valid-option\n");
-	my $result = run [ $cmd, '--not-a-valid-option' ], '>', \$stdout, '2>',
-	  \$stderr;
+	my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>',
+	  \$stdout,
+	  '2>', \$stderr;
 	ok(!$result, "$cmd with invalid option nonzero exit code");
 	isnt($stderr, '', "$cmd with invalid option prints error message");
 }
@@ -346,20 +253,10 @@ sub command_like
 	my ($cmd, $expected_stdout, $test_name) = @_;
 	my ($stdout, $stderr);
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $result = run $cmd, '>', \$stdout, '2>', \$stderr;
+	my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
 	ok($result, "@$cmd exit code 0");
 	is($stderr, '', "@$cmd no stderr");
 	like($stdout, $expected_stdout, "$test_name: matches");
 }
 
-sub issues_sql_like
-{
-	my ($cmd, $expected_sql, $test_name) = @_;
-	truncate $test_server_logfile, 0;
-	my $result = run_log($cmd);
-	ok($result, "@$cmd exit code 0");
-	my $log = slurp_file($test_server_logfile);
-	like($log, $expected_sql, "$test_name: SQL found in server log");
-}
-
 1;