Allow for installation-aware instances of PostgresNode

Currently instances of PostgresNode find their Postgres executables in
the PATH of the caller. This modification allows for instances that know
the installation path they are supposed to use, and the module adjusts
the environment of methods that call Postgres executables appropriately.

This facility is activated by passing the installation path to the
constructor:

  my $node = PostgresNode->get_new_node('mynode',
     installation_path => '/path/to/installation');

This makes a number of things substantially easier, including

. testing third party modules
. testing different versions of postgres together
. testing different builds of postgres together

Discussion: https://postgr.es/m/a94c74f9-6b71-1957-7973-a734ea3cbef1@dunslane.net

Reviewed-By:  Alvaro Herrera, Michael Paquier, Dagfinn Ilmari Mannsåker

diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 97e05993bec3cb43a618396789b572062d802387..1e96357d7ed1902e20454b38466966ca879d8348 100644 (file)
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -355,6 +355,8 @@ sub info
    print $fh "Archive directory: " . $self->archive_dir . "\n";
    print $fh "Connection string: " . $self->connstr . "\n";
    print $fh "Log file: " . $self->logfile . "\n";
+   print $fh "Install Path: ", $self->{_install_path} . "\n"
+     if $self->{_install_path};
    close $fh or die;
    return $_info;
 }
@@ -428,6 +430,8 @@ sub init
    my $pgdata = $self->data_dir;
    my $host   = $self->host;
 
+   local %ENV = $self->_get_env();
+
    $params{allows_streaming} = 0 unless defined $params{allows_streaming};
    $params{has_archiving}    = 0 unless defined $params{has_archiving};
 
@@ -555,6 +559,8 @@ sub backup
    my $backup_path = $self->backup_dir . '/' . $backup_name;
    my $name        = $self->name;
 
+   local %ENV = $self->_get_env();
+
    print "# Taking pg_basebackup $backup_name from node \"$name\"\n";
    TestLib::system_or_bail(
        'pg_basebackup', '-D', $backup_path, '-h',
@@ -784,18 +790,15 @@ sub start
 
    print("### Starting node \"$name\"\n");
 
-   {
-       # Temporarily unset PGAPPNAME so that the server doesn't
-       # inherit it.  Otherwise this could affect libpqwalreceiver
-       # connections in confusing ways.
-       local %ENV = %ENV;
-       delete $ENV{PGAPPNAME};
-
-       # Note: We set the cluster_name here, not in postgresql.conf (in
-       # sub init) so that it does not get copied to standbys.
-       $ret = TestLib::system_log('pg_ctl', '-D', $self->data_dir, '-l',
-           $self->logfile, '-o', "--cluster-name=$name", 'start');
-   }
+   # Temporarily unset PGAPPNAME so that the server doesn't
+   # inherit it.  Otherwise this could affect libpqwalreceiver
+   # connections in confusing ways.
+   local %ENV = $self->_get_env(PGAPPNAME => undef);
+
+   # Note: We set the cluster_name here, not in postgresql.conf (in
+   # sub init) so that it does not get copied to standbys.
+   $ret = TestLib::system_log('pg_ctl', '-D', $self->data_dir, '-l',
+       $self->logfile, '-o', "--cluster-name=$name", 'start');
 
    if ($ret != 0)
    {
@@ -826,6 +829,9 @@ sub kill9
    my ($self) = @_;
    my $name = $self->name;
    return unless defined $self->{_pid};
+
+   local %ENV = $self->_get_env();
+
    print "### Killing node \"$name\" using signal 9\n";
    # kill(9, ...) fails under msys Perl 5.8.8, so fall back on pg_ctl.
    kill(9, $self->{_pid})
@@ -852,6 +858,9 @@ sub stop
    my $port   = $self->port;
    my $pgdata = $self->data_dir;
    my $name   = $self->name;
+
+   local %ENV = $self->_get_env();
+
    $mode = 'fast' unless defined $mode;
    return unless defined $self->{_pid};
    print "### Stopping node \"$name\" using mode $mode\n";
@@ -874,6 +883,9 @@ sub reload
    my $port   = $self->port;
    my $pgdata = $self->data_dir;
    my $name   = $self->name;
+
+   local %ENV = $self->_get_env();
+
    print "### Reloading node \"$name\"\n";
    TestLib::system_or_bail('pg_ctl', '-D', $pgdata, 'reload');
    return;
@@ -895,15 +907,12 @@ sub restart
    my $logfile = $self->logfile;
    my $name    = $self->name;
 
-   print "### Restarting node \"$name\"\n";
+   local %ENV = $self->_get_env(PGAPPNAME => undef);
 
-   {
-       local %ENV = %ENV;
-       delete $ENV{PGAPPNAME};
+   print "### Restarting node \"$name\"\n";
 
-       TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
-           'restart');
-   }
+   TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
+       'restart');
 
    $self->_update_pid(1);
    return;
