2020-05-14 19:06:38 +02:00
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
TestLib - helper module for writing PostgreSQL's C<prove> tests.
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
use TestLib;
|
|
|
|
|
|
|
|
# Test basic output of a command
|
|
|
|
program_help_ok('initdb');
|
|
|
|
program_version_ok('initdb');
|
|
|
|
program_options_handling_ok('initdb');
|
|
|
|
|
|
|
|
# Test option combinations
|
|
|
|
command_fails(['initdb', '--invalid-option'],
|
|
|
|
'command fails with invalid option');
|
|
|
|
my $tempdir = TestLib::tempdir;
|
|
|
|
command_ok('initdb', '-D', $tempdir);
|
|
|
|
|
|
|
|
# Miscellanea
|
|
|
|
print "on Windows" if $TestLib::windows_os;
|
|
|
|
my $path = TestLib::perl2host($backup_dir);
|
|
|
|
ok(check_mode_recursive($stream_dir, 0700, 0600),
|
|
|
|
"check stream dir permissions");
|
|
|
|
TestLib::system_log('pg_ctl', 'kill', 'QUIT', $slow_pid);
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
C<TestLib> contains a set of routines dedicated to environment setup for
|
|
|
|
a PostgreSQL regression test run and includes some low-level routines
|
|
|
|
aimed at controlling command execution, logging and test functions.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
|
|
|
# This module should never depend on any other PostgreSQL regression test
|
|
|
|
# modules.
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
2014-04-15 03:33:46 +02:00
|
|
|
package TestLib;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
|
2015-07-29 18:17:02 +02:00
|
|
|
use Config;
|
2018-03-19 22:55:36 +01:00
|
|
|
use Cwd;
|
2014-04-15 03:33:46 +02:00
|
|
|
use Exporter 'import';
|
2018-04-07 23:45:39 +02:00
|
|
|
use Fcntl qw(:mode);
|
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
2015-12-02 22:46:16 +01:00
|
|
|
use File::Basename;
|
2018-04-07 23:45:39 +02:00
|
|
|
use File::Find;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
use File::Spec;
|
2018-04-07 23:45:39 +02:00
|
|
|
use File::stat qw(stat);
|
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
2015-12-02 22:46:16 +01:00
|
|
|
use File::Temp ();
|
|
|
|
use IPC::Run;
|
|
|
|
use SimpleTee;
|
2017-05-18 01:01:23 +02:00
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
# specify a recent enough version of Test::More to support the
|
|
|
|
# done_testing() function
|
2018-03-06 20:42:10 +01:00
|
|
|
use Test::More 0.87;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
2014-04-15 03:33:46 +02:00
|
|
|
our @EXPORT = qw(
|
2016-08-04 20:44:23 +02:00
|
|
|
generate_ascii_string
|
2015-07-01 03:15:29 +02:00
|
|
|
slurp_dir
|
2015-07-01 03:15:05 +02:00
|
|
|
slurp_file
|
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
2015-12-02 22:46:16 +01:00
|
|
|
append_to_file
|
2018-04-07 23:45:39 +02:00
|
|
|
check_mode_recursive
|
2018-04-07 23:45:39 +02:00
|
|
|
chmod_recursive
|
2018-01-09 18:28:49 +01:00
|
|
|
check_pg_config
|
2020-07-16 20:48:37 +02:00
|
|
|
dir_symlink
|
2014-05-06 18:12:18 +02:00
|
|
|
system_or_bail
|
2015-07-09 12:19:10 +02:00
|
|
|
system_log
|
|
|
|
run_log
|
2019-03-13 06:58:24 +01:00
|
|
|
run_command
|
2014-05-06 18:12:18 +02:00
|
|
|
|
|
|
|
command_ok
|
|
|
|
command_fails
|
|
|
|
command_exit_is
|
|
|
|
program_help_ok
|
|
|
|
program_version_ok
|
|
|
|
program_options_handling_ok
|
|
|
|
command_like
|
2017-07-26 23:15:59 +02:00
|
|
|
command_like_safe
|
2016-07-26 16:48:43 +02:00
|
|
|
command_fails_like
|
2017-09-08 15:32:50 +02:00
|
|
|
command_checks_all
|
2015-07-28 21:34:35 +02:00
|
|
|
|
2015-08-03 02:58:18 +02:00
|
|
|
$windows_os
|
2020-07-16 20:48:37 +02:00
|
|
|
$is_msys2
|
2020-03-30 17:30:44 +02:00
|
|
|
$use_unix_sockets
|
2014-04-15 03:33:46 +02:00
|
|
|
);
|
|
|
|
|
2020-07-16 20:48:37 +02:00
|
|
|
our ($windows_os, $is_msys2, $use_unix_sockets, $tmp_check, $log_path,
|
|
|
|
$test_logfile);
|
2019-11-25 21:51:51 +01:00
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
BEGIN
|
2014-05-06 18:12:18 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
|
|
|
# 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};
|
Unified logging system for command-line programs
This unifies the various ad hoc logging (message printing, error
printing) systems used throughout the command-line programs.
Features:
- Program name is automatically prefixed.
- Message string does not end with newline. This removes a common
source of inconsistencies and omissions.
- Additionally, a final newline is automatically stripped, simplifying
use of PQerrorMessage() etc., another common source of mistakes.
- I converted error message strings to use %m where possible.
- As a result of the above several points, more translatable message
strings can be shared between different components and between
frontends and backend, without gratuitous punctuation or whitespace
differences.
- There is support for setting a "log level". This is not meant to be
user-facing, but can be used internally to implement debug or
verbose modes.
- Lazy argument evaluation, so no significant overhead if logging at
some level is disabled.
- Some color in the messages, similar to gcc and clang. Set
PG_COLOR=auto to try it out. Some colors are predefined, but can be
customized by setting PG_COLORS.
- Common files (common/, fe_utils/, etc.) can handle logging much more
simply by just using one API without worrying too much about the
context of the calling program, requiring callbacks, or having to
pass "progname" around everywhere.
- Some programs called setvbuf() to make sure that stderr is
unbuffered, even on Windows. But not all programs did that. This
is now done centrally.
Soft goals:
- Reduces vertical space use and visual complexity of error reporting
in the source code.
- Encourages more deliberate classification of messages. For example,
in some cases it wasn't clear without analyzing the surrounding code
whether a message was meant as an error or just an info.
- Concepts and terms are vaguely aligned with popular logging
frameworks such as log4j and Python logging.
This is all just about printing stuff out. Nothing affects program
flow (e.g., fatal exits). The uses are just too varied to do that.
Some existing code had wrappers that do some kind of print-and-exit,
and I adapted those.
I tried to keep the output mostly the same, but there is a lot of
historical baggage to unwind and special cases to consider, and I
might not always have succeeded. One significant change is that
pg_rewind used to write all error messages to stdout. That is now
changed to stderr.
Reviewed-by: Donald Dong <xdong@csumb.edu>
Reviewed-by: Arthur Zakirov <a.zakirov@postgrespro.ru>
Discussion: https://www.postgresql.org/message-id/flat/6a609b43-4f57-7348-6480-bd022f924310@2ndquadrant.com
2019-04-01 14:24:37 +02:00
|
|
|
delete $ENV{PG_COLOR};
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
Avoid putting build-location-dependent strings into generated files.
Various Perl scripts we use to generate files were in the habit of
printing things like "generated by $0" into their output files.
That looks like a fine idea at first glance, but it results in
non-reproducible output, because in VPATH builds $0 won't be just
the name of the script file, but a full path for it. We'd prefer
that you get identical results whether using VPATH or not, so this
is a bad thing.
Some of these places also printed their input file name(s), causing
an additional hazard of the same type.
Hence, establish a policy that thou shalt not print $0, nor input file
pathnames, into output files (they're still allowed in error messages,
though). Instead just write the script name verbatim. While we are at
it, we can make these annotations more useful by giving the script's
full relative path name within the PG source tree, eg instead of
Gen_fmgrtab.pl let's print src/backend/utils/Gen_fmgrtab.pl.
Not all of the changes made here actually affect any files shipped
in finished tarballs today, but it seems best to apply the policy
everyplace so that nobody copies unsafe code into places where it
could matter.
Christoph Berg and Tom Lane
Discussion: https://postgr.es/m/20171215102223.GB31812@msg.df7cb.de
2017-12-21 16:56:57 +01:00
|
|
|
$ENV{PGAPPNAME} = basename($0);
|
2016-09-30 18:00:00 +02:00
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
# Must be set early
|
|
|
|
$windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
|
2020-07-16 20:48:37 +02:00
|
|
|
# Check if this environment is MSYS2.
|
|
|
|
$is_msys2 = $^O eq 'msys' && `uname -or` =~ /^[2-9].*Msys/;
|
|
|
|
|
2019-11-25 00:25:22 +01:00
|
|
|
if ($windows_os)
|
|
|
|
{
|
|
|
|
require Win32API::File;
|
|
|
|
Win32API::File->import(qw(createFile OsFHandleOpen CloseHandle));
|
|
|
|
}
|
2020-03-30 17:30:44 +02:00
|
|
|
|
|
|
|
# Specifies whether to use Unix sockets for test setups. On
|
|
|
|
# Windows we don't use them by default since it's not universally
|
|
|
|
# supported, but it can be overridden if desired.
|
2020-05-14 19:06:38 +02:00
|
|
|
$use_unix_sockets =
|
|
|
|
(!$windows_os || defined $ENV{PG_TEST_USE_UNIX_SOCKETS});
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=head1 EXPORTED VARIABLES
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item C<$windows_os>
|
|
|
|
|
|
|
|
Set to true when running under Windows, except on Cygwin.
|
|
|
|
|
2020-07-16 20:48:37 +02:00
|
|
|
=item C<$is_msys2>
|
|
|
|
|
|
|
|
Set to true when running under MSYS2.
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=back
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
INIT
|
|
|
|
{
|
2014-04-15 03:33:46 +02:00
|
|
|
|
2017-12-16 19:03:35 +01:00
|
|
|
# Return EPIPE instead of killing the process with SIGPIPE. An affected
|
|
|
|
# test may still fail, but it's more likely to report useful facts.
|
|
|
|
$SIG{PIPE} = 'IGNORE';
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
# 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";
|
2020-07-16 20:48:37 +02:00
|
|
|
$log_path = "$tmp_check/log";
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
|
|
|
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";
|
2017-03-27 04:24:13 +02:00
|
|
|
open my $testlog, '>', $test_logfile
|
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
2015-12-02 22:46:16 +01:00
|
|
|
or die "could not open STDOUT to logfile \"$test_logfile\": $!";
|
|
|
|
|
|
|
|
# Hijack STDOUT and STDERR to the log file
|
2017-03-27 04:24:13 +02:00
|
|
|
open(my $orig_stdout, '>&', \*STDOUT);
|
|
|
|
open(my $orig_stderr, '>&', \*STDERR);
|
2017-05-18 01:01:23 +02:00
|
|
|
open(STDOUT, '>&', $testlog);
|
|
|
|
open(STDERR, '>&', $testlog);
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
|
|
|
# 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;
|
2017-03-27 04:24:13 +02:00
|
|
|
tie *$fh, "SimpleTee", $orig_stdout, $testlog;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
$fh = $builder->failure_output;
|
2017-03-27 04:24:13 +02:00
|
|
|
tie *$fh, "SimpleTee", $orig_stderr, $testlog;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
|
|
|
|
# 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;
|
2017-03-27 04:24:13 +02:00
|
|
|
autoflush $testlog 1;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
}
|
2014-04-15 03:33:46 +02:00
|
|
|
|
2016-03-01 23:50:13 +01:00
|
|
|
END
|
|
|
|
{
|
2016-06-12 10:19:56 +02:00
|
|
|
|
2020-02-05 17:26:41 +01:00
|
|
|
# Test files have several ways of causing prove_check to fail:
|
|
|
|
# 1. Exit with a non-zero status.
|
|
|
|
# 2. Call ok(0) or similar, indicating that a constituent test failed.
|
|
|
|
# 3. Deviate from the planned number of tests.
|
|
|
|
#
|
|
|
|
# Preserve temporary directories after (1) and after (2).
|
|
|
|
$File::Temp::KEEP_ALL = 1 unless $? == 0 && all_tests_passing();
|
2016-03-02 07:06:31 +01:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=head1 ROUTINES
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item all_tests_passing()
|
|
|
|
|
|
|
|
Return 1 if all the tests run so far have passed. Otherwise, return 0.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2016-03-02 07:06:31 +01:00
|
|
|
sub all_tests_passing
|
|
|
|
{
|
|
|
|
foreach my $status (Test::More->builder->summary)
|
|
|
|
{
|
|
|
|
return 0 unless $status;
|
|
|
|
}
|
|
|
|
return 1;
|
2016-03-01 23:50:13 +01:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item tempdir(prefix)
|
|
|
|
|
|
|
|
Securely create a temporary directory inside C<$tmp_check>, like C<mkdtemp>,
|
|
|
|
and return its name. The directory will be removed automatically at the
|
|
|
|
end of the tests.
|
|
|
|
|
|
|
|
If C<prefix> is given, the new directory is templated as C<${prefix}_XXXX>.
|
|
|
|
Otherwise the template is C<tmp_test_XXXX>.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub tempdir
|
|
|
|
{
|
2016-03-02 21:02:36 +01:00
|
|
|
my ($prefix) = @_;
|
|
|
|
$prefix = "tmp_test" unless defined $prefix;
|
2015-05-24 03:35:49 +02:00
|
|
|
return File::Temp::tempdir(
|
2016-03-02 21:02:36 +01:00
|
|
|
$prefix . '_XXXX',
|
|
|
|
DIR => $tmp_check,
|
2015-05-24 03:35:49 +02:00
|
|
|
CLEANUP => 1);
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item tempdir_short()
|
|
|
|
|
|
|
|
As above, but the directory is outside the build tree so that it has a short
|
|
|
|
name, to avoid path length issues.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-07-03 03:44:02 +02:00
|
|
|
sub tempdir_short
|
|
|
|
{
|
2015-05-24 03:35:49 +02:00
|
|
|
|
2014-07-03 03:44:02 +02:00
|
|
|
return File::Temp::tempdir(CLEANUP => 1);
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item perl2host()
|
|
|
|
|
2020-07-16 20:48:37 +02:00
|
|
|
Translate a virtual file name to a host file name. Currently, this is a no-op
|
2019-09-02 19:37:57 +02:00
|
|
|
except for the case of Perl=msys and host=mingw32. The subject need not
|
2020-07-16 20:48:37 +02:00
|
|
|
exist, but its parent or grandparent directory must exist unless cygpath is
|
|
|
|
available.
|
2019-09-02 19:37:57 +02:00
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2019-06-22 05:34:23 +02:00
|
|
|
sub perl2host
|
2018-03-19 22:55:36 +01:00
|
|
|
{
|
2019-06-22 05:34:23 +02:00
|
|
|
my ($subject) = @_;
|
|
|
|
return $subject unless $Config{osname} eq 'msys';
|
2020-07-16 20:48:37 +02:00
|
|
|
if ($is_msys2)
|
|
|
|
{
|
|
|
|
# get absolute, windows type path
|
|
|
|
my $path = qx{cygpath -a -w "$subject"};
|
|
|
|
if (!$?)
|
|
|
|
{
|
|
|
|
chomp $path;
|
|
|
|
return $path if $path;
|
|
|
|
}
|
|
|
|
# fall through if this didn't work.
|
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
my $here = cwd;
|
2019-06-22 05:34:23 +02:00
|
|
|
my $leaf;
|
|
|
|
if (chdir $subject)
|
|
|
|
{
|
|
|
|
$leaf = '';
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
$leaf = '/' . basename $subject;
|
|
|
|
my $parent = dirname $subject;
|
2020-07-16 20:48:37 +02:00
|
|
|
if (!chdir $parent)
|
|
|
|
{
|
|
|
|
$leaf = '/' . basename($parent) . $leaf;
|
|
|
|
$parent = dirname $parent;
|
|
|
|
chdir $parent or die "could not chdir \"$parent\": $!";
|
|
|
|
}
|
2019-06-22 05:34:23 +02:00
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
|
2018-03-19 22:55:36 +01:00
|
|
|
# this odd way of calling 'pwd -W' is the only way that seems to work.
|
2019-06-22 05:34:23 +02:00
|
|
|
my $dir = qx{sh -c "pwd -W"};
|
2018-04-25 20:00:19 +02:00
|
|
|
chomp $dir;
|
|
|
|
chdir $here;
|
2019-06-22 05:34:23 +02:00
|
|
|
return $dir . $leaf;
|
2018-03-19 22:55:36 +01:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item system_log(@cmd)
|
|
|
|
|
|
|
|
Run (via C<system()>) the command passed as argument; the return
|
|
|
|
value is passed through.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
sub system_log
|
2014-05-06 18:12:18 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
print("# Running: " . join(" ", @_) . "\n");
|
|
|
|
return system(@_);
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item system_or_bail(@cmd)
|
|
|
|
|
|
|
|
Run (via C<system()>) the command passed as argument, and returns
|
|
|
|
if the command is successful.
|
|
|
|
On failure, abandon further tests and exit the program.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
sub system_or_bail
|
2014-05-06 18:12:18 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
if (system_log(@_) != 0)
|
2014-05-06 18:12:18 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
BAIL_OUT("system $_[0] failed");
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item run_log(@cmd)
|
|
|
|
|
|
|
|
Run the given command via C<IPC::Run::run()>, noting it in the log.
|
|
|
|
The return value from the command is passed through.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
sub run_log
|
2014-05-06 18:12:18 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
print("# Running: " . join(" ", @{ $_[0] }) . "\n");
|
2015-12-03 03:16:22 +01:00
|
|
|
return IPC::Run::run(@_);
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item run_command(cmd)
|
|
|
|
|
|
|
|
Run (via C<IPC::Run::run()>) the command passed as argument.
|
|
|
|
The return value from the command is ignored.
|
|
|
|
The return value is C<($stdout, $stderr)>.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2019-03-13 06:58:24 +01:00
|
|
|
sub run_command
|
|
|
|
{
|
|
|
|
my ($cmd) = @_;
|
|
|
|
my ($stdout, $stderr);
|
2019-11-27 13:19:22 +01:00
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
|
2019-03-13 06:58:24 +01:00
|
|
|
chomp($stdout);
|
|
|
|
chomp($stderr);
|
|
|
|
return ($stdout, $stderr);
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item generate_ascii_string(from_char, to_char)
|
|
|
|
|
|
|
|
Generate a string made of the given range of ASCII characters.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2016-08-04 20:44:23 +02:00
|
|
|
sub generate_ascii_string
|
|
|
|
{
|
|
|
|
my ($from_char, $to_char) = @_;
|
|
|
|
my $res;
|
|
|
|
|
|
|
|
for my $i ($from_char .. $to_char)
|
|
|
|
{
|
|
|
|
$res .= sprintf("%c", $i);
|
|
|
|
}
|
|
|
|
return $res;
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item slurp_dir(dir)
|
|
|
|
|
|
|
|
Return the complete list of entries in the specified directory.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2015-07-01 03:15:29 +02:00
|
|
|
sub slurp_dir
|
|
|
|
{
|
|
|
|
my ($dir) = @_;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
opendir(my $dh, $dir)
|
|
|
|
or die "could not opendir \"$dir\": $!";
|
2015-07-01 03:15:29 +02:00
|
|
|
my @direntries = readdir $dh;
|
|
|
|
closedir $dh;
|
|
|
|
return @direntries;
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item slurp_file(filename)
|
|
|
|
|
|
|
|
Return the full contents of the specified file.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2015-07-01 03:15:05 +02:00
|
|
|
sub slurp_file
|
|
|
|
{
|
2015-12-08 22:58:05 +01:00
|
|
|
my ($filename) = @_;
|
2015-07-01 03:15:05 +02:00
|
|
|
local $/;
|
2019-11-25 00:25:22 +01:00
|
|
|
my $contents;
|
2019-11-27 21:45:44 +01:00
|
|
|
if ($Config{osname} ne 'MSWin32')
|
2019-11-25 00:25:22 +01:00
|
|
|
{
|
|
|
|
open(my $in, '<', $filename)
|
|
|
|
or die "could not read \"$filename\": $!";
|
|
|
|
$contents = <$in>;
|
|
|
|
close $in;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
my $fHandle = createFile($filename, "r", "rwd")
|
|
|
|
or die "could not open \"$filename\": $^E";
|
|
|
|
OsFHandleOpen(my $fh = IO::Handle->new(), $fHandle, 'r')
|
|
|
|
or die "could not read \"$filename\": $^E\n";
|
|
|
|
$contents = <$fh>;
|
|
|
|
CloseHandle($fHandle)
|
|
|
|
or die "could not close \"$filename\": $^E\n";
|
|
|
|
}
|
2020-07-09 02:25:52 +02:00
|
|
|
$contents =~ s/\r\n/\n/g if $Config{osname} eq 'msys';
|
2015-08-05 22:19:23 +02:00
|
|
|
return $contents;
|
2015-07-01 03:15:05 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item append_to_file(filename, str)
|
|
|
|
|
|
|
|
Append a string at the end of a given file. (Note: no newline is appended at
|
|
|
|
end of file.)
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
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
2015-12-02 22:46:16 +01:00
|
|
|
sub append_to_file
|
2015-07-09 12:19:10 +02:00
|
|
|
{
|
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
2015-12-02 22:46:16 +01:00
|
|
|
my ($filename, $str) = @_;
|
2015-12-08 22:58:05 +01:00
|
|
|
open my $fh, ">>", $filename
|
|
|
|
or die "could not write \"$filename\": $!";
|
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
2015-12-02 22:46:16 +01:00
|
|
|
print $fh $str;
|
|
|
|
close $fh;
|
2018-06-27 08:03:54 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list)
|
|
|
|
|
|
|
|
Check that all file/dir modes in a directory match the expected values,
|
|
|
|
ignoring files in C<ignore_list> (basename only).
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2018-04-07 23:45:39 +02:00
|
|
|
sub check_mode_recursive
|
|
|
|
{
|
|
|
|
my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_;
|
|
|
|
|
|
|
|
# Result defaults to true
|
|
|
|
my $result = 1;
|
|
|
|
|
2018-04-25 20:00:19 +02:00
|
|
|
find(
|
2018-05-09 16:14:46 +02:00
|
|
|
{
|
|
|
|
follow_fast => 1,
|
2018-04-25 20:00:19 +02:00
|
|
|
wanted => sub {
|
2018-04-07 23:45:39 +02:00
|
|
|
# Is file in the ignore list?
|
|
|
|
foreach my $ignore ($ignore_list ? @{$ignore_list} : [])
|
|
|
|
{
|
|
|
|
if ("$dir/$ignore" eq $File::Find::name)
|
|
|
|
{
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2018-09-09 03:26:10 +02:00
|
|
|
# Allow ENOENT. A running server can delete files, such as
|
|
|
|
# those in pg_stat. Other stat() failures are fatal.
|
|
|
|
my $file_stat = stat($File::Find::name);
|
|
|
|
unless (defined($file_stat))
|
|
|
|
{
|
|
|
|
my $is_ENOENT = $!{ENOENT};
|
2019-05-22 19:36:19 +02:00
|
|
|
my $msg = "unable to stat $File::Find::name: $!";
|
2018-09-09 03:26:10 +02:00
|
|
|
if ($is_ENOENT)
|
|
|
|
{
|
|
|
|
warn $msg;
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
die $msg;
|
|
|
|
}
|
|
|
|
}
|
2018-04-07 23:45:39 +02:00
|
|
|
|
|
|
|
my $file_mode = S_IMODE($file_stat->mode);
|
|
|
|
|
|
|
|
# Is this a file?
|
|
|
|
if (S_ISREG($file_stat->mode))
|
|
|
|
{
|
|
|
|
if ($file_mode != $expected_file_mode)
|
|
|
|
{
|
2018-04-25 20:00:19 +02:00
|
|
|
print(
|
|
|
|
*STDERR,
|
2018-04-07 23:45:39 +02:00
|
|
|
sprintf("$File::Find::name mode must be %04o\n",
|
2018-04-25 20:00:19 +02:00
|
|
|
$expected_file_mode));
|
2018-04-07 23:45:39 +02:00
|
|
|
|
|
|
|
$result = 0;
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
|
2018-04-07 23:45:39 +02:00
|
|
|
# Else a directory?
|
|
|
|
elsif (S_ISDIR($file_stat->mode))
|
|
|
|
{
|
|
|
|
if ($file_mode != $expected_dir_mode)
|
|
|
|
{
|
2018-04-25 20:00:19 +02:00
|
|
|
print(
|
|
|
|
*STDERR,
|
2018-04-07 23:45:39 +02:00
|
|
|
sprintf("$File::Find::name mode must be %04o\n",
|
2018-04-25 20:00:19 +02:00
|
|
|
$expected_dir_mode));
|
2018-04-07 23:45:39 +02:00
|
|
|
|
|
|
|
$result = 0;
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
|
2018-04-07 23:45:39 +02:00
|
|
|
# Else something we can't handle
|
|
|
|
else
|
|
|
|
{
|
|
|
|
die "unknown file type for $File::Find::name";
|
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
}
|
|
|
|
},
|
|
|
|
$dir);
|
2018-04-07 23:45:39 +02:00
|
|
|
|
|
|
|
return $result;
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item chmod_recursive(dir, dir_mode, file_mode)
|
|
|
|
|
|
|
|
C<chmod> recursively each file and directory within the given directory.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2018-04-07 23:45:39 +02:00
|
|
|
sub chmod_recursive
|
|
|
|
{
|
|
|
|
my ($dir, $dir_mode, $file_mode) = @_;
|
|
|
|
|
2018-04-25 20:00:19 +02:00
|
|
|
find(
|
2018-05-09 16:14:46 +02:00
|
|
|
{
|
|
|
|
follow_fast => 1,
|
2018-04-25 20:00:19 +02:00
|
|
|
wanted => sub {
|
2018-04-07 23:45:39 +02:00
|
|
|
my $file_stat = stat($File::Find::name);
|
|
|
|
|
|
|
|
if (defined($file_stat))
|
|
|
|
{
|
2018-04-25 20:00:19 +02:00
|
|
|
chmod(
|
|
|
|
S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode,
|
|
|
|
$File::Find::name
|
|
|
|
) or die "unable to chmod $File::Find::name";
|
2018-04-07 23:45:39 +02:00
|
|
|
}
|
2018-04-25 20:00:19 +02:00
|
|
|
}
|
|
|
|
},
|
|
|
|
$dir);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2018-04-07 23:45:39 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item check_pg_config(regexp)
|
|
|
|
|
|
|
|
Return the number of matches of the given regular expression
|
|
|
|
within the installation's C<pg_config.h>.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2018-01-09 18:28:49 +01:00
|
|
|
sub check_pg_config
|
|
|
|
{
|
|
|
|
my ($regexp) = @_;
|
|
|
|
my ($stdout, $stderr);
|
|
|
|
my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>',
|
2019-11-27 13:19:22 +01:00
|
|
|
\$stdout, '2>', \$stderr
|
2018-01-09 18:28:49 +01:00
|
|
|
or die "could not execute pg_config";
|
|
|
|
chomp($stdout);
|
2019-09-30 21:48:54 +02:00
|
|
|
$stdout =~ s/\r$//;
|
2018-01-09 18:28:49 +01:00
|
|
|
|
|
|
|
open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!";
|
2018-04-25 20:00:19 +02:00
|
|
|
my $match = (grep { /^$regexp/ } <$pg_config_h>);
|
2018-01-09 18:28:49 +01:00
|
|
|
close $pg_config_h;
|
|
|
|
return $match;
|
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
2020-07-16 20:48:37 +02:00
|
|
|
=item dir_symlink(oldname, newname)
|
|
|
|
|
|
|
|
Portably create a symlink for a directory. On Windows this creates a junction
|
|
|
|
point. Elsewhere it just calls perl's builtin symlink.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
|
|
|
sub dir_symlink
|
|
|
|
{
|
|
|
|
my $oldname = shift;
|
|
|
|
my $newname = shift;
|
|
|
|
if ($windows_os)
|
|
|
|
{
|
|
|
|
$oldname = perl2host($oldname);
|
|
|
|
$newname = perl2host($newname);
|
|
|
|
$oldname =~ s,/,\\,g;
|
|
|
|
$newname =~ s,/,\\,g;
|
|
|
|
my $cmd = qq{mklink /j "$newname" "$oldname"};
|
|
|
|
if ($Config{osname} eq 'msys')
|
|
|
|
{
|
|
|
|
# need some indirection on msys
|
|
|
|
$cmd = qq{echo '$cmd' | \$COMSPEC /Q};
|
|
|
|
}
|
|
|
|
system($cmd);
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
symlink $oldname, $newname;
|
|
|
|
}
|
|
|
|
die "No $newname" unless -e $newname;
|
|
|
|
}
|
|
|
|
|
|
|
|
=pod
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=back
|
|
|
|
|
|
|
|
=head1 Test::More-LIKE METHODS
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item command_ok(cmd, test_name)
|
|
|
|
|
|
|
|
Check that the command runs (via C<run_log>) successfully.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub command_ok
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd, $test_name) = @_;
|
2015-07-09 12:19:10 +02:00
|
|
|
my $result = run_log($cmd);
|
2014-04-15 03:33:46 +02:00
|
|
|
ok($result, $test_name);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_fails(cmd, test_name)
|
|
|
|
|
|
|
|
Check that the command fails (when run via C<run_log>).
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub command_fails
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd, $test_name) = @_;
|
2015-07-09 12:19:10 +02:00
|
|
|
my $result = run_log($cmd);
|
2014-04-15 03:33:46 +02:00
|
|
|
ok(!$result, $test_name);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_exit_is(cmd, expected, test_name)
|
|
|
|
|
|
|
|
Check that the command exit code matches the expected exit code.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub command_exit_is
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd, $expected, $test_name) = @_;
|
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
2015-12-02 22:46:16 +01:00
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n");
|
|
|
|
my $h = IPC::Run::start $cmd;
|
2014-04-15 03:33:46 +02:00
|
|
|
$h->finish();
|
2015-07-29 18:17:02 +02:00
|
|
|
|
|
|
|
# On Windows, the exit status of the process is returned directly as the
|
|
|
|
# process's exit code, while on Unix, it's returned in the high bits
|
|
|
|
# of the exit code (see WEXITSTATUS macro in the standard <sys/wait.h>
|
|
|
|
# header file). IPC::Run's result function always returns exit code >> 8,
|
|
|
|
# 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
|
2019-07-16 06:23:53 +02:00
|
|
|
# that, use $h->full_results on Windows instead.
|
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
2015-12-02 22:46:16 +01:00
|
|
|
my $result =
|
2020-07-16 20:48:37 +02:00
|
|
|
($Config{osname} eq "MSWin32")
|
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
2015-12-02 22:46:16 +01:00
|
|
|
? ($h->full_results)[0]
|
|
|
|
: $h->result(0);
|
2015-07-29 18:17:02 +02:00
|
|
|
is($result, $expected, $test_name);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item program_help_ok(cmd)
|
|
|
|
|
|
|
|
Check that the command supports the C<--help> option.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub program_help_ok
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd) = @_;
|
2014-10-30 00:41:19 +01:00
|
|
|
my ($stdout, $stderr);
|
2015-07-09 12:19:10 +02:00
|
|
|
print("# Running: $cmd --help\n");
|
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
2015-12-02 22:46:16 +01:00
|
|
|
my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>',
|
2019-11-27 13:19:22 +01:00
|
|
|
\$stderr;
|
2014-10-30 00:41:19 +01:00
|
|
|
ok($result, "$cmd --help exit code 0");
|
|
|
|
isnt($stdout, '', "$cmd --help goes to stdout");
|
|
|
|
is($stderr, '', "$cmd --help nothing to stderr");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item program_version_ok(cmd)
|
|
|
|
|
|
|
|
Check that the command supports the C<--version> option.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub program_version_ok
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd) = @_;
|
2014-10-30 00:41:19 +01:00
|
|
|
my ($stdout, $stderr);
|
2015-07-09 12:19:10 +02:00
|
|
|
print("# Running: $cmd --version\n");
|
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
2015-12-02 22:46:16 +01:00
|
|
|
my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>',
|
2019-11-27 13:19:22 +01:00
|
|
|
\$stderr;
|
2014-10-30 00:41:19 +01:00
|
|
|
ok($result, "$cmd --version exit code 0");
|
|
|
|
isnt($stdout, '', "$cmd --version goes to stdout");
|
|
|
|
is($stderr, '', "$cmd --version nothing to stderr");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item program_options_handling_ok(cmd)
|
|
|
|
|
|
|
|
Check that a command with an invalid option returns a non-zero
|
|
|
|
exit code and error message.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub program_options_handling_ok
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd) = @_;
|
2014-10-30 00:41:19 +01:00
|
|
|
my ($stdout, $stderr);
|
2015-07-09 12:19:10 +02:00
|
|
|
print("# Running: $cmd --not-a-valid-option\n");
|
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
2015-12-02 22:46:16 +01:00
|
|
|
my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>',
|
2019-11-27 13:19:22 +01:00
|
|
|
\$stdout,
|
|
|
|
'2>', \$stderr;
|
2014-10-30 00:41:19 +01:00
|
|
|
ok(!$result, "$cmd with invalid option nonzero exit code");
|
|
|
|
isnt($stderr, '', "$cmd with invalid option prints error message");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_like(cmd, expected_stdout, test_name)
|
|
|
|
|
|
|
|
Check that the command runs successfully and the output
|
|
|
|
matches the given regular expression.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-05-06 18:12:18 +02:00
|
|
|
sub command_like
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2014-04-15 03:33:46 +02:00
|
|
|
my ($cmd, $expected_stdout, $test_name) = @_;
|
2014-10-30 00:41:19 +01:00
|
|
|
my ($stdout, $stderr);
|
2015-07-09 12:19:10 +02:00
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n");
|
2019-11-27 13:19:22 +01:00
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
|
2016-07-26 17:39:43 +02:00
|
|
|
ok($result, "$test_name: exit code 0");
|
|
|
|
is($stderr, '', "$test_name: no stderr");
|
2014-10-30 00:41:19 +01:00
|
|
|
like($stdout, $expected_stdout, "$test_name: matches");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-04-15 03:33:46 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_like_safe(cmd, expected_stdout, test_name)
|
|
|
|
|
|
|
|
Check that the command runs successfully and the output
|
|
|
|
matches the given regular expression. Doesn't assume that the
|
|
|
|
output files are closed.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2017-07-26 23:15:59 +02:00
|
|
|
sub command_like_safe
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2017-08-14 23:29:33 +02:00
|
|
|
|
2017-07-26 23:15:59 +02:00
|
|
|
# Doesn't rely on detecting end of file on the file descriptors,
|
|
|
|
# which can fail, causing the process to hang, notably on Msys
|
|
|
|
# when used with 'pg_ctl start'
|
|
|
|
my ($cmd, $expected_stdout, $test_name) = @_;
|
|
|
|
my ($stdout, $stderr);
|
|
|
|
my $stdoutfile = File::Temp->new();
|
|
|
|
my $stderrfile = File::Temp->new();
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n");
|
2019-11-27 13:19:22 +01:00
|
|
|
my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile;
|
2017-07-26 23:15:59 +02:00
|
|
|
$stdout = slurp_file($stdoutfile);
|
|
|
|
$stderr = slurp_file($stderrfile);
|
|
|
|
ok($result, "$test_name: exit code 0");
|
|
|
|
is($stderr, '', "$test_name: no stderr");
|
|
|
|
like($stdout, $expected_stdout, "$test_name: matches");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2017-07-26 23:15:59 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_fails_like(cmd, expected_stderr, test_name)
|
|
|
|
|
|
|
|
Check that the command fails and the error message matches
|
|
|
|
the given regular expression.
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2016-07-26 16:48:43 +02:00
|
|
|
sub command_fails_like
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
2016-07-26 16:48:43 +02:00
|
|
|
my ($cmd, $expected_stderr, $test_name) = @_;
|
|
|
|
my ($stdout, $stderr);
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n");
|
2019-11-27 13:19:22 +01:00
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
|
2016-07-26 16:48:43 +02:00
|
|
|
ok(!$result, "$test_name: exit code not 0");
|
|
|
|
like($stderr, $expected_stderr, "$test_name: matches");
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2016-07-26 16:48:43 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=item command_checks_all(cmd, ret, out, err, test_name)
|
|
|
|
|
|
|
|
Run a command and check its status and outputs.
|
|
|
|
Arguments:
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item C<cmd>: Array reference of command and arguments to run
|
|
|
|
|
|
|
|
=item C<ret>: Expected exit code
|
|
|
|
|
|
|
|
=item C<out>: Expected stdout from command
|
|
|
|
|
|
|
|
=item C<err>: Expected stderr from command
|
|
|
|
|
|
|
|
=item C<test_name>: test name
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2017-09-08 15:32:50 +02:00
|
|
|
sub command_checks_all
|
|
|
|
{
|
2018-05-22 20:25:01 +02:00
|
|
|
local $Test::Builder::Level = $Test::Builder::Level + 1;
|
|
|
|
|
2017-09-08 19:36:13 +02:00
|
|
|
my ($cmd, $expected_ret, $out, $err, $test_name) = @_;
|
2017-09-08 15:32:50 +02:00
|
|
|
|
|
|
|
# run command
|
|
|
|
my ($stdout, $stderr);
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n");
|
2019-11-27 13:19:22 +01:00
|
|
|
IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr);
|
2017-09-08 15:32:50 +02:00
|
|
|
|
2017-09-08 19:36:13 +02:00
|
|
|
# See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR
|
|
|
|
my $ret = $?;
|
|
|
|
die "command exited with signal " . ($ret & 127)
|
|
|
|
if $ret & 127;
|
|
|
|
$ret = $ret >> 8;
|
2017-09-08 15:32:50 +02:00
|
|
|
|
|
|
|
# check status
|
2017-09-08 19:36:13 +02:00
|
|
|
ok($ret == $expected_ret,
|
|
|
|
"$test_name status (got $ret vs expected $expected_ret)");
|
2017-09-08 15:32:50 +02:00
|
|
|
|
|
|
|
# check stdout
|
|
|
|
for my $re (@$out)
|
|
|
|
{
|
|
|
|
like($stdout, $re, "$test_name stdout /$re/");
|
|
|
|
}
|
|
|
|
|
|
|
|
# check stderr
|
|
|
|
for my $re (@$err)
|
|
|
|
{
|
|
|
|
like($stderr, $re, "$test_name stderr /$re/");
|
|
|
|
}
|
2018-06-27 08:03:54 +02:00
|
|
|
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2017-09-08 15:32:50 +02:00
|
|
|
}
|
|
|
|
|
2019-09-02 19:37:57 +02:00
|
|
|
=pod
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2014-04-15 03:33:46 +02:00
|
|
|
1;
|