[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 <tom@tromey.com>

diff --git a/gdb/testsuite/gdb.base/gdb-caching-proc.exp b/gdb/testsuite/gdb.base/gdb-caching-proc.exp
index 6610c25157a56f6acf4eb8667957ced98f864edf..df7715f9c248c585a89f554606ac72eab836cd4d 100644 (file)
--- 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 33a21df8f13e8ca44c7d3c616979285d4e9fe52d..6112b4090229459a31d8a84784a6ebab94fb29c4 100644 (file)
--- 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 5c44ed8dcf7e8c456fd97ec9c0a91f34ed011b0f..d221858e0d7f8b1e685ed6b646e90e55c0bc5a1c 100644 (file)
--- 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 04d49e658ba7b4bfeba48d046f692191eb375e21..e2b08c64eae5905c4171796a2af812535716aaf7 100644 (file)
--- 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]