gdb: Restore selected frame in print_frame_local_vars
[external/binutils.git] / gdb / testsuite / lib / gdb.exp
index 48fec2f..ee66a38 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright 1992-2017 Free Software Foundation, Inc.
+# Copyright 1992-2018 Free Software Foundation, Inc.
 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -226,6 +226,19 @@ proc delete_breakpoints {} {
     }
 }
 
+# Returns true iff the target supports using the "run" command.
+
+proc target_can_use_run_cmd {} {
+    if [target_info exists use_gdb_stub] {
+       # In this case, when we connect, the inferior is already
+       # running.
+       return 0
+    }
+
+    # Assume yes.
+    return 1
+}
+
 # Generic run command.
 #
 # The second pattern below matches up to the first newline *only*.
@@ -409,7 +422,7 @@ proc gdb_starti_cmd {args} {
 
 # Set a breakpoint at FUNCTION.  If there is an additional argument it is
 # a list of options; the supported options are allow-pending, temporary,
-# message, no-message, and passfail.
+# message, no-message, passfail and qualified.
 # The result is 1 for success, 0 for failure.
 #
 # Note: The handling of message vs no-message is messed up, but it's based
@@ -434,6 +447,10 @@ proc gdb_breakpoint { function args } {
        set break_message "Temporary breakpoint"
     }
 
+    if {[lsearch -exact $args qualified] != -1} {
+       append break_command " -qualified"
+    }
+
     set print_pass 0
     set print_fail 1
     set no_message_loc [lsearch -exact $args no-message]
@@ -1080,7 +1097,8 @@ proc gdb_test_no_output { args } {
 # This is useful when the sequence is long and contains ".*", a single
 # regexp to match the entire output can get a timeout much easier.
 #
-# COMMAND is the command to send.
+# COMMAND is the command to execute, send to GDB with send_gdb.  If
+#   this is the null string no command is sent.
 # TEST_NAME is passed to pass/fail.  COMMAND is used if TEST_NAME is "".
 # EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are
 # processed in order, and all must be present in the output.
@@ -1103,7 +1121,9 @@ proc gdb_test_sequence { command test_name expected_output_list } {
        set test_name $command
     }
     lappend expected_output_list ""; # implicit ".*" before gdb prompt
-    send_gdb "$command\n"
+    if { $command != "" } {
+       send_gdb "$command\n"
+    }
     return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list]
 }
 
@@ -2034,6 +2054,30 @@ proc save_vars { vars body } {
     }
 }
 
+# Run tests in BODY with the current working directory (CWD) set to
+# DIR.  When BODY is finished, restore the original CWD.  Return the
+# result of BODY.
+#
+# This procedure doesn't check if DIR is a valid directory, so you
+# have to make sure of that.
+
+proc with_cwd { dir body } {
+    set saved_dir [pwd]
+    verbose -log "Switching to directory $dir (saved CWD: $saved_dir)."
+    cd $dir
+
+    set code [catch {uplevel 1 $body} result]
+
+    verbose -log "Switching back to $saved_dir."
+    cd $saved_dir
+
+    if {$code == 1} {
+       global errorInfo errorCode
+       return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+    } else {
+       return -code $code $result
+    }
+}
 
 # Run tests in BODY with GDB prompt and variable $gdb_prompt set to
 # PROMPT.  When BODY is finished, restore GDB prompt and variable
