}
}
+ drain_gdbserver_output
+
set code $early_processed_code
append code {
-re ".*A problem internal to GDB has been detected" {
}
\f
+# Match output of COMMAND using RE. Read output line-by-line.
+# Report pass/fail with MESSAGE.
+# For a command foo with output:
+# (gdb) foo^M
+# <line1>^M
+# <line2>^M
+# (gdb)
+# the portion matched using RE is:
+# '<line1>^M
+# <line2>^M
+# '
+
+proc gdb_test_lines { command message re } {
+ set found 0
+ set idx 0
+ if { $message == ""} {
+ set message $command
+ }
+ set lines ""
+ gdb_test_multiple $command $message {
+ -re "\r\n(\[^\r\n\]*)(?=\r\n)" {
+ set line $expect_out(1,string)
+ if { $lines eq "" } {
+ append lines "$line"
+ } else {
+ append lines "\r\n$line"
+ }
+ exp_continue
+ }
+ -re -wrap "" {
+ append lines "\r\n"
+ }
+ }
+
+ gdb_assert { [regexp $re $lines] } $message
+}
+
# Test that a command gives an error. For pass or fail, return
# a 1 to indicate that more tests can proceed. However a timeout
# is a serious error, generates a special fail message, and causes
remote_close host
}
unset gdb_spawn_id
+ unset ::gdb_tty_name
unset inferior_spawn_id
}
}
}
+# The expect "spawn" function puts the tty name into the spawn_out
+# array; but dejagnu doesn't export this globally. So, we have to
+# wrap spawn with our own function and poke in the built-in spawn
+# so that we can capture this value.
+#
+# If available, the TTY name is saved to the LAST_SPAWN_TTY_NAME global.
+# Otherwise, LAST_SPAWN_TTY_NAME is unset.
+
+proc spawn_capture_tty_name { args } {
+ set result [uplevel builtin_spawn $args]
+ upvar spawn_out spawn_out
+ if { [info exists spawn_out] } {
+ set ::last_spawn_tty_name $spawn_out(slave,name)
+ } else {
+ unset ::last_spawn_tty_name
+ }
+ return $result
+}
+
+rename spawn builtin_spawn
+rename spawn_capture_tty_name spawn
+
# Default gdb_spawn procedure.
proc default_gdb_spawn { } {
}
set gdb_spawn_id $res
+ set ::gdb_tty_name $::last_spawn_tty_name
return 0
}
# Examine the output of compilation to determine whether compilation
# failed or not. If it failed determine whether it is due to missing
# compiler or due to compiler error. Report pass, fail or unsupported
-# as appropriate
+# as appropriate.
proc gdb_compile_test {src output} {
+ set msg "compilation [file tail $src]"
+
if { $output == "" } {
- pass "compilation [file tail $src]"
- } elseif { [regexp {^[a-zA-Z_0-9]+: Can't find [^ ]+\.$} $output] } {
- unsupported "compilation [file tail $src]"
- } elseif { [regexp {.*: command not found[\r|\n]*$} $output] } {
- unsupported "compilation [file tail $src]"
- } elseif { [regexp {.*: [^\r\n]*compiler not installed[^\r\n]*[\r|\n]*$} $output] } {
- unsupported "compilation [file tail $src]"
- } else {
- verbose -log "compilation failed: $output" 2
- fail "compilation [file tail $src]"
+ pass $msg
+ return
+ }
+
+ if { [regexp {^[a-zA-Z_0-9]+: Can't find [^ ]+\.$} $output]
+ || [regexp {.*: command not found[\r|\n]*$} $output]
+ || [regexp {.*: [^\r\n]*compiler not installed[^\r\n]*[\r|\n]*$} $output] } {
+ unsupported "$msg (missing compiler)"
+ return
+ }
+
+ set gcc_re ".*: error: unrecognized command line option "
+ set clang_re ".*: error: unsupported option "
+ if { [regexp "(?:$gcc_re|$clang_re)(\[^ \t;\r\n\]*)" $output dummy option]
+ && $option != "" } {
+ unsupported "$msg (unsupported option $option)"
+ return
}
+
+ # Unclassified compilation failure, be more verbose.
+ verbose -log "compilation failed: $output" 2
+ fail "$msg"
}
# Return a 1 for configurations for which we don't even want to try to
}
}
+# Return 1 if memory tagging is supported at runtime, otherwise return 0.
+
+gdb_caching_proc supports_memtag {
+ global gdb_prompt
+
+ gdb_test_multiple "memory-tag check" "" {
+ -re "Memory tagging not supported or disabled by the current architecture\..*$gdb_prompt $" {
+ return 0
+ }
+ -re "Argument required \\(address or pointer\\).*$gdb_prompt $" {
+ return 1
+ }
+ }
+ return 0
+}
+
# Return 1 if the target supports hardware single stepping.
proc can_hardware_single_step {} {
return $skip_vmx_tests
}
+# Run a test on the power target to see if it supports ISA 3.1 instructions
+gdb_caching_proc skip_power_isa_3_1_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_power_isa_3_1_tests"
+
+ # Compile a test program containing ISA 3.1 instructions.
+ set src {
+ int main() {
+ asm volatile ("pnop"); // marker
+ asm volatile ("nop");
+ return 0;
+ }
+ }
+
+ if {![gdb_simple_compile $me $src executable ]} {
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$obj"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "\n$me Power ISA 3.1 hardware not detected"
+ set skip_power_isa_3_1_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "\n$me: Power ISA 3.1 hardware detected"
+ set skip_power_isa_3_1_tests 0
+ }
+ default {
+ warning "\n$me: default case taken"
+ set skip_power_isa_3_1_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_power_isa_3_1_tests" 2
+ return $skip_power_isa_3_1_tests
+}
+
# Run a test on the target to see if it supports vmx hardware. Return 0 if so,
# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
return [string match $compiler $compiler_info]
}
+# Return the gcc major version, or -1.
+# For gcc 4.8.5, the major version is 4.8.
+# For gcc 7.5.0, the major version 7.
+
+proc gcc_major_version { } {
+ global compiler_info
+ global decimal
+ if { ![test_compiler_info "gcc-*"] } {
+ return -1
+ }
+ set res [regexp gcc-($decimal)-($decimal)- $compiler_info \
+ dummy_var major minor]
+ if { $res != 1 } {
+ return -1
+ }
+ if { $major >= 5} {
+ return $major
+ }
+ return $major.$minor
+}
+
proc current_target_name { } {
global target_info
if [info exists target_info(target,name)] {
|| [lsearch -exact $options f90] != -1 } {
# Fortran compile.
set mod_path [standard_output_file ""]
- lappend new_options "additional_flags=-J${mod_path}"
+ if [test_compiler_info "gcc-*"] {
+ lappend new_options "additional_flags=-J${mod_path}"
+ }
}
set shlib_found 0
lappend options "$flag"
}
- # Replace the "nopie" option with the appropriate linker flag to disable
- # PIE executables. There are no compiler flags for this option.
+ # Replace the "nopie" option with the appropriate compiler and linker
+ # flags to disable PIE executables.
set nopie [lsearch -exact $options nopie]
if {$nopie != -1} {
if [target_info exists gdb,nopie_flag] {
- set flag "ldflags=[target_info gdb,nopie_flag]"
+ set flag "additional_flags=[target_info gdb,nopie_flag]"
} else {
- set flag "ldflags=-no-pie"
+ set flag "additional_flags=-fno-pie"
}
set options [lreplace $options $nopie $nopie $flag]
+
+ if [target_info exists gdb,nopie_ldflag] {
+ set flag "ldflags=[target_info gdb,nopie_ldflag]"
+ } else {
+ set flag "ldflags=-no-pie"
+ }
+ lappend options "$flag"
}
if { $type == "executable" } {
set why_msg "missing runtime threads library"
}
{^$} {
- pass "successfully compiled posix threads test case"
+ pass "successfully compiled posix threads shlib test case"
set built_binfile 1
break
}
# tests.
setenv TERM "dumb"
+ # If DEBUGINFOD_URLS is set, gdb will try to download sources and
+ # debug info for f.i. system libraries. Prevent this.
+ unset -nocomplain ::env(DEBUGINFOD_URLS)
+
# Ensure that GDBHISTFILE and GDBHISTSIZE are removed from the
# environment, we don't want these modifications to the history
# settings.
if { $res != 0 } {
return -1
}
- set res [regexp -line {^[ \t]*Type:[ \t]*DYN \(Shared object file\)$} \
+ set res [regexp -line {^[ \t]*Type:[ \t]*DYN \((Position-Independent Executable|Shared object) file\)$} \
$output]
if { $res == 1 } {
return 1
# being.
proc multi_line { args } {
+ if { [llength $args] == 1 } {
+ set hint "forgot {*} before list argument?"
+ error "multi_line called with one argument ($hint)"
+ }
return [join $args "\r\n"]
}
return 1
}
- return ![gdb_can_simple_compile ctfdebug {
+ set can_ctf [gdb_can_simple_compile ctfdebug {
int main () {
return 0;
}
} executable "additional_flags=-gt"]
+
+ return [expr {!$can_ctf}]
}
# Return 1 if compiler supports -gstatement-frontiers. Otherwise,
} else {
set re ""
}
+
+ set readnow_p 0
+ # Given the listing from the following command can be very verbose, match
+ # the patterns line-by-line. This prevents timeouts from waiting for
+ # too much data to come at once.
set cmd "maint print objfiles $re"
- gdb_test_multiple $cmd "" {
- -re -wrap "\r\n.gdb_index: faked for \"readnow\"\r\n.*" {
- return 1
+ gdb_test_multiple $cmd "" -lbl {
+ -re "\r\n.gdb_index: faked for \"readnow\"" {
+ # Record the we've seen the above pattern.
+ set readnow_p 1
+ exp_continue
}
-re -wrap "" {
- return 0
+ # We don't care about any other input.
}
}
- return 0
+ return $readnow_p
+}
+
+# Return index name if symbols were read in using an index.
+# Otherwise, return "".
+
+proc have_index { objfile } {
+
+ set res ""
+ set cmd "maint print objfiles $objfile"
+ gdb_test_multiple $cmd "" -lbl {
+ -re "\r\n.gdb_index: faked for \"readnow\"" {
+ set res ""
+ exp_continue
+ }
+ -re "\r\n.gdb_index:" {
+ set res "gdb_index"
+ exp_continue
+ }
+ -re "\r\n.debug_names:" {
+ set res "debug_names"
+ exp_continue
+ }
+ -re -wrap "" {
+ # We don't care about any other input.
+ }
+ }
+
+ return $res
}
# Return 1 if partial symbols are available. Otherwise, return 0.
# Add a .gdb_index section to PROGRAM.
# PROGRAM is assumed to be the output of standard_output_file.
# Returns the 0 if there is a failure, otherwise 1.
+#
+# STYLE controls which style of index to add, if needed. The empty
+# string (the default) means .gdb_index; "-dwarf-5" means .debug_names.
-proc add_gdb_index { program } {
+proc add_gdb_index { program {style ""} } {
global srcdir GDB env BUILD_DATA_DIRECTORY
set contrib_dir "$srcdir/../contrib"
set env(GDB) "$GDB --data-directory=$BUILD_DATA_DIRECTORY"
- set result [catch "exec $contrib_dir/gdb-add-index.sh $program" output]
+ set result [catch "exec $contrib_dir/gdb-add-index.sh $style $program" output]
if { $result != 0 } {
verbose -log "result is $result"
verbose -log "output is $output"
# (.gdb_index/.debug_names). Gdb doesn't support building an index from a
# program already using one. Return 1 if a .gdb_index was added, return 0
# if it already contained an index, and -1 if an error occurred.
+#
+# STYLE controls which style of index to add, if needed. The empty
+# string (the default) means .gdb_index; "-dwarf-5" means .debug_names.
-proc ensure_gdb_index { binfile } {
+proc ensure_gdb_index { binfile {style ""} } {
set testfile [file tail $binfile]
set test "check if index present"
gdb_test_multiple "mt print objfiles ${testfile}" $test {
return 0
}
-re -wrap "Psymtabs.*" {
- if { [add_gdb_index $binfile] != "1" } {
+ if { [add_gdb_index $binfile $style] != "1" } {
return -1
}
return 1
# finalization function.
proc tuiterm_env { } {
load_lib tuiterm.exp
-
- # Do initialization.
- tuiterm_env_init
-
- # Schedule finalization.
- global gdb_finish_hooks
- lappend gdb_finish_hooks tuiterm_env_finish
}
# Dejagnu has a version of note, but usage is not allowed outside of dejagnu.
return $status
}
+# Return 1 if target supports avx, otherwise return 0.
+gdb_caching_proc have_avx {
+ global srcdir
+
+ set me "have_avx"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support avx, returning 0" 2
+ return 0
+ }
+
+ # Compile a test program.
+ set src {
+ #include "nat/x86-cpuid.h"
+
+ int main() {
+ unsigned int eax, ebx, ecx, edx;
+
+ if (!x86_cpuid (1, &eax, &ebx, &ecx, &edx))
+ return 0;
+
+ if ((ecx & (bit_AVX | bit_OSXSAVE)) == (bit_AVX | bit_OSXSAVE))
+ return 1;
+ else
+ return 0;
+ }
+ }
+ set compile_flags "incdir=${srcdir}/.."
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
+ return 0
+ }
+
+ set result [remote_exec target $obj]
+ set status [lindex $result 0]
+ set output [lindex $result 1]
+ if { $output != "" } {
+ set status 0
+ }
+
+ remote_file build delete $obj
+
+ verbose "$me: returning $status" 2
+ return $status
+}
+
# Always load compatibility stuff.
load_lib future.exp
+
+proc drain_gdbserver_output { } {
+ if { [info exists ::server_spawn_id] } {
+ #puts "gonna expect"
+ gdb_expect {
+ -i "$::server_spawn_id"
+ -timeout 0
+
+ -re ".+" {
+ exp_continue
+ #puts "consumed: $expect_out(buffer)"
+ }
+
+
+ }
+ #puts "expected"
+ }
+}
projects / deliverable / binutils-gdb.git / blobdiff