From 87e75dbff60d4cca96aaedf7f898a54e728874ec Mon Sep 17 00:00:00 2001
From: Thomas Munro <thomas.munro@gmail.com>
Date: Sat, 20 Apr 2024 17:18:46 +1200
Subject: [PATCH 1/2] More Windows pseudo-symlink support for Perl code.

We already had PostgreSQL::Test::Utils::dir_symlink() to make junction
points, which we used instead of symlinks on Windows.  Add is_symlink()
and read_symlink() functions, for use by TAP tests.

FIXME I don't know how to access the name FILE_ATTRIBUTE_REPARSE_POINT
from Win32API::File without getting weird "barename" warnings, because I
don't know perl, so I just looked up the numerical value, which works.
---
 src/test/perl/PostgreSQL/Test/Utils.pm | 46 +++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 022b44ba22..5e3dfc8f1b 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -71,6 +71,8 @@ our @EXPORT = qw(
   chmod_recursive
   check_pg_config
   dir_symlink
+  is_symlink
+  read_symlink
   scan_server_header
   system_or_bail
   system_log
@@ -155,7 +157,7 @@ BEGIN
 	if ($windows_os)
 	{
 		require Win32API::File;
-		Win32API::File->import(qw(createFile OsFHandleOpen CloseHandle));
+		Win32API::File->import(qw(createFile OsFHandleOpen CloseHandle GetFileAttributes));
 	}
 
 	# Specifies whether to use Unix sockets for test setups.  On
@@ -805,6 +807,48 @@ sub dir_symlink
 
 =pod
 
+=item is_symlink(path)
+
+Portably test if a path is a symlink.  On Windows this tests for a junction
+point.
+
+=cut
+
+sub is_symlink
+{
+	my $path = shift;
+	if ($windows_os)
+	{
+		return GetFileAttributes($path) & 1024; # FILE_ATTRIBUTE_REPARSE_POINT
+	}
+	else
+	{
+		return -l $path;
+	}
+}
+
+=pod
+
+=item read_symlink(path)
+
+Portably read a symlink.  On Windows, perl's readlink() already knows how to
+read junction points.  To match dirmod.c's pgreadlink(), we strip the prefix
+from the full NT path and return just the "drive absolute" part.
+
+=cut
+
+sub read_symlink
+{
+	my $path = shift;
+	my $result = readlink($path);
+
+	$result =~ s/^\\\?\?\\// if $windows_os;
+
+	return $result;
+}
+
+=pod
+
 =back
 
 =head1 Test::More-LIKE METHODS
-- 
2.39.3 (Apple Git-146)