Hi all
I've been working with the new TAP tests for recovery and have a number of
enhancements I'd like to make to the tooling to make writing tests easier
and nicer. I've also included two improvements proposed by Kyotaro
HORIGUCHI in the prior thread about the now-committed TAP recovery tests.
I developed these changes as part of testing failover slots and logical
decoding timeline following, where I found a need for better control over
psql, the ability to make filesystem level backups, etc. It doesn't make
sense to try to jam all that into my test script when it belongs in the
infrastructure.
Patches attached, each explains what it does and what for.
--
Craig Ringer http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Training & Services
From 26fdff1b8f76f3c47d4e19be7c4aef3cdcd3393c Mon Sep 17 00:00:00 2001
From: Andrew Dunstan <and...@dunslane.net>
Date: Sun, 28 Feb 2016 09:38:43 -0500
Subject: [PATCH 1/7] Allow multiple --temp-config arguments to pg_regress
This means that if, for example, TEMP_CONFIG is set and a Makefile
explicitly sets a temp-config file, both will now be used.
Patch from John Gorman.
---
src/test/regress/pg_regress.c | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/src/test/regress/pg_regress.c b/src/test/regress/pg_regress.c
index a1902fe..416829d 100644
--- a/src/test/regress/pg_regress.c
+++ b/src/test/regress/pg_regress.c
@@ -80,7 +80,7 @@ static char *encoding = NULL;
static _stringlist *schedulelist = NULL;
static _stringlist *extra_tests = NULL;
static char *temp_instance = NULL;
-static char *temp_config = NULL;
+static _stringlist *temp_configs = NULL;
static bool nolocale = false;
static bool use_existing = false;
static char *hostname = NULL;
@@ -2117,7 +2117,7 @@ regression_main(int argc, char *argv[], init_function ifunc, test_function tfunc
split_to_stringlist(strdup(optarg), ", ", &extraroles);
break;
case 19:
- temp_config = strdup(optarg);
+ add_stringlist_item(&temp_configs, optarg);
break;
case 20:
use_existing = true;
@@ -2249,8 +2249,9 @@ regression_main(int argc, char *argv[], init_function ifunc, test_function tfunc
fputs("log_temp_files = 128kB\n", pg_conf);
fputs("max_prepared_transactions = 2\n", pg_conf);
- if (temp_config != NULL)
+ for (sl = temp_configs; sl != NULL; sl = sl->next)
{
+ char *temp_config = sl->str;
FILE *extra_conf;
char line_buf[1024];
--
2.1.0
From 8fd42e646327c2d18c102c87f8785d17145913c3 Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:06:47 +0800
Subject: [PATCH 2/7] TAP: Add filtering to RecursiveCopy
Allow RecursiveCopy to accept a filter function so callers can
exclude unwanted files. Also POD-ify it.
---
src/test/perl/RecursiveCopy.pm | 76 ++++++++++++++++++++++++++++++++++++++----
1 file changed, 70 insertions(+), 6 deletions(-)
diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm
index 9362aa8..97f84e5 100644
--- a/src/test/perl/RecursiveCopy.pm
+++ b/src/test/perl/RecursiveCopy.pm
@@ -1,4 +1,18 @@
-# RecursiveCopy, a simple recursive copy implementation
+
+=pod
+
+=head1 NAME
+
+RecursiveCopy - simple recursive copy implementation
+
+=head1 SYNOPSIS
+
+use RecursiveCopy;
+
+RecursiveCopy::copypath($from, $to);
+
+=cut
+
package RecursiveCopy;
use strict;
@@ -7,10 +21,56 @@ use warnings;
use File::Basename;
use File::Copy;
+=pod
+
+=head2 copypath($from, $to)
+
+Copy all files and directories from $from to $to. Raises an exception
+if a file would be overwritten, the source dir can't be read, or any
+I/O operation fails. Always returns true. On failure the copy may be
+in some incomplete state; no cleanup is attempted.
+
+If the keyword param 'filterfn' is defined it's invoked as a sub that
+returns true if the file/directory should be copied, false otherwise.
+The passed path is the full path to the file relative to the source
+directory.
+
+e.g.
+
+RecursiveCopy::copypath('/some/path', '/empty/dir',
+ filterfn => sub {^
+ # omit children of pg_log
+ my $src = shift;
+ return ! $src ~= /\/pg_log\//
+ }
+);
+
+=cut
+
sub copypath
{
- my $srcpath = shift;
- my $destpath = shift;
+ my ($srcpath, $destpath, %params) = @_;
+
+ die("if specified, 'filterfn' must be a sub ref")
+ if defined $params{filterfn} && !ref $params{filterfn};
+
+ my $filterfn;
+ if (defined $params{filterfn})
+ {
+ $filterfn = $params{filterfn};
+ }
+ else
+ {
+ $filterfn = sub { return 1; };
+ }
+
+ return _copypath_recurse($srcpath, $destpath, $filterfn);
+}
+
+# Recursive private guts of copypath
+sub _copypath_recurse
+{
+ my ($srcpath, $destpath, $filterfn) = @_;
die "Cannot operate on symlinks" if -l $srcpath or -l $destpath;
@@ -19,8 +79,11 @@ sub copypath
die "Destination path $destpath exists as file" if -f $destpath;
if (-f $srcpath)
{
- copy($srcpath, $destpath)
- or die "copy $srcpath -> $destpath failed: $!";
+ if ($filterfn->($srcpath))
+ {
+ copy($srcpath, $destpath)
+ or die "copy $srcpath -> $destpath failed: $!";
+ }
return 1;
}
@@ -32,7 +95,8 @@ sub copypath
while (my $entry = readdir($directory))
{
next if ($entry eq '.' || $entry eq '..');
- RecursiveCopy::copypath("$srcpath/$entry", "$destpath/$entry")
+ RecursiveCopy::_copypath_recurse("$srcpath/$entry",
+ "$destpath/$entry", $filterfn)
or die "copypath $srcpath/$entry -> $destpath/$entry failed";
}
closedir($directory);
--
2.1.0
From 6ad042a28bf61902765c14f1c48c72251d98a3ea Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:08:21 +0800
Subject: [PATCH 3/7] TAP: Add easier, more flexible ways to invoke psql
The PostgresNode::psql method is limited - it offers no access
to the return code from psql, ignores SQL errors, and offers
no access to psql's stderr.
Provide a new psql_expert that addresses those limitations and
can be used more flexibly - see the embedded PerlDoc for details.
Also add a new psql_check method that invokes psql and dies if
the SQL fails with any error. Test scripts should use this so
they automatically die if SQL that should succeed fails instead;
with the current psql method such failures would go undetected.
---
src/test/perl/PostgresNode.pm | 233 +++++++++++++++++++++++++++++++++++++++---
1 file changed, 221 insertions(+), 12 deletions(-)
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index a8e6f0c..c18c94a 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -21,8 +21,20 @@ PostgresNode - class representing PostgreSQL server instance
$node->restart('fast');
# run a query with psql
- # like: psql -qAXt postgres -c 'SELECT 1;'
- $psql_stdout = $node->psql('postgres', 'SELECT 1');
+ # like:
+ # echo 'SELECT 1' | psql -qAXt postgres -v ON_ERROR_STOP=1
+ $psql_stdout = $node->psql_check('postgres', 'SELECT 1');
+
+ # Run psql with a timeout, capturing stdout and stderr
+ # as well as the psql exit code. Pass some extra psql
+ # options. If there's an error from psql raise an exception.
+ my ($stdout, $stderr, $timed_out);
+ my $cmdret = $psql_expert('postgres', 'SELECT pg_sleep(60)',
+ stdout => \$stdout, stderr => \$stderr,
+ timeout => 30, timed_out => \$timed_out,
+ extra_params => ['--single-transaction'],
+ on_error_die => 1)
+ print "Sleep timed out" if $timed_out;
# run query every second until it returns 't'
# or times out
@@ -69,6 +81,7 @@ use IPC::Run;
use RecursiveCopy;
use Test::More;
use TestLib ();
+use Scalar::Util qw(blessed);
our @EXPORT = qw(
get_new_node
@@ -780,11 +793,16 @@ sub teardown_node
=item $node->psql(dbname, sql)
-Run a query with psql and return stdout, or on error print stderr.
+Run a query with psql and return stdout if psql returns with no error.
-Executes a query/script with psql and returns psql's standard output. psql is
-run in unaligned tuples-only quiet mode with psqlrc disabled so simple queries
-will just return the result row(s) with fields separated by commas.
+psql is run in unaligned tuples-only quiet mode with psqlrc disabled so simple
+queries will just return the result row(s) with fields separated by commas.
+
+If any stderr output is generated it is printed and discarded.
+
+Nonzero return codes from psql are ignored and discarded.
+
+Use psql_expert for more control.
=cut
@@ -793,24 +811,215 @@ sub psql
my ($self, $dbname, $sql) = @_;
my ($stdout, $stderr);
+
my $name = $self->name;
print("### Running SQL command on node \"$name\": $sql\n");
- IPC::Run::run [ 'psql', '-XAtq', '-d', $self->connstr($dbname), '-f',
- '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr
- or die;
+ # Run the command, ignoring errors
+ $self->psql_expert($dbname, $sql, stdout => \$stdout, stderr => \$stderr,
+ die_on_error => 0, on_error_stop => 0);
+
+ if ($stderr ne "")
+ {
+ print "#### Begin standard error\n";
+ print $stderr;
+ print "\n#### End standard error\n";
+ }
+ return $stdout;
+}
+
+=pod $node->psql_check($dbname, $sql) => stdout
+
+Invoke 'psql' to run 'sql' on 'dbname' and return its stdout on success.
+Die if the SQL produces an error. Runs with ON_ERROR_STOP set.
+
+Takes optional extra params like timeout and timed_out parameters with the same
+options as psql_expert.
+=cut
+
+sub psql_check
+{
+ my ($self, $dbname, $sql, %params) = @_;
+
+ my ($stdout, $stderr);
+
+ my $ret = $self->psql_expert($dbname, $sql,
+ %params,
+ stdout => \$stdout, stderr => \$stderr,
+ on_error_die => 1, on_error_stop => 1);
+
+ # psql can emit stderr from NOTICEs etc
if ($stderr ne "")
{
print "#### Begin standard error\n";
print $stderr;
- print "#### End standard error\n";
+ print "\n#### End standard error\n";
}
- chomp $stdout;
- $stdout =~ s/\r//g if $Config{osname} eq 'msys';
+
return $stdout;
}
+=pod $node->psql_expert($dbname, $sql, %params) => psql_retval
+
+Invoke 'psql' to run 'sql' on 'dbname' and return the return value from
+psql, which is run with on_error_stop by default so that it will stop running
+sql and return 3 if the passed SQL results in an error.
+
+psql is invoked in tuples-only unaligned mode with reading of psqlrc disabled. That
+may be overridden by passing extra psql parameters.
+
+stdout and stderr are transformed to unix line endings if on Windows and any
+trailing newline is removed.
+
+Dies on failure to invoke psql but not if psql exits with a nonzero return code
+(unless on_error_die specified). Dies if psql exits with a signal.
+
+=over
+
+=item stdout => \$stdout
+
+If a scalar to write stdout to is passed as the keyword parameter 'stdout' it
+will be set to psql's stdout.
+
+=item stderr => \$stderr
+
+Same as 'stdout' but gets stderr. If the same scalar is passed for both stdout
+and stderr the results may be interleaved unpredictably.
+
+=item on_error_stop => 1
+
+By default psql_expert invokes psql with ON_ERROR_STOP=1 set so it will
+stop executing SQL at the first error and return exit code 2. If you want
+to ignore errors, pass 0 to on_error_stop.
+
+=item on_error_die => 0
+
+By default psql_expert returns psql's result code. Pass on_error_die to instead
+die with an informative message.
+
+=item timeout => 'interval'
+
+Set a timeout for the psql call as an interval accepted by IPC::Run::timer.
+Integer seconds is fine. psql_expert dies with an exception on timeout unless
+the timed_out parameter is passed.
+
+=item timed_out => \$timed_out
+
+Keyword parameter. Pass a scalar reference and it'll be set to true if the psql
+call timed out instead of dying. Has no effect unless 'timeout' is set.
+
+=item extra_params => ['--single-transaction']
+
+Pass additional parameters to psql. Must be an arrayref.
+
+=back
+
+e.g.
+
+ my ($stdout, $stderr, $timed_out);
+ my $cmdret = $psql_expert('postgres', 'SELECT pg_sleep(60)',
+ stdout => \$stdout, stderr => \$stderr,
+ timeout => 30, timed_out => \$timed_out,
+ extra_params => ['--single-transaction'])
+
+will set $cmdret to undef and $timed_out to a true value.
+
+ $psql_expert('postgres', $sql, on_error_die => 1);
+
+dies with an informative message if $sql fails.
+
+=cut
+
+sub psql_expert
+{
+ my ($self, $dbname, $sql, %params) = @_;
+
+ my $stdout = $params{stdout};
+ my $stderr = $params{stderr};
+ my $timeout = undef;
+ my $timeout_exception = 'psql timed out';
+ my @psql_params = ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-');
+
+ $params{on_error_stop} = 1 unless defined $params{on_error_stop};
+ $params{on_error_die} = 0 unless defined $params{on_error_die};
+
+ push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop};
+ push @psql_params, @{$params{extra_params}} if defined $params{extra_params};
+
+ $timeout = IPC::Run::timeout( $params{timeout}, exception => $timeout_exception)
+ if (defined($params{timeout}));
+
+ # IPC::Run would otherwise append to existing contents:
+ $$stdout = "" if ref($stdout);
+ $$stderr = "" if ref($stderr);
+
+ my $ret;
+
+ # Perl's exception handling is ... interesting. Especially since we have to
+ # support 5.8.8. So we hide that from the caller, returning true/false for
+ # timeout instead. See
+ # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for
+ # background.
+ my $error = do {
+ local $@;
+ eval {
+ IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>', $stderr, $timeout;
+ $ret = $?;
+ };
+ my $exc_save = $@;
+ if ($exc_save) {
+ # IPC::Run::run threw an exception. re-throw unless it's a
+ # timeout, which we'll handle by testing is_expired
+ if (blessed($exc_save) || $exc_save ne $timeout_exception) {
+ print "Exception from IPC::Run::run when invoking psql: '$exc_save'\n";
+ die $exc_save;
+ } else {
+ $ret = undef;
+
+ die "Got timeout exception '$exc_save' but timer not expired?!"
+ unless $timeout->is_expired;
+
+ if (defined($params{timed_out}))
+ {
+ ${$params{timed_out}} = 1;
+ } else {
+ die "psql timed out while running '@psql_params', stderr '$$stderr'";
+ }
+ }
+ }
+ };
+
+ chomp $$stdout;
+ $$stdout =~ s/\r//g if $Config{osname} eq 'msys';
+
+ chomp $$stderr;
+ $$stderr =~ s/\r//g if $Config{osname} eq 'msys';
+
+ # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR
+ # We don't use IPC::Run::Simple to limit dependencies.
+ #
+ # We always die on signal. If someone wants to capture signals
+ # to psql we can return it with another reference out parameter.
+ die "psql exited with signal " . ($ret & 127) . ": '$$stderr' while running '@psql_params'"
+ if $ret & 127;
+ die "psql exited with core dump: '$$stderr' while running '@psql_params'"
+ if $ret & 128;
+ $ret = $ret >> 8;
+
+ if ($ret && $params{on_error_die}) {
+ die "psql command line syntax error or internal error: '$$stderr' while running '@psql_params'"
+ if $ret == 1;
+ die "psql connection error: '$$stderr' while running '@psql_params'"
+ if $ret == 2;
+ die "error when running passed SQL: '$$stderr' while running '@psql_params'"
+ if $ret == 3;
+ die "unexpected error code $ret from psql: '$$stderr' while running '@psql_params'";
+ }
+
+ return $ret;
+}
+
=pod
=item $node->poll_query_until(dbname, query)
--
2.1.0
From ee832b9bc7b240b279f0228e624356ca3fd63a27 Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:21:25 +0800
Subject: [PATCH 4/7] TAP: Add support for taking filesystem level backups
---
src/test/perl/PostgresNode.pm | 83 ++++++++++++++++++++++++++++++++++++-------
1 file changed, 71 insertions(+), 12 deletions(-)
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index c18c94a..099bb89 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -463,11 +463,81 @@ sub backup
my $port = $self->port;
my $name = $self->name;
- print "# Taking backup $backup_name from node \"$name\"\n";
+ print "# Taking pg_basebackup $backup_name from node \"$name\"\n";
TestLib::system_or_bail("pg_basebackup -D $backup_path -p $port -x");
print "# Backup finished\n";
}
+=item $node->backup_fs_hot(backup_name)
+
+Create a backup with a filesystem level copy in $node->backup_dir,
+including transaction logs. Archiving must be enabled as pg_start_backup
+and pg_stop_backup are used. This is not checked or enforced.
+
+The backup name is passed as the backup label to pg_start_backup.
+
+=cut
+
+sub backup_fs_hot
+{
+ my ($self, $backup_name) = @_;
+ $self->_backup_fs($backup_name, 1);
+}
+
+=item $node->backup_fs_cold(backup_name)
+
+Create a backup with a filesystem level copy in $node->backup dir,
+including transaction logs. The server must be stopped as no
+attempt to handle concurrent writes is made.
+
+Use backup or backup_fs_hot if you want to back up a running
+server.
+
+=cut
+
+sub backup_fs_cold
+{
+ my ($self, $backup_name) = @_;
+ $self->_backup_fs($backup_name, 0);
+}
+
+
+# Common sub of backup_fs_hot and backup_fs_cold
+sub _backup_fs
+{
+ my ($self, $backup_name, $hot) = @_;
+ my $backup_path = $self->backup_dir . '/' . $backup_name;
+ my $port = $self->port;
+ my $name = $self->name;
+
+ print "# Taking filesystem level backup $backup_name from node \"$name\"\n";
+
+ if ($hot) {
+ my $stdout = $self->psql_check('postgres', "SELECT * FROM pg_start_backup('$backup_name');");
+ print "# pg_start_backup: $stdout\n";
+ }
+
+ RecursiveCopy::copypath($self->data_dir, $backup_path,
+ filterfn => sub {
+ my $src = shift;
+ return $src !~ /\/pg_log\// && $src !~ /\/postmaster.pid$/;
+ }
+ );
+
+ if ($hot)
+ {
+ # We ignore pg_stop_backup's return value. We also assume archiving
+ # is enabled; otherwise the caller will have to copy the remaining
+ # segments.
+ my $stdout = $self->psql_check('postgres', 'SELECT * FROM pg_stop_backup();');
+ print "# pg_stop_backup: $stdout\n";
+ }
+
+ print "# Backup finished\n";
+}
+
+
+
=pod
=item $node->init_from_backup(root_node, backup_name)
@@ -917,17 +987,6 @@ Pass additional parameters to psql. Must be an arrayref.
e.g.
- my ($stdout, $stderr, $timed_out);
- my $cmdret = $psql_expert('postgres', 'SELECT pg_sleep(60)',
- stdout => \$stdout, stderr => \$stderr,
- timeout => 30, timed_out => \$timed_out,
- extra_params => ['--single-transaction'])
-
-will set $cmdret to undef and $timed_out to a true value.
-
- $psql_expert('postgres', $sql, on_error_die => 1);
-
-dies with an informative message if $sql fails.
=cut
--
2.1.0
From c30b466bde94452d4b4aad79199b9e8b149785bc Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:27:36 +0800
Subject: [PATCH 5/7] TAP: Suffix temporary directories with node name
Temporary directories for PostgreSQL nodes used in TAP tests now
have the node name appended to them.
By Kyotaro Horiguchi
---
src/test/perl/PostgresNode.pm | 2 +-
src/test/perl/TestLib.pm | 6 ++++--
2 files changed, 5 insertions(+), 3 deletions(-)
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 099bb89..4eaa3ed 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -128,7 +128,7 @@ sub new
my $self = {
_port => $pgport,
_host => $pghost,
- _basedir => TestLib::tempdir,
+ _basedir => TestLib::tempdir($name),
_name => $name,
_logfile => "$TestLib::log_path/${testname}_${name}.log" };
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 3d11cbb..8c13655 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -112,9 +112,11 @@ INIT
#
sub tempdir
{
+ my ($prefix) = @_;
+ $prefix = "tmp_test" if (!$prefix);
return File::Temp::tempdir(
- 'tmp_testXXXX',
- DIR => $tmp_check,
+ $prefix . '_XXXX',
+ DIR => $tmp_check,
CLEANUP => 1);
}
--
2.1.0
From 25544852d530dce6ccd9e1e31e966f4031d5417a Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:31:31 +0800
Subject: [PATCH 6/7] TAP: Retain tempdirs for failed tests
If a test fails temporary directories created for that test are retained
- in particular, PostgresNode data directories. This makes debugging
much easier.
By Kyotaro Horiguchi
---
src/test/perl/TestLib.pm | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 8c13655..63a0e77 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -107,6 +107,12 @@ INIT
autoflush TESTLOG 1;
}
+END
+{
+ # Preserve temporary directory for this test on failure
+ $File::Temp::KEEP_ALL = 1 unless Test::More->builder->is_passing;
+}
+
#
# Helper functions
#
--
2.1.0
From 80c5e4e02ee43e76f28ceadb9f9d7cf85df3015b Mon Sep 17 00:00:00 2001
From: Craig Ringer <cr...@2ndquadrant.com>
Date: Tue, 1 Mar 2016 21:44:11 +0800
Subject: [PATCH 7/7] TAP: Perltidy PostgresNode.pm
Recent PostgresNode changes were committed without using the project's
perltidyrc. Tidy it now.
---
src/test/perl/PostgresNode.pm | 204 ++++++++++++++++++++++++------------------
src/test/perl/README | 3 +
src/test/perl/SimpleTee.pm | 13 +--
3 files changed, 130 insertions(+), 90 deletions(-)
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 4eaa3ed..a965e71 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -1,3 +1,4 @@
+
=pod
=head1 NAME
@@ -119,18 +120,15 @@ of finding port numbers, registering instances for cleanup, etc.
sub new
{
- my $class = shift;
- my $name = shift;
- my $pghost = shift;
- my $pgport = shift;
+ my ($class, $name, $pghost, $pgport) = @_;
my $testname = basename($0);
$testname =~ s/\.[^.]+$//;
- my $self = {
- _port => $pgport,
- _host => $pghost,
- _basedir => TestLib::tempdir($name),
- _name => $name,
- _logfile => "$TestLib::log_path/${testname}_${name}.log" };
+ my $self = {
+ _port => $pgport,
+ _host => $pghost,
+ _basedir => TestLib::tempdir($name),
+ _name => $name,
+ _logfile => "$TestLib::log_path/${testname}_${name}.log" };
bless $self, $class;
$self->dump_info;
@@ -380,7 +378,7 @@ sub init
$params{hba_permit_replication} = 1
unless defined $params{hba_permit_replication};
$params{allows_streaming} = 0 unless defined $params{allows_streaming};
- $params{has_archiving} = 0 unless defined $params{has_archiving};
+ $params{has_archiving} = 0 unless defined $params{has_archiving};
mkdir $self->backup_dir;
mkdir $self->archive_dir;
@@ -418,7 +416,7 @@ sub init
close $conf;
$self->set_replication_conf if $params{hba_permit_replication};
- $self->enable_archiving if $params{has_archiving};
+ $self->enable_archiving if $params{has_archiving};
}
=pod
@@ -510,26 +508,31 @@ sub _backup_fs
my $port = $self->port;
my $name = $self->name;
- print "# Taking filesystem level backup $backup_name from node \"$name\"\n";
+ print
+ "# Taking filesystem level backup $backup_name from node \"$name\"\n";
- if ($hot) {
- my $stdout = $self->psql_check('postgres', "SELECT * FROM pg_start_backup('$backup_name');");
+ if ($hot)
+ {
+ my $stdout = $self->psql_check('postgres',
+ "SELECT * FROM pg_start_backup('$backup_name');");
print "# pg_start_backup: $stdout\n";
}
- RecursiveCopy::copypath($self->data_dir, $backup_path,
- filterfn => sub {
- my $src = shift;
- return $src !~ /\/pg_log\// && $src !~ /\/postmaster.pid$/;
- }
- );
+ RecursiveCopy::copypath(
+ $self->data_dir,
+ $backup_path,
+ filterfn => sub {
+ my $src = shift;
+ return $src !~ /\/pg_log\// && $src !~ /\/postmaster.pid$/;
+ });
if ($hot)
{
# We ignore pg_stop_backup's return value. We also assume archiving
# is enabled; otherwise the caller will have to copy the remaining
# segments.
- my $stdout = $self->psql_check('postgres', 'SELECT * FROM pg_stop_backup();');
+ my $stdout =
+ $self->psql_check('postgres', 'SELECT * FROM pg_stop_backup();');
print "# pg_stop_backup: $stdout\n";
}
@@ -575,7 +578,7 @@ sub init_from_backup
$params{has_streaming} = 0 unless defined $params{has_streaming};
$params{hba_permit_replication} = 1
- unless defined $params{hba_permit_replication};
+ unless defined $params{hba_permit_replication};
$params{has_restoring} = 0 unless defined $params{has_restoring};
print
@@ -597,7 +600,7 @@ sub init_from_backup
qq(
port = $port
));
- $self->set_replication_conf if $params{hba_permit_replication};
+ $self->set_replication_conf if $params{hba_permit_replication};
$self->enable_streaming($root_node) if $params{has_streaming};
$self->enable_restoring($root_node) if $params{has_restoring};
}
@@ -690,19 +693,19 @@ sub promote
my $logfile = $self->logfile;
my $name = $self->name;
print "### Promoting node \"$name\"\n";
- TestLib::system_log('pg_ctl', '-D', $pgdata, '-l', $logfile,
- 'promote');
+ TestLib::system_log('pg_ctl', '-D', $pgdata, '-l', $logfile, 'promote');
}
# Internal routine to enable streaming replication on a standby node.
sub enable_streaming
{
- my ($self, $root_node) = @_;
+ my ($self, $root_node) = @_;
my $root_connstr = $root_node->connstr;
- my $name = $self->name;
+ my $name = $self->name;
print "### Enabling streaming replication for node \"$name\"\n";
- $self->append_conf('recovery.conf', qq(
+ $self->append_conf(
+ 'recovery.conf', qq(
primary_conninfo='$root_connstr application_name=$name'
standby_mode=on
));
@@ -711,7 +714,7 @@ standby_mode=on
# Internal routine to enable archive recovery command on a standby node
sub enable_restoring
{
- my ($self, $root_node) = @_;
+ my ($self, $root_node) = @_;
my $path = $root_node->archive_dir;
my $name = $self->name;
@@ -724,11 +727,13 @@ sub enable_restoring
# first. Paths also need to be double-quoted to prevent failures where
# the path contains spaces.
$path =~ s{\\}{\\\\}g if ($TestLib::windows_os);
- my $copy_command = $TestLib::windows_os ?
- qq{copy "$path\\\\%f" "%p"} :
- qq{cp $path/%f %p};
+ my $copy_command =
+ $TestLib::windows_os
+ ? qq{copy "$path\\\\%f" "%p"}
+ : qq{cp $path/%f %p};
- $self->append_conf('recovery.conf', qq(
+ $self->append_conf(
+ 'recovery.conf', qq(
restore_command = '$copy_command'
standby_mode = on
));
@@ -750,12 +755,14 @@ sub enable_archiving
# first. Paths also need to be double-quoted to prevent failures where
# the path contains spaces.
$path =~ s{\\}{\\\\}g if ($TestLib::windows_os);
- my $copy_command = $TestLib::windows_os ?
- qq{copy "%p" "$path\\\\%f"} :
- qq{cp %p $path/%f};
+ my $copy_command =
+ $TestLib::windows_os
+ ? qq{copy "%p" "$path\\\\%f"}
+ : qq{cp %p $path/%f};
# Enable archive_mode and archive_command on node
- $self->append_conf('postgresql.conf', qq(
+ $self->append_conf(
+ 'postgresql.conf', qq(
archive_mode = on
archive_command = '$copy_command'
));
@@ -886,8 +893,12 @@ sub psql
print("### Running SQL command on node \"$name\": $sql\n");
# Run the command, ignoring errors
- $self->psql_expert($dbname, $sql, stdout => \$stdout, stderr => \$stderr,
- die_on_error => 0, on_error_stop => 0);
+ $self->psql_expert(
+ $dbname, $sql,
+ stdout => \$stdout,
+ stderr => \$stderr,
+ die_on_error => 0,
+ on_error_stop => 0);
if ($stderr ne "")
{
@@ -914,10 +925,13 @@ sub psql_check
my ($stdout, $stderr);
- my $ret = $self->psql_expert($dbname, $sql,
- %params,
- stdout => \$stdout, stderr => \$stderr,
- on_error_die => 1, on_error_stop => 1);
+ my $ret = $self->psql_expert(
+ $dbname, $sql,
+ %params,
+ stdout => \$stdout,
+ stderr => \$stderr,
+ on_error_die => 1,
+ on_error_stop => 1);
# psql can emit stderr from NOTICEs etc
if ($stderr ne "")
@@ -994,20 +1008,23 @@ sub psql_expert
{
my ($self, $dbname, $sql, %params) = @_;
- my $stdout = $params{stdout};
- my $stderr = $params{stderr};
- my $timeout = undef;
+ my $stdout = $params{stdout};
+ my $stderr = $params{stderr};
+ my $timeout = undef;
my $timeout_exception = 'psql timed out';
- my @psql_params = ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-');
+ my @psql_params =
+ ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-');
$params{on_error_stop} = 1 unless defined $params{on_error_stop};
- $params{on_error_die} = 0 unless defined $params{on_error_die};
+ $params{on_error_die} = 0 unless defined $params{on_error_die};
push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop};
- push @psql_params, @{$params{extra_params}} if defined $params{extra_params};
+ push @psql_params, @{ $params{extra_params} }
+ if defined $params{extra_params};
- $timeout = IPC::Run::timeout( $params{timeout}, exception => $timeout_exception)
- if (defined($params{timeout}));
+ $timeout =
+ IPC::Run::timeout($params{timeout}, exception => $timeout_exception)
+ if (defined($params{timeout}));
# IPC::Run would otherwise append to existing contents:
$$stdout = "" if ref($stdout);
@@ -1015,37 +1032,48 @@ sub psql_expert
my $ret;
- # Perl's exception handling is ... interesting. Especially since we have to
- # support 5.8.8. So we hide that from the caller, returning true/false for
- # timeout instead. See
- # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for
- # background.
- my $error = do {
+ # Perl's exception handling is ... interesting. Especially since we have to
+ # support 5.8.8. So we hide that from the caller, returning true/false for
+ # timeout instead. See
+ # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for
+ # background.
+ my $error = do
+ {
local $@;
eval {
- IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>', $stderr, $timeout;
+ IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>',
+ $stderr, $timeout;
$ret = $?;
};
my $exc_save = $@;
- if ($exc_save) {
- # IPC::Run::run threw an exception. re-throw unless it's a
- # timeout, which we'll handle by testing is_expired
- if (blessed($exc_save) || $exc_save ne $timeout_exception) {
- print "Exception from IPC::Run::run when invoking psql: '$exc_save'\n";
- die $exc_save;
- } else {
- $ret = undef;
-
- die "Got timeout exception '$exc_save' but timer not expired?!"
+ if ($exc_save)
+ {
+ # IPC::Run::run threw an exception. re-throw unless it's a
+ # timeout, which we'll handle by testing is_expired
+ if (blessed($exc_save) || $exc_save ne $timeout_exception)
+ {
+ print
+"Exception from IPC::Run::run when invoking psql: '$exc_save'\n";
+ die $exc_save;
+ }
+ else
+ {
+ $ret = undef;
+
+ die
+ "Got timeout exception '$exc_save' but timer not expired?!"
unless $timeout->is_expired;
- if (defined($params{timed_out}))
- {
- ${$params{timed_out}} = 1;
- } else {
- die "psql timed out while running '@psql_params', stderr '$$stderr'";
- }
- }
+ if (defined($params{timed_out}))
+ {
+ ${ $params{timed_out} } = 1;
+ }
+ else
+ {
+ die
+"psql timed out while running '@psql_params', stderr '$$stderr'";
+ }
+ }
}
};
@@ -1060,20 +1088,26 @@ sub psql_expert
#
# We always die on signal. If someone wants to capture signals
# to psql we can return it with another reference out parameter.
- die "psql exited with signal " . ($ret & 127) . ": '$$stderr' while running '@psql_params'"
+ die "psql exited with signal "
+ . ($ret & 127)
+ . ": '$$stderr' while running '@psql_params'"
if $ret & 127;
die "psql exited with core dump: '$$stderr' while running '@psql_params'"
if $ret & 128;
$ret = $ret >> 8;
- if ($ret && $params{on_error_die}) {
- die "psql command line syntax error or internal error: '$$stderr' while running '@psql_params'"
- if $ret == 1;
- die "psql connection error: '$$stderr' while running '@psql_params'"
- if $ret == 2;
- die "error when running passed SQL: '$$stderr' while running '@psql_params'"
- if $ret == 3;
- die "unexpected error code $ret from psql: '$$stderr' while running '@psql_params'";
+ if ($ret && $params{on_error_die})
+ {
+ die
+"psql command line syntax error or internal error: '$$stderr' while running '@psql_params'"
+ if $ret == 1;
+ die "psql connection error: '$$stderr' while running '@psql_params'"
+ if $ret == 2;
+ die
+"error when running passed SQL: '$$stderr' while running '@psql_params'"
+ if $ret == 3;
+ die
+"unexpected error code $ret from psql: '$$stderr' while running '@psql_params'";
}
return $ret;
diff --git a/src/test/perl/README b/src/test/perl/README
index 7b6de5f..9eae159 100644
--- a/src/test/perl/README
+++ b/src/test/perl/README
@@ -11,6 +11,9 @@ isolation tester specs in src/test/isolation, if possible. If not, check to
see if your new tests make sense under an existing tree in src/test, like
src/test/ssl, or should be added to one of the suites for an existing utility.
+Note that all tests and test tools should have perltidy run on them before
+patches are submitted, using perltidy --profile=src/tools/pgindent/perltidyrc
+
Writing tests
-------------
diff --git a/src/test/perl/SimpleTee.pm b/src/test/perl/SimpleTee.pm
index 5da82d0..ea2f2ee 100644
--- a/src/test/perl/SimpleTee.pm
+++ b/src/test/perl/SimpleTee.pm
@@ -10,17 +10,20 @@
package SimpleTee;
use strict;
-sub TIEHANDLE {
+sub TIEHANDLE
+{
my $self = shift;
bless \@_, $self;
}
-sub PRINT {
+sub PRINT
+{
my $self = shift;
- my $ok = 1;
- for my $fh (@$self) {
+ my $ok = 1;
+ for my $fh (@$self)
+ {
print $fh @_ or $ok = 0;
- $fh->flush or $ok = 0;
+ $fh->flush or $ok = 0;
}
return $ok;
}
--
2.1.0
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
