daily update
[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp
index 433015f0fbf0192e269a1edfa110338e8211ba2a..ce9d6f1e692e11679783d108bb6abb2226c5eed2 100644 (file)
@@ -180,8 +180,7 @@ proc gdb_run_cmd {args} {
        if [target_info exists gdb,do_reload_on_run] {
            # Specifying no file, defaults to the executable
            # currently being debugged.
-           set status [gdb_load ""]
-           if { [lindex $status 0] != "" } {
+           if { [gdb_load ""] != 0 } {
                return;
            }
            send_gdb "continue\n";
@@ -226,8 +225,7 @@ proc gdb_run_cmd {args} {
                    send_gdb "y\n"
                }
                -re "The program is not being run.*$gdb_prompt $" {
-                   set status [gdb_load ""]
-                   if { [lindex $status 0] != ""] } {
+                   if { [gdb_load ""] != 0 } {
                        return;
                    }
                    send_gdb "jump *$start\n";
@@ -249,8 +247,7 @@ proc gdb_run_cmd {args} {
     }
 
     if [target_info exists gdb,do_reload_on_run] {
-       set status [gdb_load ""]
-       if { [lindex $status 0] != "" } {
+       if { [gdb_load ""] != 0 } {
            return;
        }
     }
@@ -957,36 +954,37 @@ proc default_gdb_exit {} {
 }
 
 # Load a file into the debugger.
-# The return value is a list with the following information:
+# The return value is 0 for success, -1 for failure.
 #
-#  { message word ... }
-# 
-# MESSAGE has the following values:
-#
-#   ""     file was loaded successfully
-#   "..."  file was not loaded successfully.
-#          A perror has been generated with MESSAGE.
+# This procedure also set the global variable GDB_FILE_CMD_DEBUG_INFO
+# to one of these values:
 #
-# If the MESSAGE is "", then there is an optional set of words.
-# The words may be:
+#   debug    file was loaded successfully and has debug information
+#   nodebug  file was loaded successfully and has no debug information
+#   fail     file was not loaded
 #
-#  nodebug  this file does not contain debug information
+# I tried returning this information as part of the return value,
+# but ran into a mess because of the many re-implementations of
+# gdb_load in config/*.exp.
 #
-# TODO: gdb.base/sepdebug.exp and gdb.stabs/weird.exp might
-# be able to use this if they can get more information
-# in the return value.
+# TODO: gdb.base/sepdebug.exp and gdb.stabs/weird.exp might be able to use
+# this if they can get more information set.
 
 proc gdb_file_cmd { arg } {
     global gdb_prompt
     global verbose
     global GDB
 
+    # Set whether debug info was found.
+    # Default to "fail".
+    global gdb_file_cmd_debug_info
+    set gdb_file_cmd_debug_info "fail"
+
     if [is_remote host] {
        set arg [remote_download host $arg]
        if { $arg == "" } {
-           set message "download failed"
-           perror $message
-           return { $message }
+           perror "download failed"
+           return -1
        }
     }
 
@@ -994,15 +992,17 @@ proc gdb_file_cmd { arg } {
     gdb_expect 120 {
        -re "Reading symbols from.*no debugging symbols found.*done.*$gdb_prompt $" {
            verbose "\t\tLoaded $arg into the $GDB with no debugging symbols"
-           return { "" nodebug }
+           set gdb_file_cmd_debug_info "nodebug"
+           return 0
        }
         -re "Reading symbols from.*done.*$gdb_prompt $" {
             verbose "\t\tLoaded $arg into the $GDB"
-           return { "" }
+           set gdb_file_cmd_debug_info "debug"
+           return 0
         }
         -re "A program is being debugged already.*Kill it.*y or n. $" {
             send_gdb "y\n"
-                verbose "\t\tKilling previous program being debugged"
+           verbose "\t\tKilling previous program being debugged"
             exp_continue
         }
         -re "Load new symbol table from \".*\".*y or n. $" {
@@ -1010,37 +1010,33 @@ proc gdb_file_cmd { arg } {
             gdb_expect 120 {
                 -re "Reading symbols from.*done.*$gdb_prompt $" {
                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
-                   return { "" }
+                   set gdb_file_cmd_debug_info "debug"
+                   return 0
                 }
                 timeout {
-                    set message "(timeout) Couldn't load $arg, other program already loaded."
-                   perror $message
-                   return { $message }
+                    perror "(timeout) Couldn't load $arg, other program already loaded."
+                   return -1
                 }
             }
        }
         -re "No such file or directory.*$gdb_prompt $" {
-            set message "($arg) No such file or directory"
-            perror $message
-           return { $message }
+            perror "($arg) No such file or directory"
+           return -1
         }
         -re "$gdb_prompt $" {
-            set message "couldn't load $arg into $GDB."
-            perror $message
-           return { $message }
+            perror "couldn't load $arg into $GDB."
+           return -1
             }
         timeout {
-            set message "couldn't load $arg into $GDB (timed out)."
-           perror $message
-           return { $message }
+            perror "couldn't load $arg into $GDB (timed out)."
+           return -1
         }
         eof {
             # This is an attempt to detect a core dump, but seems not to
             # work.  Perhaps we need to match .* followed by eof, in which
             # gdb_expect does not seem to have a way to do that.
-            set message "couldn't load $arg into $GDB (end of file)."
-           perror $message
-           return { $message }
+            perror "couldn't load $arg into $GDB (end of file)."
+           return -1
         }
     }
 }
@@ -1295,8 +1291,19 @@ proc get_compiler_info {binfile args} {
     return 0;
 }
 
-proc test_compiler_info { compiler } {
+proc test_compiler_info { {compiler ""} } {
     global compiler_info
+
+     # if no arg, return the compiler_info string
+
+     if [string match "" $compiler] {
+         if [info exists compiler_info] {
+             return $compiler_info
+         } else {
+             perror "No compiler info found."
+         }
+     }
+
     return [string match $compiler $compiler_info]
 }
 
@@ -1328,6 +1335,35 @@ proc gdb_compile {source dest type options} {
     global gdb_wrapper_flags;
     global gdb_wrapper_initialized;
 
+     # Add platform-specific options if a shared library was specified using
+     # "shlib=librarypath" in OPTIONS.
+     set new_options ""
+     set shlib_found 0
+     foreach opt $options {
+        if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
+            if [test_compiler_info "xlc-*"] {
+               # IBM xlc compiler doesn't accept shared library named other  
+               # than .so: use "-Wl," to bypass this
+               lappend source "-Wl,$shlib_name"
+            } else {
+               lappend source $shlib_name
+            }
+            if {$shlib_found == 0} {
+                set shlib_found 1
+                if { ([test_compiler_info "gcc-*"]
+                      &&  ([istarget "powerpc*-*-aix*"]
+                        || [istarget "rs6000*-*-aix*"] )) } {
+                    lappend options "additional_flags=-L${objdir}/${subdir}"
+                } elseif { [istarget "mips-sgi-irix*"] } {
+                    lappend options "additional_flags=-rpath ${objdir}/${subdir}"
+                }
+            }
+        } else {
+            lappend new_options $opt
+        }
+     }
+     set options $new_options
+
     if [target_info exists gdb_stub] {
        set options2 { "additional_flags=-Dusestubs" }
        lappend options "libs=[target_info gdb_stub]";
@@ -1398,6 +1434,63 @@ proc gdb_compile_pthreads {source dest type options} {
     }
 }
 
+# Build a shared library from SOURCES.  You must use get_compiler_info
+# first.
+
+proc gdb_compile_shlib {sources dest options} {
+    set obj_options $options
+
+    switch -glob [test_compiler_info] {
+        "xlc-*" {
+            lappend obj_options "additional_flags=-qpic"
+        }
+        "gcc-*" {
+            if { !([istarget "powerpc*-*-aix*"]
+                   || [istarget "rs6000*-*-aix*"]) } {
+                lappend obj_options "additional_flags=-fpic"
+            }
+        }
+        default {
+            switch -glob [istarget] {
+                "hppa*-hp-hpux*" {
+                    lappend obj_options "additional_flags=+z"
+                }
+                "mips-sgi-irix*" {
+                    # Disable SGI compiler's implicit -Dsgi
+                    lappend obj_options "additional_flags=-Usgi"
+                } 
+                default {
+                    # don't know what the compiler is...
+                }
+            }
+        }
+    }
+
+    set outdir [file dirname $dest]
+    set objects ""
+    foreach source $sources {
+       set sourcebase [file tail $source]
+       if {[gdb_compile $source "${outdir}/${sourcebase}.o" object $obj_options] != ""} {
+           return -1
+       }
+       lappend objects ${outdir}/${sourcebase}.o
+    }
+
+    if [istarget "hppa*-*-hpux*"] {
+       remote_exec build "ld -b ${objects} -o ${dest}"
+    } else {
+       set link_options $options
+       if [test_compiler_info "xlc-*"] {
+          lappend link_options "additional_flags=-qmkshrobj"
+       } else {
+          lappend link_options "additional_flags=-shared"
+       }
+       if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} {
+           return -1
+       }
+    }
+}
+
 # This is just like gdb_compile_pthreads, above, except that we always add the
 # objc library for compiling Objective-C programs
 proc gdb_compile_objc {source dest type options} {
@@ -1655,6 +1748,7 @@ proc gdb_exit { } {
 
 #
 # gdb_load -- load a file into the debugger.
+# Many files in config/*.exp override this procedure.
 #
 proc gdb_load { arg } {
     return [gdb_file_cmd $arg]
This page took 0.026913 seconds and 4 git commands to generate.