return $result
}
+# Global written to by gdb_exit_called proc. Is set to true to
+# indicate that a caching proc has called gdb_exit.
+
+set gdb_exit_called false
+
+# This proc is called via TCL's trace mechanism whenever gdb_exit is
+# called during the execution of a caching proc. This sets the global
+# flag to indicate that gdb_exit has been called.
+
+proc gdb_exit_called { args } {
+ set ::gdb_exit_called true
+}
+
+# If DO_EXIT is false then this proc does nothing. If DO_EXIT is true
+# then call gdb_exit the first time this proc is called for each
+# unique value of NAME within a single test. Every subsequent time
+# this proc is called within a single test (for a given value of
+# NAME), don't call gdb_exit.
+
+proc gdb_cache_maybe_gdb_exit { name do_exit } {
+ if { !$do_exit } {
+ return
+ }
+
+ # To track if this proc has been called for NAME we create a
+ # global variable. In gdb_cleanup_globals (see gdb.exp) this
+ # global will be deleted when the test has finished.
+ set global_name __${name}__cached_gdb_exit_called
+ if { ![info exists ::${global_name}] } {
+ gdb_exit
+ set ::${global_name} true
+ }
+}
+
# A helper for gdb_caching_proc that handles the caching.
proc gdb_do_cache {name args} {
set is_cached 0
if {[info exists gdb_data_cache(${cache_name},value)]} {
- set cached $gdb_data_cache(${cache_name},value)
- verbose "$name: returning '$cached' from cache" 2
+ set cached_value $gdb_data_cache(${cache_name},value)
+ set cached_exit $gdb_data_cache(${cache_name},exit)
+ verbose "$name: returning '$cached_value' from cache" 2
if { $cache_verify == 0 } {
- return $cached
+ gdb_cache_maybe_gdb_exit $name $cached_exit
+ return $cached_value
}
set is_cached 1
}
set cache_filename [make_gdb_parallel_path cache $cache_name]
if {[file exists $cache_filename]} {
set fd [open $cache_filename]
- set gdb_data_cache(${cache_name},value) [read -nonewline $fd]
+ set content [split [read -nonewline $fd] \n]
close $fd
- set cached $gdb_data_cache(${cache_name},value)
- verbose "$name: returning '$cached' from file cache" 2
+ set gdb_data_cache(${cache_name},value) [lindex $content 0]
+ set gdb_data_cache(${cache_name},exit) [lindex $content 1]
+ set cached_value $gdb_data_cache(${cache_name},value)
+ set cached_exit $gdb_data_cache(${cache_name},exit)
+ verbose "$name: returning '$cached_value' from file cache" 2
if { $cache_verify == 0 } {
- return $cached
+ gdb_cache_maybe_gdb_exit $name $cached_exit
+ return $cached_value
}
set is_cached 1
}
}
+ # Add a trace hook to gdb_exit. In the case of recursive calls to
+ # gdb_do_cache we only want to install the trace hook once, so we
+ # set a global to indicate that the trace is in place.
+ #
+ # We also set a local flag to indicate that this is the scope in
+ # which the debug trace needs to be removed.
+ if { ![info exists ::gdb_exit_trace_in_place] } {
+ trace add execution gdb_exit enter gdb_exit_called
+ set ::gdb_exit_trace_in_place true
+ set gdb_exit_trace_created true
+ } else {
+ set gdb_exit_trace_created false
+ }
+
+ # As above, we need to consider recursive calls into gdb_do_cache.
+ # Store the old value of gdb_exit_called global and then set the
+ # flag to false. Initially gdb_exit_called is always false, but
+ # for recursive calls to gdb_do_cache we can't know the state of
+ # gdb_exit_called.
+ #
+ # Before starting a recursive gdb_do_cache call we need
+ # gdb_exit_called to be false, that way the inner call can know if
+ # it invoked gdb_exit or not.
+ #
+ # Once the recursive call completes, if it did call gdb_exit then
+ # the outer, parent call to gdb_do_cache should also be considered
+ # as having called gdb_exit.
+ set old_gdb_exit_called $::gdb_exit_called
+ set ::gdb_exit_called false
+
set real_name gdb_real__$name
set gdb_data_cache(${cache_name},value) [gdb_do_cache_wrap $real_name {*}$args]
+ set gdb_data_cache(${cache_name},exit) $::gdb_exit_called
+
+ # See comment above where OLD_GDB_EXIT_CALLED is set: if
+ # GDB_EXIT_CALLED was previously true then this is a recursive
+ # call and the outer caching proc set the global true, so restore
+ # the true value now.
+ if { $old_gdb_exit_called } {
+ set ::gdb_exit_called true
+ }
+
+ # See comment above where GDB_EXIT_TRACE_CREATED is set: this is
+ # the frame in which the trace was installed. This must be the
+ # outer caching proc call (if an recursion occurred).
+ if { $gdb_exit_trace_created } {
+ trace remove execution gdb_exit enter gdb_exit_called
+ unset ::gdb_exit_trace_in_place
+ set ::gdb_exit_called false
+ }
+
+ # If a value being stored in the cache contains a newline then
+ # when we try to read the value back from an on-disk cache file
+ # we'll interpret the second line of the value as the ',exit' value.
+ if { [regexp "\[\r\n\]" $gdb_data_cache(${cache_name},value)] } {
+ set computed_value $gdb_data_cache(${cache_name},value)
+ error "Newline found in value for $cache_name: $computed_value"
+ }
+
if { $cache_verify == 1 && $is_cached == 1 } {
- set computed $gdb_data_cache(${cache_name},value)
- if { $cached != $computed } {
- error [join [list "Inconsistent results for $cache_name:"
- "cached: $cached vs. computed: $computed"]]
+ set computed_value $gdb_data_cache(${cache_name},value)
+ set computed_exit $gdb_data_cache(${cache_name},exit)
+ if { $cached_value != $computed_value } {
+ error [join [list "Inconsistent value results for $cache_name:"
+ "cached: $cached_value vs. computed: $computed_value"]]
+ }
+ if { $cached_exit != $computed_exit } {
+ error [join [list "Inconsistent exit results for $cache_name:"
+ "cached: $cached_exit vs. computed: $computed_exit"]]
}
}
# Make sure to write the results file atomically.
set fd [open $cache_filename.[pid] w]
puts $fd $gdb_data_cache(${cache_name},value)
+ puts $fd $gdb_data_cache(${cache_name},exit)
close $fd
file rename -force -- $cache_filename.[pid] $cache_filename
}
+ gdb_cache_maybe_gdb_exit $name $gdb_data_cache(${cache_name},exit)
return $gdb_data_cache(${cache_name},value)
}
catch default_gdb_exit
}
-# Helper function for can_spawn_for_attach. Try to spawn and attach, and
-# return 0 only if we cannot attach because it's unsupported.
-
-gdb_caching_proc can_spawn_for_attach_1 {} {
- # For the benefit of gdb-caching-proc-consistency.exp, which
- # calls can_spawn_for_attach_1 directly. Keep in sync with
- # can_spawn_for_attach.
- if { [is_remote target] || [target_info exists use_gdb_stub] } {
+# Return true if we can spawn a program on the target and attach to
+# it.
+
+gdb_caching_proc can_spawn_for_attach {} {
+ # We use exp_pid to get the inferior's pid, assuming that gives
+ # back the pid of the program. On remote boards, that would give
+ # us instead the PID of e.g., the ssh client, etc.
+ if {[is_remote target]} {
+ verbose -log "can't spawn for attach (target is remote)"
+ return 0
+ }
+
+ # The "attach" command doesn't make sense when the target is
+ # stub-like, where GDB finds the program already started on
+ # initial connection.
+ if {[target_info exists use_gdb_stub]} {
+ verbose -log "can't spawn for attach (target is stub)"
return 0
}
set test_spawn_id [spawn_wait_for_attach_1 $obj]
remote_file build delete $obj
+ # In case GDB is already running.
+ gdb_exit
+
gdb_start
set test_pid [spawn_id_get_pid $test_spawn_id]
return $res
}
-# Return true if we can spawn a program on the target and attach to
-# it. Calls gdb_exit for the first call in a test-case.
-
-proc can_spawn_for_attach { } {
- # We use exp_pid to get the inferior's pid, assuming that gives
- # back the pid of the program. On remote boards, that would give
- # us instead the PID of e.g., the ssh client, etc.
- if {[is_remote target]} {
- verbose -log "can't spawn for attach (target is remote)"
- return 0
- }
-
- # The "attach" command doesn't make sense when the target is
- # stub-like, where GDB finds the program already started on
- # initial connection.
- if {[target_info exists use_gdb_stub]} {
- verbose -log "can't spawn for attach (target is stub)"
- return 0
- }
-
- # The normal sequence to use for a runtime test like
- # can_spawn_for_attach_1 is:
- # - gdb_exit (don't use a running gdb, we don't know what state it is in),
- # - gdb_start (start a new gdb), and
- # - gdb_exit (cleanup).
- #
- # By making can_spawn_for_attach_1 a gdb_caching_proc, we make it
- # unpredictable which test-case will call it first, and consequently a
- # test-case may pass in say a full test run, but fail when run
- # individually, due to a can_spawn_for_attach call in a location where a
- # gdb_exit (as can_spawn_for_attach_1 does) breaks things.
- # To avoid this, we move the initial gdb_exit out of
- # can_spawn_for_attach_1, guaranteeing that we end up in the same state
- # regardless of whether can_spawn_for_attach_1 is called. However, that
- # is only necessary for the first call in a test-case, so cache the result
- # in a global (which should be reset after each test-case) to keep track
- # of that.
- #
- # In summary, we distinguish between three cases:
- # - first call in first test-case. Executes can_spawn_for_attach_1.
- # Calls gdb_exit, gdb_start, gdb_exit.
- # - first call in following test-cases. Uses cached result of
- # can_spawn_for_attach_1. Calls gdb_exit.
- # - rest. Use cached result in cache_can_spawn_for_attach_1. Calls no
- # gdb_start or gdb_exit.
- global cache_can_spawn_for_attach_1
- if { [info exists cache_can_spawn_for_attach_1] } {
- return $cache_can_spawn_for_attach_1
- }
- gdb_exit
-
- set cache_can_spawn_for_attach_1 [can_spawn_for_attach_1]
- return $cache_can_spawn_for_attach_1
-}
-
# Centralize the failure checking of "attach" command.
# Return 0 if attach failed, otherwise return 1.
projects / thirdparty / binutils-gdb.git / commitdiff
