1 # Copyright 2012-2020 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 3 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
17 # The in-memory cache.
18 array set gdb_data_cache {}
20 # Print pass message msg into gdb.log
21 proc ignore_pass { msg } {
22 verbose -log "gdb_do_cache_wrap ignoring pass: $msg"
25 # Call proc real_name and return the result, while ignoring calls to pass.
26 proc gdb_do_cache_wrap {real_name} {
27 if { [info procs save_pass] != "" } {
28 return [uplevel 2 $real_name]
32 rename ignore_pass pass
34 set code [catch {uplevel 2 $real_name} result]
36 rename pass ignore_pass
40 global errorInfo errorCode
41 return -code error -errorinfo $errorInfo -errorcode $errorCode $result
42 } elseif {$code > 1} {
43 return -code $code $result
49 # A helper for gdb_caching_proc that handles the caching.
51 proc gdb_do_cache {name} {
52 global gdb_data_cache objdir
55 # See if some other process wrote the cache file. Cache value per
56 # "board" to handle runs with multiple options
57 # (e.g. unix/{-m32,-64}) correctly. We use "file join" here
58 # because we later use this in a real filename.
59 set cache_name [file join [target_info name] $name]
61 if {[info exists gdb_data_cache($cache_name)]} {
62 verbose "$name: returning '$gdb_data_cache($cache_name)' from cache" 2
63 return $gdb_data_cache($cache_name)
66 if {[info exists GDB_PARALLEL]} {
67 set cache_filename [make_gdb_parallel_path cache $cache_name]
68 if {[file exists $cache_filename]} {
69 set fd [open $cache_filename]
70 set gdb_data_cache($cache_name) [read -nonewline $fd]
72 verbose "$name: returning '$gdb_data_cache($cache_name)' from file cache" 2
73 return $gdb_data_cache($cache_name)
77 set real_name gdb_real__$name
78 set gdb_data_cache($cache_name) [gdb_do_cache_wrap $real_name]
80 if {[info exists GDB_PARALLEL]} {
81 verbose "$name: returning '$gdb_data_cache($cache_name)' and writing file" 2
82 file mkdir [file dirname $cache_filename]
83 # Make sure to write the results file atomically.
84 set fd [open $cache_filename.[pid] w]
85 puts $fd $gdb_data_cache($cache_name)
87 file rename -force -- $cache_filename.[pid] $cache_filename
89 return $gdb_data_cache($cache_name)
92 # Define a new proc named NAME that takes no arguments. BODY is the
93 # body of the proc. The proc will evaluate BODY and cache the
94 # results, both in memory and, if GDB_PARALLEL is defined, in the
95 # filesystem for use across invocations of dejagnu.
97 proc gdb_caching_proc {name body} {
98 # Define the underlying proc that we'll call.
99 set real_name gdb_real__$name
100 proc $real_name {} $body
102 # Define the advertised proc.
103 proc $name {} [list gdb_do_cache $name]