On Wed, Nov 6, 2019 at 4:38 PM Alvaro Herrera <[email protected]>
wrote:
> On 2019-Nov-05, Michael Paquier wrote:
>
> > On Sun, Nov 03, 2019 at 10:53:00PM -0500, Tom Lane wrote:
> > > That is, TestLib::slurp_file is failing to read a file. Almost
> > > certainly, "permission denied" doesn't really mean a permissions
> > > problem, but failure to specify the file-opening flags needed to
> > > allow concurrent access on Windows. We fixed this in pg_ctl
> > > itself in commit 0ba06e0bf ... but we didn't fix the TAP
> > > infrastructure. Is there an easy way to get Perl on board
> > > with that?
> >
> > If we were to use Win32API::File so as the file is opened in shared
> > mode, we would do the same as what our frontend/backend code does (see
> > $uShare):
> > https://metacpan.org/pod/Win32API::File
>
> Compatibility-wise, that should be okay, since that module appears to
> have been distributed with Perl core early on.
>
>
Please find attached a patch that adds the FILE_SHARE options to
TestLib::slurp_file using Win32API::File.
Regards,
Juan José Santamaría Flecha
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 905d0d1..25ab1f2 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -112,6 +112,22 @@ BEGIN
# Must be set early
$windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
+ if ($windows_os)
+ {
+ require Win32::API;
+ Win32::API->import;
+
+ require Win32API::File;
+ Win32API::File->import(qw(
+ :Func
+ :Misc
+ :FILE_
+ :FILE_FLAG_
+ :FILE_SHARE_
+ :FILE_ATTRIBUTE_
+ :GENERIC_
+ ));
+ }
}
=pod
@@ -394,10 +410,25 @@ sub slurp_file
{
my ($filename) = @_;
local $/;
- open(my $in, '<', $filename)
- or die "could not read \"$filename\": $!";
- my $contents = <$in>;
- close $in;
+ my $contents;
+ if (!$windows_os)
+ {
+ open(my $in, '<', $filename)
+ or die "could not read \"$filename\": $!";
+ $contents = <$in>;
+ close $in;
+ }
+ else
+ {
+ my $fHandle = CreateFile($filename, GENERIC_READ(),
+ FILE_SHARE_DELETE()|FILE_SHARE_READ()|FILE_SHARE_WRITE(), [], OPEN_EXISTING(), 0, [])
+ or die "could not read \"$filename\": $^E";
+ OsFHandleOpen(my $fh = IO::Handle->new(), $fHandle, 'r')
+ or die "OsFHandleOpen: $^E\n";
+ $contents = <$fh>;
+ CloseHandle($fHandle)
+ or die "CloseHandle: $^E\n";
+ }
$contents =~ s/\r//g if $Config{osname} eq 'msys';
return $contents;
}
