[PATCH] Fix nested gdb_caching_proc with args; Fix gdb.rocm/ tests

[Pedro Alves <pedro@palves.net>]

Commit d09eba07 ("Make get_compiler_info use gdb_caching_proc")
regressed the gdb.rocm/ testsuite.  E.g.:

 Running /home/pedro/rocm/gdb/build/gdb/testsuite/../../../src/gdb/testsuite/gdb.rocm/simple.exp ...
 ERROR: tcl error sourcing /home/pedro/rocm/gdb/build/gdb/testsuite/../../../src/gdb/testsuite/gdb.rocm/simple.exp.
 ERROR: tcl error code TCL WRONGARGS
 ERROR: wrong # args: should be "gdb_real__get_compiler_info_1 language"
     while executing
 "gdb_real__get_compiler_info_1"
     ("uplevel" body line 1)
     invoked from within
 "uplevel 2 $real_name"
     (procedure "gdb_do_cache_wrap" line 3)
     invoked from within
 "gdb_do_cache_wrap $real_name {*}$args"
     (procedure "gdb_do_cache" line 98)
     invoked from within

This is actually a latent problem in gdb_do_cache_wrap, introduced in:

 commit 71f1ab80f1aabd70bce526635f84c7b849e8a0f4
 CommitDate: Mon Mar 6 16:49:19 2023 +0100

    [gdb/testsuite] Allow args in gdb_caching_proc

This change:

   # Call proc real_name and return the result, while ignoring calls to pass.
  -proc gdb_do_cache_wrap {real_name} {
  +proc gdb_do_cache_wrap {real_name args} {
       if { [info procs save_pass] != "" } {
	  return [uplevel 2 $real_name]   <<<<<<<<<<<<<<<<<<<<<<< HERE
       }
  @@ -31,7 +31,7 @@ proc gdb_do_cache_wrap {real_name} {
       rename pass save_pass
       rename ignore_pass pass

  -    set code [catch {uplevel 2 $real_name} result]
  +    set code [catch {uplevel 2 [list $real_name {*}$args]} result]

Missed updating the line marked with HERE above, to pass down $args.
So the case of a caching proc calling another caching proc with args
isn't handled correctly.

We could fix this by fixing the HERE line like so:

 -	  return [uplevel 2 $real_name]
 +	  return [uplevel 2 [list $real_name {*}$args]]

However, we have with_override nowadays that we can use here which
eliminates the duplicated logic, which was what was missed originally.

A new test that exposes the problem is added to
gdb.testsuite/gdb-caching-proc.exp.

This also adds a new test to gdb.testsuite/with-override.exp that I
think was missing, making sure that the inner foo override restores
the outer foo override.

Change-Id: I8b2a7366bf910902fe5f547bde58c3b475bf5133
---
 .../gdb.testsuite/gdb-caching-proc.exp        | 21 +++++++++++++------
 gdb/testsuite/gdb.testsuite/with-override.exp |  4 ++++
 gdb/testsuite/lib/cache.exp                   | 21 ++-----------------
 3 files changed, 21 insertions(+), 25 deletions(-)

diff --git a/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp b/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp
index f9610afd076..6b46b1c555a 100644
--- a/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp
+++ b/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp
@@ -22,23 +22,32 @@ gdb_caching_proc gdb_testsuite_gdb_caching_proc_exp_arg { arg } {
     return $arg
 }
 
+gdb_caching_proc gdb_testsuite_gdb_caching_proc_exp_arg_nested { arg } {
+    incr ::count
+    return [gdb_testsuite_gdb_caching_proc_exp_arg $arg]
+}
+
+# List of "expected $::count after running expression" and
+# "expression".
 set assertions {
-    { [gdb_testsuite_gdb_caching_proc_exp_noarg] == 1 }
-    { [gdb_testsuite_gdb_caching_proc_exp_arg 1] == 1 }
-    { [gdb_testsuite_gdb_caching_proc_exp_arg "foo foo"] == "foo foo" }
+    1 { [gdb_testsuite_gdb_caching_proc_exp_noarg] == 1 }
+    1 { [gdb_testsuite_gdb_caching_proc_exp_arg 1] == 1 }
+    1 { [gdb_testsuite_gdb_caching_proc_exp_arg "foo foo"] == "foo foo" }
+    1 { [gdb_testsuite_gdb_caching_proc_exp_arg_nested "foo foo"] == "foo foo" }
+    2 { [gdb_testsuite_gdb_caching_proc_exp_arg_nested "bar bar"] == "bar bar" }
 }
 
 set assertion_nr 0
-foreach assertion $assertions {
+foreach {expected_count assertion} $assertions {
     with_test_prefix $assertion_nr {
 	set ::count 0
 
 	gdb_assert $assertion
-	gdb_assert { $::count == 1 }
+	gdb_assert { $::count == $expected_count }
 
 	with_test_prefix cached {
 	    gdb_assert $assertion
-	    gdb_assert { $::count == 1 }
+	    gdb_assert { $::count == $expected_count }
 	}
     }
     incr assertion_nr
diff --git a/gdb/testsuite/gdb.testsuite/with-override.exp b/gdb/testsuite/gdb.testsuite/with-override.exp
index 1a4ee6adbbb..2a316f904e4 100644
--- a/gdb/testsuite/gdb.testsuite/with-override.exp
+++ b/gdb/testsuite/gdb.testsuite/with-override.exp
@@ -42,6 +42,10 @@ with_test_prefix no-args {
 		gdb_assert { [foo] == 2 }
 	    }
 	}
+
+	with_test_prefix "foo1 again" {
+	    gdb_assert { [foo] == 1 }
+	}
     }
 
     with_test_prefix after {
diff --git a/gdb/testsuite/lib/cache.exp b/gdb/testsuite/lib/cache.exp
index 6ca3f183f9f..b4c5fab2b98 100644
--- a/gdb/testsuite/lib/cache.exp
+++ b/gdb/testsuite/lib/cache.exp
@@ -24,26 +24,9 @@ proc ignore_pass { msg } {
 
 # Call proc real_name and return the result, while ignoring calls to pass.
 proc gdb_do_cache_wrap {real_name args} {
-    if { [info procs save_pass] != "" } {
-	return [uplevel 2 $real_name]
+    with_override pass ignore_pass {
+	return [$real_name {*}$args]
     }
-
-    rename pass save_pass
-    rename ignore_pass pass
-
-    set code [catch {uplevel 2 [list $real_name {*}$args]} result]
-
-    rename pass ignore_pass
-    rename save_pass pass
-
-    if {$code == 1} {
-	global errorInfo errorCode
-	return -code error -errorinfo $errorInfo -errorcode $errorCode $result
-    } elseif {$code > 1} {
-	return -code $code $result
-    }
-
-    return $result
 }
 
 # Global written to by gdb_exit_called proc.  Is set to true to

base-commit: d09eba07ca013e6b95eeafd67d79c32ebf6f28eb
-- 
2.51.0