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

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

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