On Wed, Jun 17, 2020 at 04:44:34PM +0900, Michael Paquier wrote:
> Okay.  This could be a problem as jacana is proving to have good
> coverage AFAIK.  So it looks like we are really heading in the
> direction is still skipping the test if there is no support for
> symlink in the environment. At least that makes less diffs in the
> patch.

I have implemented a patch based on the feedback received that does
the following, tested with all three patterns (MSVC only on Windows):
- Assume that all non-Windows platform have a proper symlink
implementation for perl.
- If on Windows, check for the presence of Win32::Symlink:
-- If the module is not detected, skip the tests not supported.
-- If the module is detected, run them.

I have added this patch to the next commit fest:
https://commitfest.postgresql.org/28/2612/

Thanks,
--
Michael
diff --git a/src/bin/pg_basebackup/t/010_pg_basebackup.pl b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
index 208df557b8..715bf9a309 100644
--- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl
+++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
@@ -211,11 +211,11 @@ $node->command_fails(
 	'pg_basebackup tar with long name fails');
 unlink "$pgdata/$superlongname";
 
-# The following tests test symlinks. Windows doesn't have symlinks, so
-# skip on Windows.
+# The following tests test symlinks. Windows may not have symlinks, so
+# skip there.
 SKIP:
 {
-	skip "symlinks not supported on Windows", 18 if ($windows_os);
+	skip "symlinks not supported on this platform", 18 if (!$symlink_support);
 
 	# Move pg_replslot out of $pgdata and create a symlink to it.
 	$node->stop;
@@ -238,11 +238,12 @@ SKIP:
 	# for the tablespace directories, which hopefully won't run afoul of
 	# the 99 character length limit.
 	my $shorter_tempdir = TestLib::tempdir_short . "/tempdir";
+	my $realTsDir       = TestLib::perl2host("$shorter_tempdir/tblspc1");
 	symlink "$tempdir", $shorter_tempdir;
 
 	mkdir "$tempdir/tblspc1";
 	$node->safe_psql('postgres',
-		"CREATE TABLESPACE tblspc1 LOCATION '$shorter_tempdir/tblspc1';");
+		"CREATE TABLESPACE tblspc1 LOCATION '$realTsDir';");
 	$node->safe_psql('postgres',
 		"CREATE TABLE test1 (a int) TABLESPACE tblspc1;");
 	$node->command_ok([ 'pg_basebackup', '-D', "$tempdir/tarbackup2", '-Ft' ],
@@ -292,18 +293,33 @@ SKIP:
 		],
 		'plain format with tablespaces succeeds with tablespace mapping');
 	ok(-d "$tempdir/tbackup/tblspc1", 'tablespace was relocated');
-	opendir(my $dh, "$pgdata/pg_tblspc") or die;
-	ok( (   grep {
-				-l "$tempdir/backup1/pg_tblspc/$_"
-				  and readlink "$tempdir/backup1/pg_tblspc/$_" eq
-				  "$tempdir/tbackup/tblspc1"
-			} readdir($dh)),
-		"tablespace symlink was updated");
-	closedir $dh;
+
+	# Symlink checks are not supported on Windows.  Win32::Symlink works
+	# around this situation by using junction points (actually PostgreSQL
+	# approach on the problem), and -l is not able to detect that situation.
+  SKIP:
+	{
+		skip "symlink check not implemented on Windows", 1
+		  if ($windows_os);
+		opendir(my $dh, "$pgdata/pg_tblspc") or die;
+		ok( (   grep {
+					-l "$tempdir/backup1/pg_tblspc/$_"
+					  and readlink "$tempdir/backup1/pg_tblspc/$_" eq
+					  "$tempdir/tbackup/tblspc1"
+				} readdir($dh)),
+			"tablespace symlink was updated");
+		closedir $dh;
+	}
 
 	# Group access should be enabled on all backup files
-	ok(check_mode_recursive("$tempdir/backup1", 0750, 0640),
-		"check backup dir permissions");
+  SKIP:
+	{
+		skip "unix-style permissions not supported on Windows", 1
+		  if ($windows_os);
+
+		ok(check_mode_recursive("$tempdir/backup1", 0750, 0640),
+			"check backup dir permissions");
+	}
 
 	# Unlogged relation forks other than init should not be copied
 	my ($tblspc1UnloggedBackupPath) =
diff --git a/src/bin/pg_rewind/t/004_pg_xlog_symlink.pl b/src/bin/pg_rewind/t/004_pg_xlog_symlink.pl
index 639eeb9c91..0797142588 100644
--- a/src/bin/pg_rewind/t/004_pg_xlog_symlink.pl
+++ b/src/bin/pg_rewind/t/004_pg_xlog_symlink.pl
@@ -7,9 +7,9 @@ use File::Copy;
 use File::Path qw(rmtree);
 use TestLib;
 use Test::More;
-if ($windows_os)
+if (!$symlink_support)
 {
-	plan skip_all => 'symlinks not supported on Windows';
+	plan skip_all => 'symlinks not supported on this platform';
 	exit;
 }
 else
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index d579d5c177..e9cd045f06 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -22,6 +22,7 @@ TestLib - helper module for writing PostgreSQL's C<prove> tests.
 
   # Miscellanea
   print "on Windows" if $TestLib::windows_os;
+  print "supports symlinks" if $TestLib::symlink_support;
   my $path = TestLib::perl2host($backup_dir);
   ok(check_mode_recursive($stream_dir, 0700, 0600),
     "check stream dir permissions");
@@ -84,10 +85,12 @@ our @EXPORT = qw(
   command_checks_all
 
   $windows_os
+  $symlink_support
   $use_unix_sockets
 );
 
-our ($windows_os, $use_unix_sockets, $tmp_check, $log_path, $test_logfile);
+our ($windows_os, $symlink_support, $use_unix_sockets, $tmp_check, $log_path,
+	$test_logfile);
 
 BEGIN
 {
@@ -120,6 +123,28 @@ BEGIN
 		Win32API::File->import(qw(createFile OsFHandleOpen CloseHandle));
 	}
 
+	# Check if this environment has support for symlinks.  Windows
+	# may provide an equivalent implementation based on junction
+	# points thanks to Win32::Symlink.  Non-Windows platforms should
+	# have an implementation natively available.
+	if ($windows_os)
+	{
+		eval { require Win32::Symlink; };
+		if ($@)
+		{
+			$symlink_support = 0;
+		}
+		else
+		{
+			$symlink_support = 1;
+			Win32::Symlink->import(qw(readlink symlink));
+		}
+	}
+	else
+	{
+		$symlink_support = 1;
+	}
+
 	# Specifies whether to use Unix sockets for test setups.  On
 	# Windows we don't use them by default since it's not universally
 	# supported, but it can be overridden if desired.
@@ -137,6 +162,10 @@ BEGIN
 
 Set to true when running under Windows, except on Cygwin.
 
+=item C<$symlink_support>
+
+Set to true when running on a platform that supports symlinks.
+
 =back
 
 =cut

Attachment: signature.asc
Description: PGP signature

Reply via email to