Several TAP test suites have a need to translate from an msys path to a
Windows path. They currently use two ways to do that:
1. TestLib::real_dir, new in v11, is sound but works for directories only.
2. The $vfs_path approach is semi-private to PostgresNode.pm and 017_shm.pl,
and it does not work if the file falls in a mount point other than "/".
For example, it has been doing the wrong thing when builddir is
/c/nm/postgresql (falling in mount point /c).
I'd like to fix the mount point problem and consolidate these two methods. I
plan to call it TestLib::perl2host, since it translates a path in Perl's
notion of the filesystem to a path in the @host@ notion of the filesystem.
Attached.
diff --git a/src/bin/pg_checksums/t/002_actions.pl
b/src/bin/pg_checksums/t/002_actions.pl
index ce24d06..59228b9 100644
--- a/src/bin/pg_checksums/t/002_actions.pl
+++ b/src/bin/pg_checksums/t/002_actions.pl
@@ -183,7 +183,7 @@ check_relation_corruption($node, 'corrupt1', 'pg_default');
my $basedir = $node->basedir;
my $tablespace_dir = "$basedir/ts_corrupt_dir";
mkdir($tablespace_dir);
-$tablespace_dir = TestLib::real_dir($tablespace_dir);
+$tablespace_dir = TestLib::perl2host($tablespace_dir);
$node->safe_psql('postgres',
"CREATE TABLESPACE ts_corrupt LOCATION '$tablespace_dir';");
check_relation_corruption($node, 'corrupt2', 'ts_corrupt');
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 8d5ad6b..6019f37 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -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";
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index f8eb705..d2a9828 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -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
diff --git a/src/test/recovery/t/014_unlogged_reinit.pl
b/src/test/recovery/t/014_unlogged_reinit.pl
index 103c0a2..ee05e1a 100644
--- a/src/test/recovery/t/014_unlogged_reinit.pl
+++ b/src/test/recovery/t/014_unlogged_reinit.pl
@@ -30,7 +30,7 @@ ok(-f "$pgdata/$baseUnloggedPath", 'main fork in base
exists');
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',
diff --git a/src/test/recovery/t/017_shm.pl b/src/test/recovery/t/017_shm.pl
index f16821d..7f10ff5 100644
--- a/src/test/recovery/t/017_shm.pl
+++ b/src/test/recovery/t/017_shm.pl
@@ -12,14 +12,6 @@ use Time::HiRes qw(usleep);
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 $port;
@@ -103,10 +95,11 @@ log_ipcs();
# Scenarios involving no postmaster.pid, dead postmaster, and a live backend.
# Use a regress.c function to emulate the responsiveness of a backend working
# through a CPU-intensive task.
+my $regress_shlib = TestLib::perl2host($ENV{REGRESS_SHLIB});
$gnat->safe_psql('postgres', <<EOSQL);
CREATE FUNCTION wait_pid(int)
RETURNS void
- AS '$vfs_path$ENV{REGRESS_SHLIB}'
+ AS '$regress_shlib'
LANGUAGE C STRICT;
EOSQL
my $slow_query = 'SELECT wait_pid(pg_backend_pid())';
