From 71f1ab80f1aabd70bce526635f84c7b849e8a0f4 Mon Sep 17 00:00:00 2001 From: Tom de Vries Date: Mon, 6 Mar 2023 16:49:19 +0100 Subject: [PATCH] [gdb/testsuite] Allow args in gdb_caching_proc Test-case gdb.base/morestack.exp contains: ... require {have_compile_flag -fsplit-stack} ... and I want to cache the result of have_compile_flag. Currently gdb_caching_proc doesn't allow args, so I could add: ... gdb_caching_proc have_compile_flag_fsplit_stack { return [have_compile_flag -fsplit-stack] } ... and then use that proc instead, but I find this cumbersome and maintenance-unfriendly. Instead, allow args in a gdb_caching_proc, such that I can simply do: ... -proc have_compile_flag { flag } { +gdb_caching_proc have_compile_flag { flag } { ... Note that gdb_caching_procs with args do not work with the gdb.base/gdb-caching-procs.exp test-case, so those procs are skipped. Tested on x86_64-linux. Reviewed-By: Tom Tromey --- gdb/testsuite/gdb.base/gdb-caching-proc.exp | 4 +++ .../gdb.testsuite/gdb-caching-proc.exp | 7 +++++ gdb/testsuite/lib/cache.exp | 31 ++++++++++--------- gdb/testsuite/lib/gdb.exp | 2 +- 4 files changed, 29 insertions(+), 15 deletions(-) diff --git a/gdb/testsuite/gdb.base/gdb-caching-proc.exp b/gdb/testsuite/gdb.base/gdb-caching-proc.exp index 6610c25157a..df7715f9c24 100644 --- a/gdb/testsuite/gdb.base/gdb-caching-proc.exp +++ b/gdb/testsuite/gdb.base/gdb-caching-proc.exp @@ -81,6 +81,10 @@ proc test_file { file } { } foreach procname $procnames { + if { [info args $procname] != "" } { + # With args. + continue + } with_test_prefix $procname { switch $procname { "is_address_zero_readable" { set setup_gdb 1 } diff --git a/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp b/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp index 33a21df8f13..6112b409022 100644 --- a/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp +++ b/gdb/testsuite/gdb.testsuite/gdb-caching-proc.exp @@ -17,8 +17,15 @@ gdb_caching_proc gdb_testsuite_gdb_caching_proc_exp_noarg {} { return 1 } +gdb_caching_proc gdb_testsuite_gdb_caching_proc_exp_arg { arg } { + incr ::count + return $arg +} + 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" } } set assertion_nr 0 diff --git a/gdb/testsuite/lib/cache.exp b/gdb/testsuite/lib/cache.exp index 5c44ed8dcf7..d221858e0d7 100644 --- a/gdb/testsuite/lib/cache.exp +++ b/gdb/testsuite/lib/cache.exp @@ -23,7 +23,7 @@ proc ignore_pass { msg } { } # 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] } @@ -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] rename pass ignore_pass rename save_pass pass @@ -48,7 +48,7 @@ proc gdb_do_cache_wrap {real_name} { # A helper for gdb_caching_proc that handles the caching. -proc gdb_do_cache {name} { +proc gdb_do_cache {name args} { global gdb_data_cache objdir global GDB_PARALLEL @@ -67,7 +67,7 @@ proc gdb_do_cache {name} { # "board" to handle runs with multiple options # (e.g. unix/{-m32,-64}) correctly. We use "file join" here # because we later use this in a real filename. - set cache_name [file join [target_info name] $name] + set cache_name [file join [target_info name] $name {*}$args] set is_cached 0 if {[info exists gdb_data_cache($cache_name)]} { @@ -95,7 +95,7 @@ proc gdb_do_cache {name} { } set real_name gdb_real__$name - set gdb_data_cache($cache_name) [gdb_do_cache_wrap $real_name] + set gdb_data_cache($cache_name) [gdb_do_cache_wrap $real_name {*}$args] if { $cache_verify == 1 && $is_cached == 1 } { set computed $gdb_data_cache($cache_name) if { $cached != $computed } { @@ -116,19 +116,22 @@ proc gdb_do_cache {name} { return $gdb_data_cache($cache_name) } -# Define a new proc named NAME that takes no arguments. BODY is the -# body of the proc. The proc will evaluate BODY and cache the -# results, both in memory and, if GDB_PARALLEL is defined, in the -# filesystem for use across invocations of dejagnu. +# Define a new proc named NAME, with optional args ARGS. BODY is the body of +# the proc. The proc will evaluate BODY and cache the results, both in memory +# and, if GDB_PARALLEL is defined, in the filesystem for use across +# invocations of dejagnu. +# proc gdb_caching_proc {name arglist body} { - if { [llength $arglist] != 0 } { - error "gdb_caching_proc with non-empty args list" - } # Define the underlying proc that we'll call. set real_name gdb_real__$name - proc $real_name {} $body + proc $real_name $arglist $body # Define the advertised proc. - proc $name {} [list gdb_do_cache $name] + set caching_proc_body [list gdb_do_cache $name] + foreach arg $arglist { + lappend caching_proc_body $$arg + } + set caching_proc_body [join $caching_proc_body] + proc $name $arglist $caching_proc_body } diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 04d49e658ba..e2b08c64eae 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -9427,7 +9427,7 @@ proc have_syscall { name } { # Return 1 if compile flag FLAG is supported. -proc have_compile_flag { flag } { +gdb_caching_proc have_compile_flag { flag } { set src { void foo () {} } return [gdb_can_simple_compile have_compile_flag_$flag $src object \ additional_flags=$flag] -- 2.30.2