@@ -2935,7 +2979,7 @@ gdb_caching_proc skip_btrace_pt_tests {
     file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
     set skip_btrace_tests 2
-    gdb_test_multiple "record btrace pt" "check btrace support" {
+    gdb_test_multiple "record btrace pt" "check btrace pt support" {
         -re "You can't do that when your target is.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
@@ -2945,7 +2989,7 @@ gdb_caching_proc skip_btrace_pt_tests {
         -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
-        -re "GDB does not support.*\r\n$gdb_prompt $" {
+        -re "support was disabled at compile time.*\r\n$gdb_prompt $" {
             set skip_btrace_tests 1
         }
         -re "^record btrace pt\r\n$gdb_prompt $" {
@@ -2959,6 +3003,36 @@ gdb_caching_proc skip_btrace_pt_tests {
     return $skip_btrace_tests
 }
 
+# A helper that compiles a test case to see if __int128 is supported.
+proc gdb_int128_helper {lang} {
+    set src [standard_temp_file i128[pid].c]
+    set obj [standard_temp_file i128[pid].o]
+
+    verbose -log "checking $lang for __int128"
+    gdb_produce_source $src {
+       __int128 x;
+       int main() { return 0; }
+    }
+
+    set lines [gdb_compile $src $obj object [list nowarnings quiet $lang]]
+    file delete $src
+    file delete $obj
+
+    set result [expr {!![string match "" $lines]}]
+    verbose -log "__int128 for $lang result = $result"
+    return $result
+}
+
+# Return true if the C compiler understands the __int128 type.
+gdb_caching_proc has_int128_c {
+    return [gdb_int128_helper c]
+}
+
+# Return true if the C++ compiler understands the __int128 type.
+gdb_caching_proc has_int128_cxx {
+    return [gdb_int128_helper c++]
+}
+
 # Return whether we should skip tests for showing inlined functions in
 # backtraces.  Requires get_compiler_info and get_debug_format.
 
@@ -3134,14 +3208,16 @@ proc skip_compile_feature_tests {} {
     return $result
 }
 
-# Helper for gdb_is_target_remote.  PROMPT_REGEXP is the expected
-# prompt.
-
-proc gdb_is_target_remote_prompt { prompt_regexp } {
+# Helper for gdb_is_target_* procs.  TARGET_NAME is the name of the target
+# we're looking for (used to build the test name).  TARGET_STACK_REGEXP
+# is a regexp that will match the output of "maint print target-stack" if
+# the target in question is currently pushed.  PROMPT_REGEXP is a regexp
+# matching the expected prompt after the command output.
 
-    set test "probe for target remote"
+proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } {
+    set test "probe for target ${target_name}"
     gdb_test_multiple "maint print target-stack" $test {
-       -re ".*emote serial target in gdb-specific protocol.*$prompt_regexp" {
+       -re "${target_stack_regexp}${prompt_regexp}" {
            pass $test
            return 1
        }
@@ -3152,15 +3228,29 @@ proc gdb_is_target_remote_prompt { prompt_regexp } {
     return 0
 }
 
+# Helper for gdb_is_target_remote where the expected prompt is variable.
+
+proc gdb_is_target_remote_prompt { prompt_regexp } {
+    return [gdb_is_target_1 "remote" ".*emote serial target in gdb-specific protocol.*" $prompt_regexp]
+}
+
 # Check whether we're testing with the remote or extended-remote
 # targets.
 
-proc gdb_is_target_remote {} {
+proc gdb_is_target_remote { } {
     global gdb_prompt
 
     return [gdb_is_target_remote_prompt "$gdb_prompt $"]
 }
 
+# Check whether we're testing with the native target.
+
+proc gdb_is_target_native { } {
+    global gdb_prompt
+
+    return [gdb_is_target_1 "native" ".*native \\(Native process\\).*" "$gdb_prompt $"]
+}
+
 # Return the effective value of use_gdb_stub.
 #
 # If the use_gdb_stub global has been set (it is set when the gdb process is
@@ -3484,16 +3574,17 @@ proc gdb_compile {source dest type options} {
 
     # Add platform-specific options if a shared library was specified using
     # "shlib=librarypath" in OPTIONS.
+    set new_options {}
     if {[lsearch -exact $options rust] != -1} {
        # -fdiagnostics-color is not a rustcc option.
     } else {
        set new_options [universal_compile_options]
     }
-    set new_options {}
     set shlib_found 0
     set shlib_load 0
     foreach opt $options {
-        if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
+        if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
+           && $type == "executable"} {
             if [test_compiler_info "xlc-*"] {
                # IBM xlc compiler doesn't accept shared library named other
                # than .so: use "-Wl," to bypass this
@@ -3519,7 +3610,7 @@ proc gdb_compile {source dest type options} {
                    lappend new_options "early_flags=-Wl,--no-as-needed"
                }
             }
-       } elseif { $opt == "shlib_load" } {
+       } elseif { $opt == "shlib_load" && $type == "executable" } {
            set shlib_load 1
         } else {
             lappend new_options $opt
@@ -5634,7 +5725,7 @@ proc get_integer_valueof { exp default {test ""} } {
     gdb_test_multiple "print /d ${exp}" "$test" {
        -re "\\$\[0-9\]* = (\[-\]*\[0-9\]*).*$gdb_prompt $" {
            set val $expect_out(1,string)
-           pass "$test ($val)"
+           pass "$test"
        }
        timeout {
            fail "$test (timeout)"
@@ -5714,6 +5805,22 @@ proc get_var_address { var } {
     return ""
 }
 
+# Return the frame number for the currently selected frame
+proc get_current_frame_number {{test_name ""}} {
+    global gdb_prompt
+
+    if { $test_name == "" } {
+       set test_name "get current frame number"
+    }
+    set frame_num -1
+    gdb_test_multiple "frame" $test_name {
+       -re "#(\[0-9\]+) .*$gdb_prompt $" {
+           set frame_num $expect_out(1,string)
+       }
+    }
+    return $frame_num
+}
+
 # Get the current value for remotetimeout and return it.
 proc get_remotetimeout { } {
     global gdb_prompt