database/postgres
database/postgres
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-05-06 19:59:18 +03:00
Code

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

Browse Source 
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 f7aebd7f74
commit a40dca815d
4 changed files with 31 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/test/perl/PostgresNode.pm
View File

@ -107,8 +107,7 @@ our @EXPORT = qw(
our ($use_tcp, $test_localhost, $test_pghost, $last_host_assigned, our ($use_tcp, $test_localhost, $test_pghost, $last_host_assigned,
$last_port_assigned, @all_nodes, $died); $last_port_assigned, @all_nodes, $died);
# Windows path to virtual file system root # For backward compatibility only.
our $vfs_path = ''; our $vfs_path = '';
if ($Config{osname} eq 'msys') if ($Config{osname} eq 'msys')
{ {
@ -904,7 +903,7 @@ standby_mode=on
sub enable_restoring sub enable_restoring
{ {
my ($self, $root_node) = @_; my ($self, $root_node) = @_;
my $path = $vfs_path . $root_node->archive_dir; my $path = TestLib::perl2host($root_node->archive_dir);
my $name = $self->name; my $name = $self->name;
print "### Enabling WAL restore for node \"$name\"\n"; print "### Enabling WAL restore for node \"$name\"\n";
@ -933,7 +932,7 @@ standby_mode = on
sub enable_archiving sub enable_archiving
{ {
my ($self) = @_; my ($self) = @_;
my $path = $vfs_path . $self->archive_dir; my $path = TestLib::perl2host($self->archive_dir);
my $name = $self->name; my $name = $self->name;
print "### Enabling WAL archiving for node \"$name\"\n"; print "### Enabling WAL archiving for node \"$name\"\n";

35
src/test/perl/TestLib.pm
View File

@ -164,22 +164,37 @@ sub tempdir_short
return File::Temp::tempdir(CLEANUP => 1); return File::Temp::tempdir(CLEANUP => 1);
} }
# Return the real directory for a virtual path directory under msys. # Translate a Perl file name to a host file name. Currently, this is a no-op
# The directory must exist. If it's not an existing directory or we're # except for the case of Perl=msys and host=mingw32. The subject need not
# not under msys, return the input argument unchanged. # exist, but its parent directory must exist.
sub real_dir sub perl2host
{ {
my $dir = "$_[0]"; my ($subject) = @_;
return $dir unless -d $dir; return $subject unless $Config{osname} eq 'msys';
return $dir unless $Config{osname} eq 'msys';
my $here = cwd; 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. # 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; chomp $dir;
chdir $here; chdir $here;
return $dir; return $dir . $leaf;
}
# For backward compatibility only.
sub real_dir
{
return perl2host(@_);
} }
sub system_log sub system_log

2
src/test/recovery/t/014_unlogged_reinit.pl
View File

@ -30,7 +30,7 @@ ok(-f "$pgdata/$baseUnloggedPath", 'main fork in base exists');
my $tablespaceDir = TestLib::tempdir; my $tablespaceDir = TestLib::tempdir;
my $realTSDir = TestLib::real_dir($tablespaceDir); my $realTSDir = TestLib::perl2host($tablespaceDir);
$node->safe_psql('postgres', "CREATE TABLESPACE ts1 LOCATION '$realTSDir'"); $node->safe_psql('postgres', "CREATE TABLESPACE ts1 LOCATION '$realTSDir'");
$node->safe_psql('postgres', $node->safe_psql('postgres',

11
src/test/recovery/t/017_shm.pl
View File

@ -12,14 +12,6 @@ use Time::HiRes qw(usleep);
plan tests => 5; plan tests => 5;
# See PostgresNode
my $vfs_path = '';
if ($Config{osname} eq 'msys')
{
$vfs_path = `cd / && pwd -W`;
chomp $vfs_path;
}
my $tempdir = TestLib::tempdir; my $tempdir = TestLib::tempdir;
my $port; my $port;
@ -103,10 +95,11 @@ log_ipcs();
# Scenarios involving no postmaster.pid, dead postmaster, and a live backend. # Scenarios involving no postmaster.pid, dead postmaster, and a live backend.
# Use a regress.c function to emulate the responsiveness of a backend working # Use a regress.c function to emulate the responsiveness of a backend working
# through a CPU-intensive task. # through a CPU-intensive task.
my $regress_shlib = TestLib::perl2host($ENV{REGRESS_SHLIB});
$gnat->safe_psql('postgres', <<EOSQL); $gnat->safe_psql('postgres', <<EOSQL);
CREATE FUNCTION wait_pid(int) CREATE FUNCTION wait_pid(int)
RETURNS void RETURNS void
AS '$vfs_path$ENV{REGRESS_SHLIB}' AS '$regress_shlib'
LANGUAGE C STRICT; LANGUAGE C STRICT;
EOSQL EOSQL
my $slow_query = 'SELECT wait_pid(pg_backend_pid())'; my $slow_query = 'SELECT wait_pid(pg_backend_pid())';