gdb_compile_shlib: Only consider shlib= options when building executables

[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3d3eaab2583d7bebe0b1d4ed9b790991d3e270a5..a4bde724bec0c519d56b5d9931f145a0fc1e9807 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -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*.
@@ -370,9 +383,46 @@ proc gdb_start_cmd {args} {
     return -1
 }
 
+# Generic starti command.  Return 0 if we could start the program, -1
+# if we could not.
+#
+# N.B. This function does not wait for gdb to return to the prompt,
+# that is the caller's responsibility.
+
+proc gdb_starti_cmd {args} {
+    global gdb_prompt use_gdb_stub
+
+    foreach command [gdb_init_commands] {
+       send_gdb "$command\n"
+       gdb_expect 30 {
+           -re "$gdb_prompt $" { }
+           default {
+               perror "gdb_init_command for target failed"
+               return -1
+           }
+       }
+    }
+
+    if $use_gdb_stub {
+       return -1
+    }
+
+    send_gdb "starti $args\n"
+    gdb_expect 60 {
+       -re "The program .* has been started already.*y or n. $" {
+           send_gdb "y\n"
+           exp_continue
+       }
+       -re "Starting program: \[^\r\n\]*" {
+           return 0
+       }
+    }
+    return -1
+}
+
 # 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
@@ -397,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]
@@ -1043,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.
@@ -1066,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]
 }
 
@@ -3368,6 +3425,34 @@ proc gdb_wrapper_init { args } {
     set gdb_wrapper_target [current_target_name]
 }
 
+# Determine options that we always want to pass to the compiler.
+gdb_caching_proc universal_compile_options {
+    set me "universal_compile_options"
+    set options {}
+
+    set src [standard_temp_file ccopts[pid].c]
+    set obj [standard_temp_file ccopts[pid].o]
+
+    gdb_produce_source $src {
+       int foo(void) { return 0; }
+    }
+
+    # Try an option for disabling colored diagnostics.  Some compilers
+    # yield colored diagnostics by default (when run from a tty) unless
+    # such an option is specified.
+    set opt "additional_flags=-fdiagnostics-color=never"
+    set lines [target_compile $src $obj object [list "quiet" $opt]]
+    if [string match "" $lines] then {
+       # Seems to have worked; use the option.
+       lappend options $opt
+    }
+    file delete $src
+    file delete $obj
+
+    verbose "$me:  returning $options" 2
+    return $options
+}
+
 # Some targets need to always link a special object in.  Save its path here.
 global gdb_saved_set_unbuffered_mode_obj
 set gdb_saved_set_unbuffered_mode_obj ""
@@ -3419,11 +3504,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
@@ -3449,7 +3540,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
@@ -5537,7 +5628,7 @@ proc get_valueof { fmt exp default {test ""} } {
 
     set val ${default}
     gdb_test_multiple "print${fmt} ${exp}" "$test" {
-       -re "\\$\[0-9\]* = (.*)\[\r\n\]*$gdb_prompt $" {
+       -re "\\$\[0-9\]* = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" {
            set val $expect_out(1,string)
            pass "$test ($val)"
        }
@@ -5564,7 +5655,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)"