prevent-concurrent-free-port-v2.patch

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);
 use File::Basename;
-use File::Path qw(rmtree);
+use File::Path qw(rmtree mkpath);
 use File::Spec;
 use File::stat qw(stat);
 use File::Temp ();
@@ -109,7 +109,7 @@ use Time::HiRes qw(usleep);
 use Scalar::Util qw(blessed);
 
 our ($use_tcp, $test_localhost, $test_pghost, $last_host_assigned,
-	$last_port_assigned, @all_nodes, $died);
+	$last_port_assigned, @all_nodes, $died, $portdir);
 
 # 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)
+	{
+		if (kill 0, $pid)
+		{
+			# process exists and is owned by us, so we can't reserve this port
+			close($portfile);
+			return 0;
+		}
+	}
+	# All good, go ahead and reserve the port, first rewind and truncate.
+	# If truncation fails it's not a tragedy, it just might leave some
+	# trailing junk in the file that won't affect us.
+	seek($portfile, 0, SEEK_SET);
+	truncate($portfile, 0);
+	print $portfile "$$\n";
+	close($portfile);
+	return 1;
+}
+
 # Automatically shut down any still-running nodes (in the same order the nodes
 # were created in) when the test script exits.
 END