#
# gdb_test_multiple "print foo" "test foo" {
# -re "expected output 1" {
-# pass "print foo"
+# pass "test foo"
# }
# -re "expected output 2" {
-# fail "print foo"
+# fail "test foo"
+# }
+# }
+#
+# Within action elements you can also make use of the variable
+# gdb_test_name. This variable is setup automatically by
+# gdb_test_multiple, and contains the value of MESSAGE. You can then
+# write this, which is equivalent to the above:
+#
+# gdb_test_multiple "print foo" "test foo" {
+# -re "expected output 1" {
+# pass $gdb_test_name
+# }
+# -re "expected output 2" {
+# fail $gdb_test_name
# }
# }
#
}
}
+ # Create gdb_test_name in the parent scope. If this variable
+ # already exists, which it might if we have nested calls to
+ # gdb_test_multiple, then preserve the old value, otherwise,
+ # create a new variable in the parent scope.
+ upvar gdb_test_name gdb_test_name
+ if { [info exists gdb_test_name] } {
+ set gdb_test_name_old "$gdb_test_name"
+ }
+ set gdb_test_name "$message"
+
set result 0
set code [catch {gdb_expect $code} string]
+
+ # Clean up the gdb_test_name variable. If we had a
+ # previous value then restore it, otherwise, delete the variable
+ # from the parent scope.
+ if { [info exists gdb_test_name_old] } {
+ set gdb_test_name "$gdb_test_name_old"
+ } else {
+ unset gdb_test_name
+ }
+
if {$code == 1} {
global errorInfo errorCode
return -code error -errorinfo $errorInfo -errorcode $errorCode $string
set command [lindex $args 0]
set pattern [lindex $args 1]
- if [llength $args]==5 {
- set question_string [lindex $args 3]
- set response_string [lindex $args 4]
- } else {
- set question_string "^FOOBAR$"
- }
-
- return [gdb_test_multiple $command $message {
+ set user_code {}
+ lappend user_code {
-re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
if ![string match "" $message] then {
pass "$message"
}
}
- -re "(${question_string})$" {
- send_gdb "$response_string\n"
- exp_continue
+ }
+
+ if { [llength $args] == 5 } {
+ set question_string [lindex $args 3]
+ set response_string [lindex $args 4]
+ lappend user_code {
+ -re "(${question_string})$" {
+ send_gdb "$response_string\n"
+ exp_continue
+ }
}
- }]
+ }
+
+ set user_code [join $user_code]
+ return [gdb_test_multiple $command $message $user_code]
}
-# Return 1 if tcl version used is at least MAJOR.MINOR
-proc tcl_version_at_least { major minor } {
- global tcl_version
- regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
- dummy tcl_version_major tcl_version_minor
- if { $tcl_version_major > $major } {
+# Return 1 if version MAJOR.MINOR is at least AT_LEAST_MAJOR.AT_LEAST_MINOR.
+proc version_at_least { major minor at_least_major at_least_minor} {
+ if { $major > $at_least_major } {
return 1
- } elseif { $tcl_version_major == $major \
- && $tcl_version_major >= $minor } {
+ } elseif { $major == $at_least_major \
+ && $minor >= $at_least_minor } {
return 1
} else {
return 0
}
}
+# Return 1 if tcl version used is at least MAJOR.MINOR
+proc tcl_version_at_least { major minor } {
+ global tcl_version
+ regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
+ dummy tcl_version_major tcl_version_minor
+ return [version_at_least $tcl_version_major $tcl_version_minor \
+ $major $minor]
+}
+
if { [tcl_version_at_least 8 5] == 0 } {
# lrepeat was added in tcl 8.5. Only add if missing.
proc lrepeat { n element } {
}
}
+# Run BODY with timeout factor FACTOR if check-read1 is used.
+
+proc with_read1_timeout_factor { factor body } {
+ if { [info exists ::env(READ1)] == 1 && $::env(READ1) == 1 } {
+ # Use timeout factor
+ } else {
+ # Reset timeout factor
+ set factor 1
+ }
+ return [uplevel [list with_timeout_factor $factor $body]]
+}
+
# Return 1 if _Complex types are supported, otherwise, return 0.
gdb_caching_proc support_complex_tests {
return $ok
}
-# Return 0 if we should skip tests that require the libstdc++ stap
+# Return 1 if we should skip tests that require the libstdc++ stap
# probes. This must be invoked while gdb is running, after shared
# libraries have been loaded. PROMPT_REGEXP is the expected prompt.
proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } {
- set ok 0
+ set supported 0
gdb_test_multiple "info probe" "check for stap probe in libstdc++" {
-re ".*libstdcxx.*catch.*\r\n$prompt_regexp" {
- set ok 1
+ set supported 1
}
-re "\r\n$prompt_regexp" {
}
} "$prompt_regexp"
- return $ok
+ set skip [expr !$supported]
+ return $skip
}
# As skip_libstdcxx_probe_tests_prompt, with gdb_prompt.
regsub "\[\r\n\]*$" "$result" "" result
regsub "^\[\r\n\]*" "$result" "" result
- if { $type == "executable" && $result == "" && $nopie != -1 } {
- if { [exec_is_pie "$dest"] } {
+ if { $type == "executable" && $result == "" \
+ && ($nopie != -1 || $pie != -1) } {
+ set is_pie [exec_is_pie "$dest"]
+ if { $nopie != -1 && $is_pie == 1 } {
set result "nopie failed to prevent PIE executable"
+ } elseif { $pie != -1 && $is_pie == 0 } {
+ set result "pie failed to generate PIE executable"
}
}
set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name]
file mkdir $dir
+ # If running on MinGW, replace /c/foo with c:/foo
+ if { [ishost *-*-mingw*] } {
+ set dir [regsub {^/([a-z])/} $dir {\1:/}]
+ }
return [file join $dir $basename]
}
return 0
}
-# Return true if EXECUTABLE is a Position Independent Executable.
+# Return list with major and minor version of readelf, or an empty list.
+gdb_caching_proc readelf_version {
+ set readelf_program [gdb_find_readelf]
+ set res [catch {exec $readelf_program --version} output]
+ if { $res != 0 } {
+ return [list]
+ }
+ set lines [split $output \n]
+ set line [lindex $lines 0]
+ set res [regexp {[ \t]+([0-9]+)[.]([0-9]+)[^ \t]*$} \
+ $line dummy major minor]
+ if { $res != 1 } {
+ return [list]
+ }
+ return [list $major $minor]
+}
+
+# Return 1 if readelf prints the PIE flag, 0 if is doesn't, and -1 if unknown.
+proc readelf_prints_pie { } {
+ set version [readelf_version]
+ if { [llength $version] == 0 } {
+ return -1
+ }
+ set major [lindex $version 0]
+ set minor [lindex $version 1]
+ # It would be better to construct a PIE executable and test if the PIE
+ # flag is printed by readelf, but we cannot reliably construct a PIE
+ # executable if the multilib_flags dictate otherwise
+ # (--target_board=unix/-no-pie/-fno-PIE).
+ return [version_at_least $major $minor 2 26]
+}
+
+# Return 1 if EXECUTABLE is a Position Independent Executable, 0 if it is not,
+# and -1 if unknown.
proc exec_is_pie { executable } {
+ set res [readelf_prints_pie]
+ if { $res != 1 } {
+ return -1
+ }
set readelf_program [gdb_find_readelf]
- set res [catch {exec $readelf_program -d $executable \
- | grep -E "(FLAGS_1).*Flags:.* PIE($| )" }]
- if { $res == 0 } {
+ set res [catch {exec $readelf_program -d $executable} output]
+ if { $res != 0 } {
+ return -1
+ }
+ set res [regexp -line {\(FLAGS_1\).*Flags:.* PIE($| )} $output]
+ if { $res == 1 } {
return 1
}
return 0
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"
+ }
+}
+
# Always load compatibility stuff.
load_lib future.exp
projects / deliverable / binutils-gdb.git / blobdiff