Hi,
On 2022-11-03 14:16:51 -0400, Andrew Dunstan wrote:
> > Here's a patch which I think does the right thing.
> Updated with a couple of thinkos fixed.
Thanks!
> diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
> index d80134b26f..aceca353d3 100644
> --- a/src/test/perl/PostgreSQL/Test/Cluster.pm
> +++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
> @@ -93,9 +93,9 @@ use warnings;
>
> use Carp;
> use Config;
> -use Fcntl qw(:mode);
> +use Fcntl qw(:mode :flock :seek O_CREAT O_RDWR);
Does this do anything useful on windows?
> # the minimum version we believe to be compatible with this package without
> # subclassing.
> @@ -140,6 +140,27 @@ INIT
>
> # Tracking of last port value assigned to accelerate free port lookup.
> $last_port_assigned = int(rand() * 16384) + 49152;
> +
> + # Set the port lock directory
> +
> + # If we're told to use a directory (e.g. from a buildfarm client)
> + # explicitly, use that
> + $portdir = $ENV{PG_TEST_PORT_DIR};
> + # Otherwise, try to use a directory at the top of the build tree
> + if (! $portdir && $ENV{MESON_BUILD_ROOT})
> + {
> + $portdir = $ENV{MESON_BUILD_ROOT} . '/portlock'
> + }
> + elsif (! $portdir && ($ENV{TESTDATADIR} || "") =~ /\W(src|contrib)\W/p)
> + {
> + my $dir = ${^PREMATCH};
> + $portdir = "$dir/portlock" if $dir;
> + }
> + # As a last resort use a directory under tmp_check
> + $portdir ||= $PostgreSQL::Test::Utils::tmp_check . '/portlock';
> + $portdir =~ s!\\!/!g;
> + # Make sure the directory exists
> + mkpath($portdir) unless -d $portdir;
> }
>
> =pod
> @@ -1505,6 +1526,7 @@ sub get_free_port
> last;
> }
> }
> + $found = _reserve_port($port) if $found;
> }
> }
>
> @@ -1535,6 +1557,38 @@ sub can_bind
> return $ret;
> }
>
> +# Internal routine to reserve a port number
> +# Returns 1 if successful, 0 if port is already reserved.
> +sub _reserve_port
> +{
> + my $port = shift;
> + # open in rw mode so we don't have to reopen it and lose the lock
> + sysopen(my $portfile, "$portdir/$port.rsv", O_RDWR|O_CREAT)
> + || die "opening port file";
> + # take an exclusive lock to avoid concurrent access
> + flock($portfile, LOCK_EX) || die "locking port file";
> + # see if someone else has or had a reservation of this port
> + my $pid = <$portfile>;
> + chomp $pid;
> + if ($pid +0 > 0)
Gotta love perl.
> + {
> + if (kill 0, $pid)
Does this work on windows?
Greetings,
Andres Freund
