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

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

[Tom de Vries]

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

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

[Andrew Burgess]

Tom de Vries <tdevries@suse.de> writes:

> Refactor lock_file_acquire to limit the loop body to the minimum.

It would be great if commits like this explained a little more about
what was being changed and why.  Why does it need reducing?

>
> 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.

It would be nice if there was greater clarity here on the ON_RETRY API.
For example, if ON_RETRY uses return then this will return directly to
the caller proc, leaving lock_file_acquire, this should be called out I
think.

> +
> +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

This use of uplevel seems to make the API much more complex, with us
having to handle returns directly from ON_RETRY to the caller proc.  Is
this complexity really needed?

>  	}
> -	after 10
>      }
> +
> +    # Handle the case that ON_RETRY breaks out of the loop.
> +    if {![info exists fh]} {
> +	return {}

This code path requires ON_RETRY to use break, but none of the new tests
do this, so this path is untested, would be nice if this case was
covered too.

> +    }

My AI review tool highlighted this comment as potentially confusing, and
I think in this case I agree.  Though the comment does mention 'break'
it is not clear that this path is only encountered when ON_RETRY uses
'break'.

> +
> +    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

There's an extra space after puts, though I see this was a preexisting
mistake.


Thanks,
Andrew

> +    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