1
0
mirror of https://github.com/postgres/postgres.git synced 2025-12-10 14:22:35 +03:00

Consolidate methods for translating a Perl path to a Windows path.

This fixes some TAP suites when using msys Perl and a builddir located
in an msys mount point other than "/".  For example, builddir=/c/pg
exhibited the problem, since /c/pg falls in mount point "/c".
Back-patch to 9.6, where tests first started to perform such
translations.  In back branches, offer both new and old APIs.

Reviewed by Andrew Dunstan.

Discussion: https://postgr.es/m/20190610045838.GA238501@rfd.leadboat.com
This commit is contained in:
Noah Misch
2019-06-21 20:34:23 -07:00
parent 25b93a2967
commit 660a2b1903
5 changed files with 25 additions and 32 deletions

View File

@@ -107,15 +107,6 @@ our @EXPORT = qw(
our ($use_tcp, $test_localhost, $test_pghost, $last_host_assigned,
$last_port_assigned, @all_nodes, $died);
# Windows path to virtual file system root
our $vfs_path = '';
if ($Config{osname} eq 'msys')
{
$vfs_path = `cd / && pwd -W`;
chomp $vfs_path;
}
INIT
{
@@ -945,7 +936,7 @@ primary_conninfo='$root_connstr'
sub enable_restoring
{
my ($self, $root_node) = @_;
my $path = $vfs_path . $root_node->archive_dir;
my $path = TestLib::perl2host($root_node->archive_dir);
my $name = $self->name;
print "### Enabling WAL restore for node \"$name\"\n";
@@ -990,7 +981,7 @@ sub set_standby_mode
sub enable_archiving
{
my ($self) = @_;
my $path = $vfs_path . $self->archive_dir;
my $path = TestLib::perl2host($self->archive_dir);
my $name = $self->name;
print "### Enabling WAL archiving for node \"$name\"\n";

View File

@@ -166,22 +166,31 @@ sub tempdir_short
return File::Temp::tempdir(CLEANUP => 1);
}
# Return the real directory for a virtual path directory under msys.
# The directory must exist. If it's not an existing directory or we're
# not under msys, return the input argument unchanged.
sub real_dir
# Translate a Perl file name to a host file name. Currently, this is a no-op
# except for the case of Perl=msys and host=mingw32. The subject need not
# exist, but its parent directory must exist.
sub perl2host
{
my $dir = "$_[0]";
return $dir unless -d $dir;
return $dir unless $Config{osname} eq 'msys';
my ($subject) = @_;
return $subject unless $Config{osname} eq 'msys';
my $here = cwd;
chdir $dir;
my $leaf;
if (chdir $subject)
{
$leaf = '';
}
else
{
$leaf = '/' . basename $subject;
my $parent = dirname $subject;
chdir $parent or die "could not chdir \"$parent\": $!";
}
# this odd way of calling 'pwd -W' is the only way that seems to work.
$dir = qx{sh -c "pwd -W"};
my $dir = qx{sh -c "pwd -W"};
chomp $dir;
chdir $here;
return $dir;
return $dir . $leaf;
}
sub system_log