[PATCH] [gdb/testsuite] Refactor lock_file_{acquire,release}

[Tom de Vries <tdevries@suse.de>]

Refactor lock_file_acquire to limit the loop body to the minimum.

Also make error handling more precise by only ignoring EEXIST.

Refactor both lock_file_acquire and lock_file_release to use better variable
names.

Add a test-case checking how the two procs interact.

In order to facilitate more complex testing, factor out a lock_file_acquire
parameter called on_retry, without changing default behavior.
---
 gdb/testsuite/gdb.testsuite/lock.exp | 86 ++++++++++++++++++++++++++++
 gdb/testsuite/lib/gdb-utils.exp      | 59 ++++++++++++-------
 2 files changed, 123 insertions(+), 22 deletions(-)
 create mode 100644 gdb/testsuite/gdb.testsuite/lock.exp

diff --git a/gdb/testsuite/gdb.testsuite/lock.exp b/gdb/testsuite/gdb.testsuite/lock.exp
new file mode 100644
index 00000000000..86a972e807c
--- /dev/null
+++ b/gdb/testsuite/gdb.testsuite/lock.exp
@@ -0,0 +1,86 @@
+# Copyright 2026 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+set lockfile [build_standard_output_file "lock.txt"]
+gdb_assert {![file exists $lockfile]} "Initial"
+
+# Scenario 1:
+# - acquire 1
+# - release 1
+with_test_prefix "simple" {
+    set res [lock_file_acquire $lockfile]
+    gdb_assert {[file exists $lockfile]} "Acquire lock"
+
+    lock_file_release $res
+    gdb_assert {![file exists $lockfile]} "Release lock"
+}
+
+# Scenario 2:
+# - acquire 1
+# - acquire 2 fails.  On retry, release 1.  Acquire 2 succeeds.
+# - release 2
+with_test_prefix "on retry unlock" {
+    set res [lock_file_acquire $lockfile]
+    gdb_assert {[file exists $lockfile]} "Acquire lock"
+
+    set on_retry [list lock_file_release $res]
+    # Try to acquire the lock.  That should fail.
+    # Then on retry, release the lock.
+    # The next try to acquire the lock should succeed.
+    set res2 [lock_file_acquire $lockfile $on_retry]
+    gdb_assert {[file exists $lockfile]} "Re-acquire lock"
+
+    lock_file_release $res2
+    gdb_assert {![file exists $lockfile]} "Release lock"
+}
+
+# Scenario 3:
+# - acquire 1
+# - acquire 2 fails, waits, and tries again in a loop.
+# - release 1, acquire 2 succeeds.
+# - release 2
+with_test_prefix "on retry wait" {
+    set res [lock_file_acquire $lockfile]
+    gdb_assert {[file exists $lockfile]} "Acquire lock"
+
+    after 1000 {lock_file_release $res}
+
+    set on_retry {
+	update
+	after 100
+    }
+    set res2 [lock_file_acquire $lockfile $on_retry]
+    gdb_assert {[file exists $lockfile]} "Re-acquire lock"
+
+    lock_file_release $res2
+    gdb_assert {![file exists $lockfile]} "Release lock"
+}
+
+# Scenario 4:
+# - acquire 1
+# - acquire 2 fails
+with_test_prefix "on retry return" {
+    set res [lock_file_acquire $lockfile]
+    gdb_assert {[file exists $lockfile]} "Acquire lock"
+
+    set on_retry {
+	return {}
+    }
+    set res2 [lock_file_acquire $lockfile $on_retry]
+    gdb_assert {$res2 == {}} "Acquire lock again"
+
+    lock_file_release $res
+    gdb_assert {![file exists $lockfile]} "Release lock"
+}
diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 35329f3c46e..aa286b74abc 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -178,27 +178,39 @@ proc version_compare { l1 op l2 } {
     return 1
 }
 
-# Acquire lock file LOCKFILE.  Tries forever until the lock file is
-# successfully created.
-
-proc lock_file_acquire {lockfile} {
+# Acquire lock file LOCKFILE.
+# If the lock file doesn't exist, create it and return a file handle/file name
+# pair.
+# If lock file does exist, with default ON_RETRY try again.  A custom ON_RETRY
+# may do something different like, for instance, using return.
+# Returns {} on failure.
+
+proc lock_file_acquire {lockfile {on_retry {after 10}}} {
     verbose -log "acquiring lock file: $::subdir/${::gdb_test_file_name}.exp"
-    while {true} {
+
+    while {![info exists fh]} {
 	try {
-	    open $lockfile {WRONLY CREAT EXCL}
-	} on ok {rc} {
-	    set msg "locked by $::subdir/${::gdb_test_file_name}.exp"
-	    verbose -log "lock file: $msg"
-	    # For debugging, put info in the lockfile about who owns
-	    # it.
-	    puts  $rc $msg
-	    flush $rc
-	    return [list $rc $lockfile]
-	} on error {} {
-	    # Ignore and try again.
+	    set fh [open $lockfile {WRONLY CREAT EXCL}]
+	} trap "POSIX EEXIST" {} {
+	    # Lock in use.  Ignore and try again.  Propagate all other errors.
+	    uplevel 1 $on_retry
 	}
-	after 10
     }
+
+    # Handle the case that ON_RETRY breaks out of the loop.
+    if {![info exists fh]} {
+	return {}
+    }
+
+    set msg "locked by $::subdir/${::gdb_test_file_name}.exp"
+    verbose -log "lock file: $msg"
+
+    # For debugging, put info in the lockfile about who owns
+    # it.
+    puts  $fh $msg
+    flush $fh
+
+    return [list $fh $lockfile]
 }
 
 # Release a lock file.
@@ -206,17 +218,20 @@ proc lock_file_acquire {lockfile} {
 proc lock_file_release {info} {
     verbose -log "releasing lock file: $::subdir/${::gdb_test_file_name}.exp"
 
+    set fh [lindex $info 0]
+    set lockfile [lindex $info 1]
+
     try {
-	fconfigure [lindex $info 0]
+	fconfigure $fh
     } on error {} {
 	error "invalid lock"
     }
 
     try {
-	close [lindex $info 0]
-	file delete -force [lindex $info 1]
-    } on error {rc} {
-	error "Error releasing lockfile: '$rc'"
+	close $fh
+	file delete -force $lockfile
+    } on error {err_msg} {
+	error "Error releasing lockfile: '$err_msg'"
     }
 
     return ""

base-commit: aea8b82af17261c88ab4e4b8e623903c49fc81c0
-- 
2.51.0