+# Test files shall make sure all the test result lines in gdb.sum are
+# unique in a test run, so that comparing the gdb.sum files of two
+# test runs gives correct results. Test files that exercise
+# variations of the same tests more than once, shall prefix the
+# different test invocations with different identifying strings in
+# order to make them unique.
+#
+# About test prefixes:
+#
+# $pf_prefix is the string that dejagnu prints after the result (FAIL,
+# PASS, etc.), and before the test message/name in gdb.sum. E.g., the
+# underlined substring in
+#
+# PASS: gdb.base/mytest.exp: some test
+# ^^^^^^^^^^^^^^^^^^^^
+#
+# is $pf_prefix.
+#
+# The easiest way to adjust the test prefix is to append a test
+# variation prefix to the $pf_prefix, using the with_test_prefix
+# procedure. E.g.,
+#
+# proc do_tests {} {
+# gdb_test ... ... "test foo"
+# gdb_test ... ... "test bar"
+#
+# with_test_prefix "subvariation a" {
+# gdb_test ... ... "test x"
+# }
+#
+# with_test_prefix "subvariation b" {
+# gdb_test ... ... "test x"
+# }
+# }
+#
+# with_test_prefix "variation1" {
+# ...do setup for variation 1...
+# do_tests
+# }
+#
+# with_test_prefix "variation2" {
+# ...do setup for variation 2...
+# do_tests
+# }
+#
+# Results in:
+#
+# PASS: gdb.base/mytest.exp: variation1: test foo
+# PASS: gdb.base/mytest.exp: variation1: test bar
+# PASS: gdb.base/mytest.exp: variation1: subvariation a: test x
+# PASS: gdb.base/mytest.exp: variation1: subvariation b: test x
+# PASS: gdb.base/mytest.exp: variation2: test foo
+# PASS: gdb.base/mytest.exp: variation2: test bar
+# PASS: gdb.base/mytest.exp: variation2: subvariation a: test x
+# PASS: gdb.base/mytest.exp: variation2: subvariation b: test x
+#
+# If for some reason more flexibility is necessary, one can also
+# manipulate the pf_prefix global directly, treating it as a string.
+# E.g.,
+#
+# global pf_prefix
+# set saved_pf_prefix
+# append pf_prefix "${foo}: bar"
+# ... actual tests ...
+# set pf_prefix $saved_pf_prefix
+#
+
+# Run BODY in the context of the caller, with the current test prefix
+# (pf_prefix) appended with one space, then PREFIX, and then a colon.
+# Returns the result of BODY.
+#
+proc with_test_prefix { prefix body } {
+ global pf_prefix
+
+ set saved $pf_prefix
+ append pf_prefix " " $prefix ":"
+ set code [catch {uplevel 1 $body} result]
+ set pf_prefix $saved
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
+# Return 1 if _Complex types are supported, otherwise, return 0.
+
+proc support_complex_tests {} {
+ global support_complex_tests_saved
+
+ # Use the cached value, if it exists.
+ if [info exists support_complex_tests_saved] {
+ verbose "returning saved $support_complex_tests_saved" 2
+ return $support_complex_tests_saved
+ }
+
+ # Set up, compile, and execute a test program containing _Complex types.
+ # Include the current process ID in the file names to prevent conflicts
+ # with invocations for multiple testsuites.
+ set src complex[pid].c
+ set exe complex[pid].x
+
+ set f [open $src "w"]
+ puts $f "int main() {"
+ puts $f "_Complex float cf;"
+ puts $f "_Complex double cd;"
+ puts $f "_Complex long double cld;"
+ puts $f " return 0; }"
+ close $f
+
+ verbose "compiling testfile $src" 2
+ set compile_flags {debug nowarnings quiet}
+ set lines [gdb_compile $src $exe executable $compile_flags]
+ file delete $src
+ file delete $exe
+
+ if ![string match "" $lines] then {
+ verbose "testfile compilation failed, returning 0" 2
+ set support_complex_tests_saved 0
+ } else {
+ set support_complex_tests_saved 1
+ }
+
+ return $support_complex_tests_saved
+}
+
+# Return 1 if target hardware or OS supports single stepping to signal
+# handler, otherwise, return 0.
+
+proc can_single_step_to_signal_handler {} {
+
+ # Targets don't have hardware single step. On these targets, when
+ # a signal is delivered during software single step, gdb is unable
+ # to determine the next instruction addresses, because start of signal
+ # handler is one of them.
+ if { [istarget "arm*-*-*"] || [istarget "mips*-*-*"]
+ || [istarget "tic6x-*-*"] || [istarget "sparc*-*-linux*"] } {
+ return 0
+ }
+
+ return 1
+}
+
+# Return 1 if target supports process record, otherwise return 0.
+
+proc supports_process_record {} {
+
+ if [target_info exists gdb,use_precord] {
+ return [target_info gdb,use_precord]
+ }
+
+ if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+ return 1
+ }
+
+ return 0
+}
+
+# Return 1 if target supports reverse debugging, otherwise return 0.
+
+proc supports_reverse {} {
+
+ if [target_info exists gdb,can_reverse] {
+ return [target_info gdb,can_reverse]
+ }
+
+ if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+ return 1
+ }
+
+ return 0
+}
+
+# Return 1 if target is ILP32.
+# This cannot be decided simply from looking at the target string,
+# as it might depend on externally passed compiler options like -m64.
+proc is_ilp32_target {} {
+ global is_ilp32_target_saved
+
+ # Use the cached value, if it exists. Cache value per "board" to handle
+ # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
+ set me "is_ilp32_target"
+ set board [target_info name]
+ if [info exists is_ilp32_target_saved($board)] {
+ verbose "$me: returning saved $is_ilp32_target_saved($board)" 2
+ return $is_ilp32_target_saved($board)
+ }
+
+
+ set src ilp32[pid].c
+ set obj ilp32[pid].o
+
+ set f [open $src "w"]
+ puts $f "int dummy\[sizeof (int) == 4"
+ puts $f " && sizeof (void *) == 4"
+ puts $f " && sizeof (long) == 4 ? 1 : -1\];"
+ close $f
+
+ verbose "$me: compiling testfile $src" 2
+ set lines [gdb_compile $src $obj object {quiet}]
+ file delete $src
+ file delete $obj
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed, returning 0" 2
+ return [set is_ilp32_target_saved($board) 0]
+ }
+
+ verbose "$me: returning 1" 2
+ return [set is_ilp32_target_saved($board) 1]
+}
+
+# Return 1 if target is LP64.
+# This cannot be decided simply from looking at the target string,
+# as it might depend on externally passed compiler options like -m64.
+proc is_lp64_target {} {
+ global is_lp64_target_saved
+
+ # Use the cached value, if it exists. Cache value per "board" to handle
+ # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
+ set me "is_lp64_target"
+ set board [target_info name]
+ if [info exists is_lp64_target_saved($board)] {
+ verbose "$me: returning saved $is_lp64_target_saved($board)" 2
+ return $is_lp64_target_saved($board)
+ }
+
+ set src lp64[pid].c
+ set obj lp64[pid].o
+
+ set f [open $src "w"]
+ puts $f "int dummy\[sizeof (int) == 4"
+ puts $f " && sizeof (void *) == 8"
+ puts $f " && sizeof (long) == 8 ? 1 : -1\];"
+ close $f
+
+ verbose "$me: compiling testfile $src" 2
+ set lines [gdb_compile $src $obj object {quiet}]
+ file delete $src
+ file delete $obj
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed, returning 0" 2
+ return [set is_lp64_target_saved($board) 0]
+ }
+
+ verbose "$me: returning 1" 2
+ return [set is_lp64_target_saved($board) 1]
+}
+
+# Return 1 if target has x86_64 registers - either amd64 or x32.
+# x32 target identifies as x86_64-*-linux*, therefore it cannot be determined
+# just from the target string.
+proc is_amd64_regs_target {} {
+ global is_amd64_regs_target_saved
+
+ if {![istarget "x86_64-*-*"] && ![istarget "i?86-*"]} {
+ return 0
+ }
+
+ # Use the cached value, if it exists. Cache value per "board" to handle
+ # runs with multiple options (e.g. unix/{-m32,-64}) correctly.
+ set me "is_amd64_regs_target"
+ set board [target_info name]
+ if [info exists is_amd64_regs_target_saved($board)] {
+ verbose "$me: returning saved $is_amd64_regs_target_saved($board)" 2
+ return $is_amd64_regs_target_saved($board)
+ }
+
+ set src reg64[pid].s
+ set obj reg64[pid].o
+
+ set f [open $src "w"]
+ foreach reg \
+ {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
+ puts $f "\tincq %$reg"
+ }
+ close $f
+
+ verbose "$me: compiling testfile $src" 2
+ set lines [gdb_compile $src $obj object {quiet}]
+ file delete $src
+ file delete $obj
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed, returning 0" 2
+ return [set is_amd64_regs_target_saved($board) 0]
+ }
+
+ verbose "$me: returning 1" 2
+ return [set is_amd64_regs_target_saved($board) 1]
+}
+
+# Return 1 if this target is an x86 or x86-64 with -m32.
+proc is_x86_like_target {} {
+ if {![istarget "x86_64-*-*"] && ![istarget i?86-*]} {
+ return 0
+ }
+ return [expr [is_ilp32_target] && ![is_amd64_regs_target]]
+}
+
+# Return 1 if displaced stepping is supported on target, otherwise, return 0.
+proc support_displaced_stepping {} {
+
+ if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"]
+ || [istarget "arm*-*-linux*"] || [istarget "powerpc-*-linux*"]
+ || [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"] } {
+ return 1
+ }
+
+ return 0
+}
+