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

diff --git a/src/bin/pg_checksums/t/002_actions.pl b/src/bin/pg_checksums/t/002_actions.pl
index ce24d06a10769b23d2e3f54003d5a2a5489dcdae..59228b916cb64a9cf39d9f5615cd1d6e3d513b0d 100644 (file)
--- 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 8d5ad6bc16663a73589924317dda87b60708fff9..6019f37f91226157969b8b27c77bd87472a55a32 100644 (file)
--- 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 f8eb7058a61e9ebfbcbb3f715ab4499cf3605998..d2a9828dc62199b96f87b02d2ed835315ae7ddd2 100644 (file)
--- 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 103c0a2b91ccdcfafd2f9d2b2470f48d67822edc..ee05e1a1ee11ced566d50d6ae93c554099b3a5f5 100644 (file)
--- 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 f16821d51fe97d3a0dc53f15f11d8e70d0eed4ea..7f10ff5225b13af55fb3c8c29f36b2114ff056bd 100644 (file)
--- 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())';