[gdb/testsuite] Factor out proc with_lock

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.

Approved-By: Tom Tromey <tom@tromey.com>

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 34752081b609a7d73232344a738bd1a1c4e4fd6e..4205f8d1a22725a0a12a28bac6c25453c6e72a92 100644 (file)
--- 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 ab21db6685cffe889b10ea20da601e3a07bab027..7dd7ef3f3b55dfd2824cb5fa1e0cf18aeee3d8b8 100644 (file)
--- 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