@@ -924,6 +933,9 @@ sub promote
    my $pgdata  = $self->data_dir;
    my $logfile = $self->logfile;
    my $name    = $self->name;
+
+   local %ENV = $self->_get_env();
+
    print "### Promoting node \"$name\"\n";
    TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
        'promote');
@@ -945,6 +957,9 @@ sub logrotate
    my $pgdata  = $self->data_dir;
    my $logfile = $self->logfile;
    my $name    = $self->name;
+
+   local %ENV = $self->_get_env();
+
    print "### Rotating log in node \"$name\"\n";
    TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile,
        'logrotate');
@@ -1117,6 +1132,14 @@ By default, all nodes use the same PGHOST value.  If specified, generate a
 PGHOST specific to this node.  This allows multiple nodes to use the same
 port.
 
+=item install_path => '/path/to/postgres/installation'
+
+Using this parameter is it possible to have nodes pointing to different
+installations, for testing different versions together or the same version
+with different build parameters. The provided path must be the parent of the
+installation's 'bin' and 'lib' directories. In the common case where this is
+not provided, Postgres binaries will be found in the caller's PATH.
+
 =back
 
 For backwards compatibility, it is also exported as a standalone function,
@@ -1165,12 +1188,89 @@ sub get_new_node
    # Lock port number found by creating a new node
    my $node = $class->new($name, $host, $port);
 
+   if ($params{install_path})
+   {
+       $node->{_install_path} = $params{install_path};
+   }
+
    # Add node to list of nodes
    push(@all_nodes, $node);
 
    return $node;
 }
 
+# Private routine to return a copy of the environment with the PATH and
+# (DY)LD_LIBRARY_PATH correctly set when there is an install path set for
+# the node.
+#
+# Routines that call Postgres binaries need to call this routine like this:
+#
+#    local %ENV = $self->_get_env{[%extra_settings]);
+#
+# A copy of the environment is taken and node's host and port settings are
+# added as PGHOST and PGPORT, Then the extra settings (if any) are applied.
+# Any setting in %extra_settings with a value that is undefined is deleted
+# the remainder are# set. Then the PATH and (DY)LD_LIBRARY_PATH are adjusted
+# if the node's install path is set, and the copy environment is returned.
+#
+# The install path set in get_new_node needs to be a directory containing
+# bin and lib subdirectories as in a standard PostgreSQL installation, so this
+# can't be used with installations where the bin and lib directories don't have
+# a common parent directory.
+sub _get_env
+{
+   my $self     = shift;
+   my %inst_env = (%ENV, PGHOST => $self->{_host}, PGPORT => $self->{_port});
+   # the remaining arguments are modifications to make to the environment
+   my %mods = (@_);
+   while (my ($k, $v) = each %mods)
+   {
+       if (defined $v)
+       {
+           $inst_env{$k} = "$v";
+       }
+       else
+       {
+           delete $inst_env{$k};
+       }
+   }
+   # now fix up the new environment for the install path
+   my $inst = $self->{_install_path};
+   if ($inst)
+   {
+       if ($TestLib::windows_os)
+       {
+           # Windows picks up DLLs from the PATH rather than *LD_LIBRARY_PATH
+           # choose the right path separator
+           if ($Config{osname} eq 'MSWin32')
+           {
+               $inst_env{PATH} = "$inst/bin;$inst/lib;$ENV{PATH}";
+           }
+           else
+           {
+               $inst_env{PATH} = "$inst/bin:$inst/lib:$ENV{PATH}";
+           }
+       }
+       else
+       {
+           my $dylib_name =
+             $Config{osname} eq 'darwin'
+             ? "DYLD_LIBRARY_PATH"
+             : "LD_LIBRARY_PATH";
+           $inst_env{PATH} = "$inst/bin:$ENV{PATH}";
+           if (exists $ENV{$dylib_name})
+           {
+               $inst_env{$dylib_name} = "$inst/lib:$ENV{$dylib_name}";
+           }
+           else
+           {
+               $inst_env{$dylib_name} = "$inst/lib";
+           }
+       }
+   }
+   return (%inst_env);
+}
+
 =pod
 
 =item get_free_port()
