+# Return the version of the DejaGnu framework.
+#
+# The return value is a list containing the major, minor and patch version
+# numbers. If the version does not contain a minor or patch number, they will
+# be set to 0. For example:
+#
+# 1.6 -> {1 6 0}
+# 1.6.1 -> {1 6 1}
+# 2 -> {2 0 0}
+
+proc dejagnu_version { } {
+ # The frame_version variable is defined by DejaGnu, in runtest.exp.
+ global frame_version
+
+ verbose -log "DejaGnu version: $frame_version"
+ verbose -log "Expect version: [exp_version]"
+ verbose -log "Tcl version: [info tclversion]"
+
+ set dg_ver [split $frame_version .]
+
+ while { [llength $dg_ver] < 3 } {
+ lappend dg_ver 0
+ }
+
+ return $dg_ver
+}
+
+# Define user-defined command COMMAND using the COMMAND_LIST as the
+# command's definition. The terminating "end" is added automatically.
+
+proc gdb_define_cmd {command command_list} {
+ global gdb_prompt
+
+ set input [multi_line_input {*}$command_list "end"]
+ set test "define $command"
+
+ gdb_test_multiple "define $command" $test {
+ -re "End with" {
+ gdb_test_multiple $input $test {
+ -re "\r\n$gdb_prompt " {
+ }
+ }
+ }
+ }
+}
+
+# Override the 'cd' builtin with a version that ensures that the
+# log file keeps pointing at the same file. We need this because
+# unfortunately the path to the log file is recorded using an
+# relative path name, and, we sometimes need to close/reopen the log
+# after changing the current directory. See get_compiler_info.
+
+rename cd builtin_cd
+
+proc cd { dir } {
+
+ # Get the existing log file flags.
+ set log_file_info [log_file -info]
+
+ # Split the flags into args and file name.
+ set log_file_flags ""
+ set log_file_file ""
+ foreach arg [ split "$log_file_info" " "] {
+ if [string match "-*" $arg] {
+ lappend log_file_flags $arg
+ } else {
+ lappend log_file_file $arg
+ }
+ }
+
+ # If there was an existing file, ensure it is an absolute path, and then
+ # reset logging.
+ if { $log_file_file != "" } {
+ set log_file_file [file normalize $log_file_file]
+ log_file
+ log_file $log_file_flags "$log_file_file"
+ }
+
+ # Call the builtin version of cd.
+ builtin_cd $dir
+}
+
+# Return a list of all languages supported by GDB, suitable for use in
+# 'set language NAME'. This doesn't include either the 'local' or
+# 'auto' keywords.
+proc gdb_supported_languages {} {
+ return [list c objective-c c++ d go fortran modula-2 asm pascal \
+ opencl rust minimal ada]
+}
+
+# Check if debugging is enabled for gdb.
+
+proc gdb_debug_enabled { } {
+ global gdbdebug
+
+ # If not already read, get the debug setting from environment or board setting.
+ if {![info exists gdbdebug]} {
+ global env
+ if [info exists env(GDB_DEBUG)] {
+ set gdbdebug $env(GDB_DEBUG)
+ } elseif [target_info exists gdb,debug] {
+ set gdbdebug [target_info gdb,debug]
+ } else {
+ return 0
+ }
+ }
+
+ # Ensure it not empty.
+ return [expr { $gdbdebug != "" }]
+}
+
+# Turn on debugging if enabled, or reset if already on.
+
+proc gdb_debug_init { } {
+
+ global gdb_prompt
+
+ if ![gdb_debug_enabled] {
+ return;
+ }
+
+ # First ensure logging is off.
+ send_gdb "set logging off\n"
+
+ set debugfile [standard_output_file gdb.debug]
+ send_gdb "set logging file $debugfile\n"
+
+ send_gdb "set logging debugredirect\n"
+
+ global gdbdebug
+ foreach entry [split $gdbdebug ,] {
+ send_gdb "set debug $entry 1\n"
+ }
+
+ # Now that everything is set, enable logging.
+ send_gdb "set logging on\n"
+ gdb_expect 10 {
+ -re "Copying output to $debugfile.*Redirecting debug output to $debugfile.*$gdb_prompt $" {}
+ timeout { warning "Couldn't set logging file" }
+ }
+}
+
+# Check if debugging is enabled for gdbserver.
+
+proc gdbserver_debug_enabled { } {
+ # Always disabled for GDB only setups.
+ return 0
+}
+
+# Open the file for logging gdb input
+
+proc gdb_stdin_log_init { } {
+ global in_file
+
+ if {[info exists in_file]} {
+ # Close existing file.
+ catch "close $in_file"
+ }
+
+ set logfile [standard_output_file_with_gdb_instance gdb.in]
+ set in_file [open $logfile w]
+}
+
+# Write to the file for logging gdb input.
+# TYPE can be one of the following:
+# "standard" : Default. Standard message written to the log
+# "answer" : Answer to a question (eg "Y"). Not written the log.
+# "optional" : Optional message. Not written to the log.
+
+proc gdb_stdin_log_write { message {type standard} } {
+
+ global in_file
+ if {![info exists in_file]} {
+ return
+ }
+
+ # Check message types.
+ switch -regexp -- $type {
+ "answer" {
+ return
+ }
+ "optional" {
+ return
+ }
+ }
+
+ #Write to the log
+ puts -nonewline $in_file "$message"
+}
+
+# Write the command line used to invocate gdb to the cmd file.
+
+proc gdb_write_cmd_file { cmdline } {
+ set logfile [standard_output_file_with_gdb_instance gdb.cmd]
+ set cmd_file [open $logfile w]
+ puts $cmd_file $cmdline
+ catch "close $cmd_file"
+}
+
+# Compare contents of FILE to string STR. Pass with MSG if equal, otherwise
+# fail with MSG.
+
+proc cmp_file_string { file str msg } {
+ if { ![file exists $file]} {
+ fail "$msg"
+ return
+ }
+
+ set caught_error [catch {
+ set fp [open "$file" r]
+ set file_contents [read $fp]
+ close $fp
+ } error_message]
+ if { $caught_error } then {
+ error "$error_message"
+ fail "$msg"
+ return
+ }
+
+ if { $file_contents == $str } {
+ pass "$msg"
+ } else {
+ fail "$msg"
+ }
+}