[PATCH v2 1/6] [gdb/testsuite] Add gdb.testsuite/lock.exp

[PATCH v2 1/6] [gdb/testsuite] Add gdb.testsuite/lock.exp

[Tom de Vries]

I noticed there's no test-case for lock_file_{acquire,release}.

Add gdb.testsuite/lock.exp.
---
 gdb/testsuite/gdb.testsuite/lock.exp | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)
 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..67ea09390ac
--- /dev/null
+++ b/gdb/testsuite/gdb.testsuite/lock.exp
@@ -0,0 +1,28 @@
+# 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"
+}

base-commit: 4ba6bd8393418b63dc3efa0ec6f934903a10f140
-- 
2.51.0

[PATCH v2 2/6] [gdb/testsuite] Improve variable names in lock_file_{acquire, release}

[Tom de Vries]

In lock_file_acquire we assign the result of a call to proc open to a variable
called rc.

Use fh for file handle instead.

Then use the variable names fh and lockfile as used in lock_file_acquire in
lock_file_release.
---
 gdb/testsuite/lib/gdb-utils.exp | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 5d6165f9ba3..56d8e80f152 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -188,14 +188,14 @@ proc lock_file_acquire {lockfile} {
     while {true} {
 	try {
 	    open $lockfile {WRONLY CREAT EXCL}
-	} on ok {rc} {
+	} on ok {fh} {
 	    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]
+	    puts $fh $msg
+	    flush $fh
+	    return [list $fh $lockfile]
 	} on error {} {
 	    # Ignore and try again.
 	}
@@ -208,17 +208,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 ""
-- 
2.51.0

[PATCH v2 3/6] [gdb/testsuite] Simplify lock_file_acquire

[Tom de Vries]

Currently the entire functionality of lock_file_acquire is contained in a
loop, which makes control flow harder to follow, especially so given that the
loop also contains exception handling.

Instead, limit the scope of the loop to the part that actually needs
repeating: getting a valid file handle:
...
    while {![info exists fh]} {
	try {
	    set fh [open $lockfile {WRONLY CREAT EXCL}]
	} on error {} {
	    # Ignore and try again.
	    after 10
	}
    }
...

I also liked this version:
...
    while {true} {
	try {
	    set fh [open $lockfile {WRONLY CREAT EXCL}]
	    break
	} on error {} {
	    # Ignore and try again.
	    after 10
	    continue
	}
    }
...
but ended up choosing for the first because the loop condition states the goal
of the loop.
---
 gdb/testsuite/lib/gdb-utils.exp | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 56d8e80f152..854496e9bb1 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -185,22 +185,24 @@ proc version_compare { l1 op l2 } {
 
 proc lock_file_acquire {lockfile} {
     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 {fh} {
-	    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]
+	    set fh [open $lockfile {WRONLY CREAT EXCL}]
 	} on error {} {
 	    # Ignore and try again.
+	    after 10
 	}
-	after 10
     }
+
+    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.
-- 
2.51.0

[PATCH v2 4/6] [gdb/testsuite] Only retry on EEXIST in lock_file_acquire

[Tom de Vries]

It occurred to me that ignoring all errors in lock_file_acquire may be
undesirable.

Say you call lock_file_acquire with a lock file for which you have no
permission.  You'd get an EACCESS.  It doesn't make sense to keep retrying on
such an error.

Instead, only retry on the error that indicates that the lock is taken:
EEXIST.
---
 gdb/testsuite/lib/gdb-utils.exp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 854496e9bb1..1277558170d 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -189,8 +189,8 @@ proc lock_file_acquire {lockfile} {
     while {![info exists fh]} {
 	try {
 	    set fh [open $lockfile {WRONLY CREAT EXCL}]
-	} on error {} {
-	    # Ignore and try again.
+	} trap "POSIX EEXIST" {} {
+	    # Lock in use.  Ignore and try again.  Propagate all other errors.
 	    after 10
 	}
     }
-- 
2.51.0

[PATCH v2 5/6] [gdb/testsuite] Extend gdb.testsuite/lock.exp

[Tom de Vries]

The current test-case gdb.testsuite/lock.exp contains only a very basic test:
acquiring a lock, followed by releasing it.

I wanted to extend the test-case to trigger the case that the lock is taken.

I tried out:
...
set res [lock_file_acquire $lockfile]
gdb_assert {[file exists $lockfile]} "Acquire lock"

after 1000 {lock_file_release $res}

set res2 [lock_file_acquire $lockfile]
gdb_assert {[file exists $lockfile]} "Re-acquire lock"

lock_file_release $res2
gdb_assert {![file exists $lockfile]} "Release lock"
...
but found out that this hangs.

This can be fixed by using the update command [1] to allow the code scheduled
by after to execute:
...
 	    # Lock in use.  Ignore and try again.  Propagate all other errors.
+	    update
 	    after 10
...

We could just add this, but the update is not necessary for the normal use
case of lock_file_{acquire,release}: interprocess locking, so I'd rather not.

So instead, I added an interface to lock_file_acquire by which we can handle
this: an optional parameter on_retry.  Note that the default behavior hasn't
changed.

If on_retry is non-empty, it's called as a proc, and if the call returns 0,
no retry is done, and lock_file_acquire returns an empty list.

Add a test in gdb.testsuite/lock.exp to cover this scenario.

[1] https://www.tcl-lang.org/man/tcl9.0/TclCmd/update.html
---
 gdb/testsuite/gdb.testsuite/lock.exp | 40 ++++++++++++++++++++++++++++
 gdb/testsuite/lib/gdb-utils.exp      | 19 +++++++++----
 2 files changed, 54 insertions(+), 5 deletions(-)

diff --git a/gdb/testsuite/gdb.testsuite/lock.exp b/gdb/testsuite/gdb.testsuite/lock.exp
index 67ea09390ac..51859cb80db 100644
--- a/gdb/testsuite/gdb.testsuite/lock.exp
+++ b/gdb/testsuite/gdb.testsuite/lock.exp
@@ -26,3 +26,43 @@ with_test_prefix "simple" {
     lock_file_release $res
     gdb_assert {![file exists $lockfile]} "Release lock"
 }
+
+# Scenario 2:
+# - 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}
+
+    proc on_retry {} {
+	update
+	after 100
+	return 1
+    }
+    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
+with_test_prefix "on retry return" {
+    set res [lock_file_acquire $lockfile]
+    gdb_assert {[file exists $lockfile]} "Acquire lock"
+
+    proc on_retry {} {
+	return 0
+    }
+    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 1277558170d..9ccde20634e 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -180,10 +180,15 @@ 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.
+# - does exist, and:
+#   - ON_RETRY is empty, wait a bit and try again.
+#   - ON_RETRY is non-empty, call it.  If it returns 0, don't retry and
+#     return {} to indicate failure.
+
+proc lock_file_acquire {lockfile {on_retry ""}} {
     verbose -log "acquiring lock file: $::subdir/${::gdb_test_file_name}.exp"
 
     while {![info exists fh]} {
@@ -191,7 +196,11 @@ proc lock_file_acquire {lockfile} {
 	    set fh [open $lockfile {WRONLY CREAT EXCL}]
 	} trap "POSIX EEXIST" {} {
 	    # Lock in use.  Ignore and try again.  Propagate all other errors.
-	    after 10
+	    if {$on_retry == ""} {
+		after 10
+	    } elseif {![$on_retry]} {
+		return {}
+	    }
 	}
     }
 
-- 
2.51.0

[PATCH v2 6/6] [gdb/testsuite] Extend gdb.testsuite/lock.exp a bit more

[Tom de Vries]

The test-case gdb.testsuite/lock.exp contains a lock taken scenario, but it's
timing dependent, so while it's probable that the scenario is tested, is not
guaranteed.

Fix this by adding a scenario where we use the on_retry parameter to release
the lock.
---
 gdb/testsuite/gdb.testsuite/lock.exp | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/gdb/testsuite/gdb.testsuite/lock.exp b/gdb/testsuite/gdb.testsuite/lock.exp
index 51859cb80db..9815dc25bbb 100644
--- a/gdb/testsuite/gdb.testsuite/lock.exp
+++ b/gdb/testsuite/gdb.testsuite/lock.exp
@@ -66,3 +66,26 @@ with_test_prefix "on retry return" {
     lock_file_release $res
     gdb_assert {![file exists $lockfile]} "Release lock"
 }
+
+# Scenario 4:
+# - 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"
+
+    proc on_retry {} {
+	lock_file_release $::res
+	return 1
+    }
+
+    # 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"
+}
-- 
2.51.0