[PATCH 3/7] [gdb/testsuite] Factor out proc with_lock

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

Factor out proc with_lock from with_rocm_gpu_lock, and move required procs
lock_file_acquire and lock_file_release to lib/gdb-utils.exp.

Tested on aarch64-linux.
---
 gdb/testsuite/lib/gdb-utils.exp | 59 +++++++++++++++++++++++++++++++++
 gdb/testsuite/lib/rocm.exp      | 55 +-----------------------------
 2 files changed, 60 insertions(+), 54 deletions(-)

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 34752081b60..4205f8d1a22 100644
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -138,3 +138,62 @@ 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} {
+    verbose -log "acquiring lock file: $::subdir/${::gdb_test_file_name}.exp"
+    while {true} {
+	if {![catch {open $lockfile {WRONLY CREAT EXCL}} 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]
+	}
+	after 10
+    }
+}
+
+# Release a lock file.
+
+proc lock_file_release {info} {
+    verbose -log "releasing lock file: $::subdir/${::gdb_test_file_name}.exp"
+
+    if {![catch {fconfigure [lindex $info 0]}]} {
+	if {![catch {
+	    close [lindex $info 0]
+	    file delete -force [lindex $info 1]
+	} rc]} {
+	    return ""
+	} else {
+	    return -code error "Error releasing lockfile: '$rc'"
+	}
+    } else {
+	error "invalid lock"
+    }
+}
+
+# Run body under lock LOCK_FILE.
+
+proc with_lock { lock_file body } {
+    if {[info exists ::GDB_PARALLEL]} {
+	set lock_rc [lock_file_acquire $lock_file]
+    }
+
+    set code [catch {uplevel 1 $body} result]
+
+    if {[info exists ::GDB_PARALLEL]} {
+	lock_file_release $lock_rc
+    }
+
+    if {$code == 1} {
+	global errorInfo errorCode
+	return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+    } else {
+	return -code $code $result
+    }
+}
diff --git a/gdb/testsuite/lib/rocm.exp b/gdb/testsuite/lib/rocm.exp
index ab21db6685c..7dd7ef3f3b5 100644
--- a/gdb/testsuite/lib/rocm.exp
+++ b/gdb/testsuite/lib/rocm.exp
@@ -108,68 +108,15 @@ gdb_caching_proc allow_hipcc_tests {} {
 # at a time.
 set gpu_lock_filename $objdir/gpu-parallel.lock
 
-# Acquire lock file LOCKFILE.  Tries forever until the lock file is
-# successfully created.
-
-proc lock_file_acquire {lockfile} {
-    verbose -log "acquiring lock file: $::subdir/${::gdb_test_file_name}.exp"
-    while {true} {
-	if {![catch {open $lockfile {WRONLY CREAT EXCL}} 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]
-	}
-	after 10
-    }
-}
-
-# Release a lock file.
-
-proc lock_file_release {info} {
-    verbose -log "releasing lock file: $::subdir/${::gdb_test_file_name}.exp"
-
-    if {![catch {fconfigure [lindex $info 0]}]} {
-	if {![catch {
-	    close [lindex $info 0]
-	    file delete -force [lindex $info 1]
-	} rc]} {
-	    return ""
-	} else {
-	    return -code error "Error releasing lockfile: '$rc'"
-	}
-    } else {
-	error "invalid lock"
-    }
-}
-
 # Run body under the GPU lock.  Also calls gdb_exit before releasing
 # the GPU lock.
 
 proc with_rocm_gpu_lock { body } {
-    if {[info exists ::GDB_PARALLEL]} {
-	set lock_rc [lock_file_acquire $::gpu_lock_filename]
-    }
-
-    set code [catch {uplevel 1 $body} result]
+    with_lock $::gpu_lock_filename $body
 
     # In case BODY returned early due to some testcase failing, and
     # left GDB running, debugging the GPU.
     gdb_exit
-
-    if {[info exists ::GDB_PARALLEL]} {
-	lock_file_release $lock_rc
-    }
-
-    if {$code == 1} {
-	global errorInfo errorCode
-	return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
-    } else {
-	return -code $code $result
-    }
 }
 
 # Return true if all the devices support debugging multiple processes
-- 
2.35.3