@@ -1330,6 +1430,8 @@ sub safe_psql
 {
    my ($self, $dbname, $sql, %params) = @_;
 
+   local %ENV = $self->_get_env();
+
    my ($stdout, $stderr);
 
    my $ret = $self->psql(
@@ -1441,6 +1543,8 @@ sub psql
 {
    my ($self, $dbname, $sql, %params) = @_;
 
+   local %ENV = $self->_get_env();
+
    my $stdout            = $params{stdout};
    my $stderr            = $params{stderr};
    my $replication       = $params{replication};
@@ -1634,6 +1738,8 @@ sub background_psql
 {
    my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_;
 
+   local %ENV = $self->_get_env();
+
    my $replication = $params{replication};
 
    my @psql_params = (
@@ -1712,6 +1818,8 @@ sub interactive_psql
 {
    my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_;
 
+   local %ENV = $self->_get_env();
+
    my @psql_params = ('psql', '-XAt', '-d', $self->connstr($dbname));
 
    push @psql_params, @{ $params{extra_params} }
@@ -1755,6 +1863,8 @@ sub poll_query_until
 {
    my ($self, $dbname, $query, $expected) = @_;
 
+   local %ENV = $self->_get_env();
+
    $expected = 't' unless defined($expected);    # default value
 
    my $cmd = [ 'psql', '-XAt', '-c', $query, '-d', $self->connstr($dbname) ];
@@ -1810,8 +1920,7 @@ sub command_ok
 
    my $self = shift;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    TestLib::command_ok(@_);
    return;
@@ -1831,8 +1940,7 @@ sub command_fails
 
    my $self = shift;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    TestLib::command_fails(@_);
    return;
@@ -1852,8 +1960,7 @@ sub command_like
 
    my $self = shift;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    TestLib::command_like(@_);
    return;
@@ -1874,8 +1981,7 @@ sub command_checks_all
 
    my $self = shift;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    TestLib::command_checks_all(@_);
    return;
@@ -1899,8 +2005,7 @@ sub issues_sql_like
 
    my ($self, $cmd, $expected_sql, $test_name) = @_;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    truncate $self->logfile, 0;
    my $result = TestLib::run_log($cmd);
@@ -1923,8 +2028,7 @@ sub run_log
 {
    my $self = shift;
 
-   local $ENV{PGHOST} = $self->host;
-   local $ENV{PGPORT} = $self->port;
+   local %ENV = $self->_get_env();
 
    TestLib::run_log(@_);
    return;
@@ -2174,6 +2278,9 @@ sub pg_recvlogical_upto
 {
    my ($self, $dbname, $slot_name, $endpos, $timeout_secs, %plugin_options)
      = @_;
+
+   local %ENV = $self->_get_env();
+
    my ($stdout, $stderr);
 
    my $timeout_exception = 'pg_recvlogical timed out';