gdb/testsuite/
[binutils-gdb.git] / gdb / testsuite / lib / gdb.exp
index 4658c8d85105769539ad232655de5cfadee622e7..8be2a7240a94e0f2d5744933dc1ed8fd25d5cee5 100644 (file)
@@ -54,7 +54,10 @@ if ![info exists GDBFLAGS] {
 verbose "using GDBFLAGS = $GDBFLAGS" 2
 
 # INTERNAL_GDBFLAGS contains flags that the testsuite requires.
-set INTERNAL_GDBFLAGS "-nw -nx"
+global INTERNAL_GDBFLAGS
+if ![info exists INTERNAL_GDBFLAGS] {
+    set INTERNAL_GDBFLAGS "-nw -nx"
+}
 
 # The variable gdb_prompt is a regexp which matches the gdb prompt.
 # Set it if it is not already set.
@@ -312,13 +315,13 @@ proc gdb_start_cmd {args} {
     }
 
     send_gdb "start $args\n"
+    # Use -notransfer here so that test cases (like chng-sym.exp)
+    # may test for additional start-up messages.
     gdb_expect 60 {
        -re "The program .* has been started already.*y or n. $" {
            send_gdb "y\n"
            exp_continue
        }
-       # Use -notransfer here so that test cases (like chng-sym.exp)
-       # may test for additional start-up messages.
        -notransfer -re "Starting program: \[^\r\n\]*" {
            return 0
        }
@@ -598,12 +601,23 @@ proc gdb_test_multiple { command message user_code } {
     set processed_code ""
     set patterns ""
     set expecting_action 0
+    set expecting_arg 0
     foreach item $user_code subst_item $subst_code {
        if { $item == "-n" || $item == "-notransfer" || $item == "-nocase" } {
            lappend processed_code $item
            continue
        }
-       if {$item == "-indices" || $item == "-re" || $item == "-ex"} {
+       if { $item == "-indices" || $item == "-re" || $item == "-ex" } {
+           lappend processed_code $item
+           continue
+       }
+       if { $item == "-timeout" } {
+           set expecting_arg 1
+           lappend processed_code $item
+           continue
+       }
+       if { $expecting_arg } {
+           set expecting_arg 0
            lappend processed_code $item
            continue
        }
@@ -733,7 +747,7 @@ proc gdb_test_multiple { command message user_code } {
            fail "$errmsg"
            set result -1
        }
-        -re "EXIT code \[0-9\r\n\]+Program exited normally.*$gdb_prompt $" {
+        -re "Program exited normally.*$gdb_prompt $" {
            if ![string match "" $message] then {
                set errmsg "$message (the program exited)"
            } else {
@@ -1253,6 +1267,8 @@ proc gdb_compile_test {src output} {
        unsupported "compilation [file tail $src]"
     } elseif { [regexp {.*: command not found[\r|\n]*$} $output] } {
        unsupported "compilation [file tail $src]"
+    } elseif { [regexp {.*: [^\r\n]*compiler not installed[^\r\n]*[\r|\n]*$} $output] } {
+       unsupported "compilation [file tail $src]"
     } else {
        verbose -log "compilation failed: $output" 2
        fail "compilation [file tail $src]"
@@ -1278,6 +1294,18 @@ proc skip_cplus_tests {} {
     return 0
 }
 
+# Return a 1 for configurations for which don't have both C++ and the STL.
+
+proc skip_stl_tests {} {
+    # Symbian supports the C++ language, but the STL is missing
+    # (both headers and libraries).
+    if { [istarget "arm*-*-symbianelf*"] } {
+       return 1
+    }
+
+    return [skip_cplus_tests]
+}
+
 # Return a 1 if I don't even want to try to test FORTRAN.
 
 proc skip_fortran_tests {} {
@@ -1296,6 +1324,21 @@ proc skip_java_tests {} {
     return 0
 }
 
+# Return a 1 for configurations that do not support Python scripting.
+
+proc skip_python_tests {} {
+    global gdb_prompt
+    gdb_test_multiple "python print 'test'" "verify python support" {
+       -re "not supported.*$gdb_prompt $"      {
+           unsupported "Python support is disabled."
+           return 1
+       }
+       -re "$gdb_prompt $"     {}
+    }
+
+    return 0
+}
+
 # Return a 1 if we should skip shared library tests.
 
 proc skip_shlib_tests {} {
@@ -1790,11 +1833,14 @@ proc gdb_compile {source dest type options} {
        if { ([istarget "*-*-mingw*"]
              || [istarget *-*-cygwin*]
              || [istarget *-*-pe*]
-             || [istarget arm*-*-symbianelf*]
              || [istarget hppa*-*-hpux*])} {
            # Do not need anything.
        } elseif { [istarget *-*-openbsd*] } {
            lappend new_options "additional_flags=-Wl,-rpath,${outdir}"
+       } elseif { [istarget arm*-*-symbianelf*] } {
+           if { $shlib_load } {
+               lappend new_options "libs=-ldl"
+           }
        } else {
            if { $shlib_load } {
                lappend new_options "libs=-ldl"
@@ -1911,7 +1957,7 @@ proc gdb_compile {source dest type options} {
 proc gdb_compile_pthreads {source dest type options} {
     set built_binfile 0
     set why_msg "unrecognized error"
-    foreach lib {-lpthreads -lpthread -lthread} {
+    foreach lib {-lpthreads -lpthread -lthread ""} {
         # This kind of wipes out whatever libs the caller may have
         # set.  Or maybe theirs will override ours.  How infelicitous.
         set options_with_lib [concat $options [list libs=$lib quiet]]
@@ -2315,6 +2361,22 @@ proc gdb_load_cmd { args } {
     return -1
 }
 
+# Return the filename to download to the target and load on the target
+# for this shared library.  Normally just LIBNAME, unless shared libraries
+# for this target have separate link and load images.
+
+proc shlib_target_file { libname } {
+    return $libname
+}
+
+# Return the filename GDB will load symbols from when debugging this
+# shared library.  Normally just LIBNAME, unless shared libraries for
+# this target have separate link and load images.
+
+proc shlib_symbol_file { libname } {
+    return $libname
+}
+
 # gdb_download
 #
 # Copy a file to the remote target and return its target filename.
@@ -2338,7 +2400,7 @@ proc gdb_load_shlibs { args } {
     }
 
     foreach file $args {
-       gdb_download $file
+       gdb_download [shlib_target_file $file]
     }
 
     # Even if the target supplies full paths for shared libraries,
@@ -2410,7 +2472,22 @@ proc default_gdb_init { args } {
     }
 }
 
+# The default timeout used when testing GDB commands.  We want to use
+# the same timeout as the default dejagnu timeout, unless the user has
+# already provided a specific value (probably through a site.exp file).
+global gdb_test_timeout
+if ![info exists gdb_test_timeout] {
+    set gdb_test_timeout $timeout
+}
+
 proc gdb_init { args } {
+    # Reset the timeout value to the default.  This way, any testcase
+    # that changes the timeout value without resetting it cannot affect
+    # the timeout used in subsequent testcases.
+    global gdb_test_timeout
+    global timeout
+    set timeout $gdb_test_timeout
+
     return [eval default_gdb_init $args];
 }
 
@@ -2756,8 +2833,8 @@ proc gdb_skip_xml_test { } {
 # Note: the procedure gdb_gnu_strip_debug will produce an executable called
 # ${binfile}.dbglnk, which is just like the executable ($binfile) but without
 # the debuginfo. Instead $binfile has a .gnu_debuglink section which contains
-# the name of a debuginfo only file. This file will be stored in the 
-# gdb.base/.debug subdirectory.
+# the name of a debuginfo only file. This file will be stored in the same
+# subdirectory.
 
 # Functions for separate debug info testing
 
@@ -2766,27 +2843,9 @@ proc gdb_skip_xml_test { } {
 
 # at the end of the process we have:
 # foo.stripped --> foo w/o debug info
-# .debug/foo.debug --> foo's debug info
+# foo.debug --> foo's debug info
 # foo --> like foo, but with a new .gnu_debuglink section pointing to foo.debug.
 
-# Return the name of the file in which we should stor EXEC's separated
-# debug info. EXEC contains the full path.
-proc separate_debug_filename { exec } {
-
-    # In a .debug subdirectory off the same directory where the testcase
-    # executable is going to be. Something like:
-    # <your-path>/gdb/testsuite/gdb.base/.debug/blah.debug.
-    # This is the default location where gdb expects to findi
-    # the debug info file.
-
-    set exec_dir [file dirname $exec]
-    set exec_file [file tail $exec]
-    set debug_dir [file join $exec_dir ".debug"]
-    set debug_file [file join $debug_dir "${exec_file}.debug"]
-
-    return $debug_file
-}
-
 # Return the build-id hex string (usually 160 bits as 40 hex characters)
 # converted to the form: .build-id/ab/cdef1234...89.debug
 # Return "" if no build-id found.
@@ -2812,27 +2871,26 @@ proc build_id_debug_filename_get { exec } {
     }
     # Convert it to hex.
     binary scan $data H* data
-    set data [regsub {^..} $data {\0/}]
+    regsub {^..} $data {\0/} data
     return ".build-id/${data}.debug";
 }
 
 # Create stripped files for DEST, replacing it.  If ARGS is passed, it is a
 # list of optional flags.  The only currently supported flag is no-main,
 # which removes the symbol entry for main from the separate debug file.
+#
+# Function returns zero on success.  Function will return non-zero failure code
+# on some targets not supporting separate debug info (such as i386-msdos).
 
 proc gdb_gnu_strip_debug { dest args } {
 
-    set debug_file [separate_debug_filename $dest]
+    # Use the first separate debug info file location searched by GDB so the
+    # run cannot be broken by some stale file searched with higher precedence.
+    set debug_file "${dest}.debug"
+
     set strip_to_file_program [transform strip]
     set objcopy_program [transform objcopy]
 
-    # Make sure the directory that will hold the separated debug
-    # info actually exists.
-    set debug_dir [file dirname $debug_file]
-    if {! [file isdirectory $debug_dir]} {
-       file mkdir $debug_dir
-    }
-
     set debug_link [file tail $debug_file]
     set stripped_file "${dest}.stripped"
 
@@ -2845,6 +2903,11 @@ proc gdb_gnu_strip_debug { dest args } {
       return 1
     }
 
+    # Workaround PR binutils/10802:
+    # Preserve the 'x' bit also for PIEs (Position Independent Executables).
+    set perm [file attributes ${dest} -permissions]
+    file attributes ${stripped_file} -permissions $perm
+
     # Get rid of everything but the debug info, and store result in debug_file
     # This will be in the .debug subdirectory, see above.
     set result [catch "exec $strip_to_file_program --only-keep-debug ${dest} -o ${debug_file}" output]
@@ -2881,7 +2944,12 @@ proc gdb_gnu_strip_debug { dest args } {
       return 1
     }
 
-   return 0
+    # Workaround PR binutils/10802:
+    # Preserve the 'x' bit also for PIEs (Position Independent Executables).
+    set perm [file attributes ${stripped_file} -permissions]
+    file attributes ${dest} -permissions $perm
+
+    return 0
 }
 
 # Test the output of GDB_COMMAND matches the pattern obtained
@@ -3110,3 +3178,70 @@ if {[info exists TRANSCRIPT]} {
     return [uplevel real_send_gdb $args]
   }
 }
+
+proc core_find {binfile {deletefiles {}} {arg ""}} {
+    global objdir subdir
+
+    set destcore "$binfile.core"
+    file delete $destcore
+
+    # Create a core file named "$destcore" rather than just "core", to
+    # avoid problems with sys admin types that like to regularly prune all
+    # files named "core" from the system.
+    #
+    # Arbitrarily try setting the core size limit to "unlimited" since
+    # this does not hurt on systems where the command does not work and
+    # allows us to generate a core on systems where it does.
+    #
+    # Some systems append "core" to the name of the program; others append
+    # the name of the program to "core"; still others (like Linux, as of
+    # May 2003) create cores named "core.PID".  In the latter case, we
+    # could have many core files lying around, and it may be difficult to
+    # tell which one is ours, so let's run the program in a subdirectory.
+    set found 0
+    set coredir "${objdir}/${subdir}/coredir.[getpid]"
+    file mkdir $coredir
+    catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >/dev/null 2>&1\""
+    #      remote_exec host "${binfile}"
+    foreach i "${coredir}/core ${coredir}/core.coremaker.c ${binfile}.core" {
+       if [remote_file build exists $i] {
+           remote_exec build "mv $i $destcore"
+           set found 1
+       }
+    }
+    # Check for "core.PID".
+    if { $found == 0 } {
+       set names [glob -nocomplain -directory $coredir core.*]
+       if {[llength $names] == 1} {
+           set corefile [file join $coredir [lindex $names 0]]
+           remote_exec build "mv $corefile $destcore"
+           set found 1
+       }
+    }
+    if { $found == 0 } {
+       # The braindamaged HPUX shell quits after the ulimit -c above
+       # without executing ${binfile}.  So we try again without the
+       # ulimit here if we didn't find a core file above.
+       # Oh, I should mention that any "braindamaged" non-Unix system has
+       # the same problem. I like the cd bit too, it's really neat'n stuff.
+       catch "system \"(cd ${objdir}/${subdir}; ${binfile}; true) >/dev/null 2>&1\""
+       foreach i "${objdir}/${subdir}/core ${objdir}/${subdir}/core.coremaker.c ${binfile}.core" {
+           if [remote_file build exists $i] {
+               remote_exec build "mv $i $destcore"
+               set found 1
+           }
+       }
+    }
+
+    # Try to clean up after ourselves. 
+    foreach deletefile $deletefiles {
+       remote_file build delete [file join $coredir $deletefile]
+    }
+    remote_exec build "rmdir $coredir"
+       
+    if { $found == 0  } {
+       warning "can't generate a core file - core tests suppressed - check ulimit -c"
+       return ""
+    }
+    return $destcore
+}