* gdb.threads/gcore-thread.exp: Use gdb_gcore_cmd.
[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp
index 1dfe564b0e6b0d278a5f4dd866f7d22375e7d2c7..16e8b54fc4b06a315a73131c22371227dab670d2 100644 (file)
@@ -148,7 +148,7 @@ proc gdb_unload {} {
        }
        -re "$gdb_prompt $" {}
        timeout {
-           perror "couldn't unload file in $GDB (timeout)."
+           perror "couldn't unload file in $GDB (timeout)."
            return -1
        }
     }
@@ -334,29 +334,44 @@ proc gdb_start_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,
-# and no-message.
+# message, no-message, and passfail.
+# The result is 1 for success, 0 for failure.
+#
+# Note: The handling of message vs no-message is messed up, but it's based
+# on historical usage.  By default this function does not print passes,
+# only fails.
+# no-message: turns off printing of fails (and passes, but they're already off)
+# message: turns on printing of passes (and fails, but they're already on)
 
 proc gdb_breakpoint { function args } {
     global gdb_prompt
     global decimal
 
     set pending_response n
-    if {[lsearch -exact [lindex $args 0] allow-pending] != -1} {
+    if {[lsearch -exact $args allow-pending] != -1} {
        set pending_response y
     }
 
     set break_command "break"
     set break_message "Breakpoint"
-    if {[lsearch -exact [lindex $args 0] temporary] != -1} {
+    if {[lsearch -exact $args temporary] != -1} {
        set break_command "tbreak"
        set break_message "Temporary breakpoint"
     }
 
-    set no_message 0
-    if {[lsearch -exact [lindex $args 0] no-message] != -1} {
-       set no_message 1
+    set print_pass 0
+    set print_fail 1
+    set no_message_loc [lsearch -exact $args no-message]
+    set message_loc [lsearch -exact $args message]
+    # The last one to appear in args wins.
+    if { $no_message_loc > $message_loc } {
+       set print_fail 0
+    } elseif { $message_loc > $no_message_loc } {
+       set print_pass 1
     }
 
+    set test_name "setting breakpoint at $function"
+
     send_gdb "$break_command $function\n"
     # The first two regexps are what we get with -g, the third is without -g.
     gdb_expect 30 {
@@ -365,8 +380,8 @@ proc gdb_breakpoint { function args } {
        -re "$break_message \[0-9\]* at .*$gdb_prompt $" {}
        -re "$break_message \[0-9\]* \\(.*\\) pending.*$gdb_prompt $" {
                if {$pending_response == "n"} {
-                       if { $no_message == 0 } {
-                               fail "setting breakpoint at $function"
+                       if { $print_fail } {
+                               fail $test_name
                        }
                        return 0
                }
@@ -376,23 +391,34 @@ proc gdb_breakpoint { function args } {
                exp_continue
        }
        -re "A problem internal to GDB has been detected" {
-               fail "setting breakpoint at $function in runto (GDB internal error)"
+               if { $print_fail } {
+                   fail "$test_name (GDB internal error)"
+               }
                gdb_internal_error_resync
                return 0
        }
        -re "$gdb_prompt $" {
-               if { $no_message == 0 } {
-                       fail "setting breakpoint at $function"
+               if { $print_fail } {
+                       fail $test_name
+               }
+               return 0
+       }
+       eof {
+               if { $print_fail } {
+                       fail "$test_name (eof)"
                }
                return 0
        }
        timeout {
-               if { $no_message == 0 } {
-                       fail "setting breakpoint at $function (timeout)"
+               if { $print_fail } {
+                       fail "$test_name (timeout)"
                }
                return 0
        }
     }
+    if { $print_pass } {
+       pass $test_name
+    }
     return 1;
 }    
 
@@ -400,8 +426,15 @@ proc gdb_breakpoint { function args } {
 # Since this is the only breakpoint that will be set, if it stops
 # at a breakpoint, we will assume it is the one we want.  We can't
 # just compare to "function" because it might be a fully qualified,
-# single quoted C++ function specifier.  If there's an additional argument,
-# pass it to gdb_breakpoint.
+# single quoted C++ function specifier.
+#
+# If there are additional arguments, pass them to gdb_breakpoint.
+# We recognize no-message/message ourselves.
+# The default is no-message.
+# no-message is messed up here, like gdb_breakpoint: to preserve
+# historical usage fails are always printed by default.
+# no-message: turns off printing of fails (and passes, but they're already off)
+# message: turns on printing of passes (and fails, but they're already on)
 
 proc runto { function args } {
     global gdb_prompt
@@ -409,7 +442,28 @@ proc runto { function args } {
 
     delete_breakpoints
 
-    if ![gdb_breakpoint $function [lindex $args 0]] {
+    # Default to "no-message".
+    set args "no-message $args"
+
+    set print_pass 0
+    set print_fail 1
+    set no_message_loc [lsearch -exact $args no-message]
+    set message_loc [lsearch -exact $args message]
+    # The last one to appear in args wins.
+    if { $no_message_loc > $message_loc } {
+       set print_fail 0
+    } elseif { $message_loc > $no_message_loc } {
+       set print_pass 1
+    }
+
+    set test_name "running to $function in runto"
+
+    # We need to use eval here to pass our varargs args to gdb_breakpoint
+    # which is also a varargs function.
+    # But we also have to be careful because $function may have multiple
+    # elements, and we don't want Tcl to move the remaining elements after
+    # the first to $args.  That is why $function is wrapped in {}.
+    if ![eval gdb_breakpoint {$function} $args] {
        return 0;
     }
 
@@ -419,33 +473,52 @@ proc runto { function args } {
     # the "in func" output we get without -g.
     gdb_expect 30 {
        -re "Break.* at .*:$decimal.*$gdb_prompt $" {
+           if { $print_pass } {
+               pass $test_name
+           }
            return 1
        }
        -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in .*$gdb_prompt $" { 
+           if { $print_pass } {
+               pass $test_name
+           }
            return 1
        }
        -re "The target does not support running in non-stop mode.\r\n$gdb_prompt $" {
-           unsupported "Non-stop mode not supported"
+           if { $print_fail } {
+               unsupported "Non-stop mode not supported"
+           }
            return 0
        }
        -re ".*A problem internal to GDB has been detected" {
-           fail "running to $function in runto (GDB internal error)"
+           if { $print_fail } {
+               fail "$test_name (GDB internal error)"
+           }
            gdb_internal_error_resync
            return 0
        }
        -re "$gdb_prompt $" { 
-           fail "running to $function in runto"
+           if { $print_fail } {
+               fail $test_name
+           }
            return 0
        }
        eof { 
-           fail "running to $function in runto (end of file)"
+           if { $print_fail } {
+               fail "$test_name (eof)"
+           }
            return 0
        }
        timeout { 
-           fail "running to $function in runto (timeout)"
+           if { $print_fail } {
+               fail "$test_name (timeout)"
+           }
            return 0
        }
     }
+    if { $print_pass } {
+       pass $test_name
+    }
     return 1
 }
 
@@ -455,7 +528,7 @@ proc runto { function args } {
 # If you don't want that, use gdb_start_cmd.
 
 proc runto_main { } {
-    return [runto main]
+    return [runto main no-message]
 }
 
 ### Continue, and expect to hit a breakpoint.
@@ -469,7 +542,7 @@ proc gdb_continue_to_breakpoint {name {location_pattern .*}} {
 
     send_gdb "continue\n"
     gdb_expect {
-       -re "Breakpoint .* (at|in) $location_pattern\r\n$gdb_prompt $" {
+       -re "(?:Breakpoint|Temporary breakpoint) .* (at|in) $location_pattern\r\n$gdb_prompt $" {
            pass $full_name
        }
        -re ".*$gdb_prompt $" {
@@ -508,6 +581,8 @@ proc gdb_continue_to_breakpoint {name {location_pattern .*}} {
 proc gdb_internal_error_resync {} {
     global gdb_prompt
 
+    verbose -log "Resyncing due to internal error."
+
     set count 0
     while {$count < 10} {
        gdb_expect {
@@ -1218,6 +1293,7 @@ proc gdb_file_cmd { arg } {
     global GDB
     global last_loaded_file
 
+    # Save this for the benefit of gdbserver-support.exp.
     set last_loaded_file $arg
 
     # Set whether debug info was found.
@@ -1250,12 +1326,12 @@ proc gdb_file_cmd { arg } {
     send_gdb "file $arg\n"
     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"
+           verbose "\t\tLoaded $arg into $GDB with no debugging symbols"
            set gdb_file_cmd_debug_info "nodebug"
            return 0
        }
         -re "Reading symbols from.*done.*$gdb_prompt $" {
-            verbose "\t\tLoaded $arg into the $GDB"
+            verbose "\t\tLoaded $arg into $GDB"
            set gdb_file_cmd_debug_info "debug"
            return 0
         }
@@ -1268,28 +1344,37 @@ proc gdb_file_cmd { arg } {
                    return 0
                 }
                 timeout {
-                    perror "(timeout) Couldn't load $arg, other program already loaded."
+                    perror "Couldn't load $arg, other program already loaded (timeout)."
                    return -1
                 }
+               eof {
+                   perror "Couldn't load $arg, other program already loaded (eof)."
+                   return -1
+               }
             }
        }
         -re "No such file or directory.*$gdb_prompt $" {
             perror "($arg) No such file or directory"
            return -1
         }
+       -re "A problem internal to GDB has been detected" {
+           fail "($arg) (GDB internal error)"
+           gdb_internal_error_resync
+           return -1
+       }
         -re "$gdb_prompt $" {
-            perror "couldn't load $arg into $GDB."
+            perror "Couldn't load $arg into $GDB."
            return -1
             }
         timeout {
-            perror "couldn't load $arg into $GDB (timed out)."
+            perror "Couldn't load $arg into $GDB (timeout)."
            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.
-            perror "couldn't load $arg into $GDB (end of file)."
+            perror "Couldn't load $arg into $GDB (eof)."
            return -1
         }
     }
@@ -1827,7 +1912,7 @@ proc skip_altivec_tests {} {
 
     # Make sure we have a compiler that understands altivec.
     set compile_flags {debug nowarnings}
-    if [get_compiler_info not-used] {
+    if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
@@ -1916,7 +2001,7 @@ proc skip_vsx_tests {} {
 
     # Make sure we have a compiler that understands altivec.
     set compile_flags {debug nowarnings quiet}
-    if [get_compiler_info not-used] {
+    if [get_compiler_info] {
        warning "Could not get compiler info"
        return 1
     }
@@ -2093,6 +2178,36 @@ proc skip_hw_watchpoint_access_tests {} {
     return 0
 }
 
+# Return 1 if we should skip tests that require the runtime unwinder
+# hook.  This must be invoked while gdb is running, after shared
+# libraries have been loaded.  This is needed because otherwise a
+# shared libgcc won't be visible.
+
+proc skip_unwinder_tests {} {
+    global gdb_prompt
+
+    set ok 0
+    gdb_test_multiple "print _Unwind_DebugHook" "check for unwinder hook" {
+       -re "= .*no debug info.*_Unwind_DebugHook.*\r\n$gdb_prompt $" {
+       }
+       -re "= .*_Unwind_DebugHook.*\r\n$gdb_prompt $" {
+           set ok 1
+       }
+       -re "No symbol .* in current context.\r\n$gdb_prompt $" {
+       }
+    }
+    if {!$ok} {
+       gdb_test_multiple "info probe" "check for stap probe in unwinder" {
+           -re ".*libgcc.*unwind.*\r\n$gdb_prompt $" {
+               set ok 1
+           }
+           -re "\r\n$gdb_prompt $" {
+           }
+       }
+    }
+    return $ok
+}
+
 set compiler_info              "unknown"
 set gcc_compiled               0
 set hp_cc_compiler             0
@@ -2100,10 +2215,7 @@ set hp_aCC_compiler              0
 
 # Figure out what compiler I am using.
 #
-# BINFILE is a "compiler information" output file.  This implementation
-# does not use BINFILE.
-#
-# ARGS can be empty or "C++".  If empty, "C" is assumed.
+# ARG can be empty or "C++".  If empty, "C" is assumed.
 #
 # There are several ways to do this, with various problems.
 #
@@ -2152,7 +2264,7 @@ set hp_aCC_compiler               0
 #
 # -- chastain 2004-01-06
 
-proc get_compiler_info {binfile args} {
+proc get_compiler_info {{arg ""}} {
     # For compiler.c and compiler.cc
     global srcdir
 
@@ -2170,7 +2282,7 @@ proc get_compiler_info {binfile args} {
 
     # Choose which file to preprocess.
     set ifile "${srcdir}/lib/compiler.c"
-    if { [llength $args] > 0 && [lindex $args 0] == "c++" } {
+    if { $arg == "c++" } {
        set ifile "${srcdir}/lib/compiler.cc"
     }
 
@@ -2181,12 +2293,12 @@ proc get_compiler_info {binfile args} {
        # We have to use -E and -o together, despite the comments
        # above, because of how DejaGnu handles remote host testing.
        set ppout "$outdir/compiler.i"
-       gdb_compile "${ifile}" "$ppout" preprocess [list "$args" quiet]
+       gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet]
        set file [open $ppout r]
        set cppout [read $file]
        close $file
     } else {
-       set cppout [ gdb_compile "${ifile}" "" preprocess [list "$args" quiet] ]
+       set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ]
     }
     log_file -a "$outdir/$tool.log" 
 
@@ -2914,6 +3026,36 @@ proc gdb_load_cmd { args } {
     return -1
 }
 
+# Invoke "gcore".  CORE is the name of the core file to write.  TEST
+# is the name of the test case.  This will return 1 if the core file
+# was created, 0 otherwise.  If this fails to make a core file because
+# this configuration of gdb does not support making core files, it
+# will call "unsupported", not "fail".  However, if this fails to make
+# a core file for some other reason, then it will call "fail".
+
+proc gdb_gcore_cmd {core test} {
+    global gdb_prompt
+
+    set result 0
+    gdb_test_multiple "gcore $core" $test {
+       -re "Saved corefile .*\[\r\n\]+$gdb_prompt $" {
+           pass $test
+           set result 1
+       }
+
+       -re "Undefined command.*$gdb_prompt $" {
+           unsupported $test
+           verbose -log "'gcore' command undefined in gdb_gcore_cmd"
+       }
+
+       -re "Can't create a corefile\[\r\n\]+$gdb_prompt $" {
+           unsupported $test
+       }
+    }
+
+    return $result
+}
+
 # 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.
@@ -3027,12 +3169,15 @@ proc gdb_continue { function } {
 proc default_gdb_init { args } {
     global gdb_wrapper_initialized
     global gdb_wrapper_target
+    global gdb_test_file_name
     global cleanfiles
     
     set cleanfiles {}
 
     gdb_clear_suppressed;
 
+    set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]
+
     # Make sure that the wrapper is rebuilt
     # with the appropriate multilib option.
     if { $gdb_wrapper_target != [current_target_name] } {
@@ -3066,6 +3211,84 @@ proc default_gdb_init { args } {
     }
 }
 
+# Turn BASENAME into a full file name in the standard output
+# directory.  It is ok if BASENAME is the empty string; in this case
+# the directory is returned.
+
+proc standard_output_file {basename} {
+    global objdir subdir
+
+    return [file join $objdir $subdir $basename]
+}
+
+# Set 'testfile', 'srcfile', and 'binfile'.
+#
+# ARGS is a list of source file specifications.
+# Without any arguments, the .exp file's base name is used to
+# compute the source file name.  The ".c" extension is added in this case.
+# If ARGS is not empty, each entry is a source file specification.
+# If the specification starts with a ".", it is treated as a suffix
+# to append to the .exp file's base name.
+# If the specification is the empty string, it is treated as if it
+# were ".c".
+# Otherwise it is a file name.
+# The first file in the list is used to set the 'srcfile' global.
+# Each subsequent name is used to set 'srcfile2', 'srcfile3', etc.
+#
+# Most tests should call this without arguments.
+#
+# If a completely different binary file name is needed, then it
+# should be handled in the .exp file with a suitable comment.
+
+proc standard_testfile {args} {
+    global gdb_test_file_name
+    global subdir
+    global gdb_test_file_last_vars
+
+    # Outputs.
+    global testfile binfile
+
+    set testfile $gdb_test_file_name
+    set binfile [standard_output_file ${testfile}]
+
+    if {[llength $args] == 0} {
+       set args .c
+    }
+
+    # Unset our previous output variables.
+    # This can help catch hidden bugs.
+    if {[info exists gdb_test_file_last_vars]} {
+       foreach varname $gdb_test_file_last_vars {
+           global $varname
+           catch {unset $varname}
+       }
+    }
+    # 'executable' is often set by tests.
+    set gdb_test_file_last_vars {executable}
+
+    set suffix ""
+    foreach arg $args {
+       set varname srcfile$suffix
+       global $varname
+
+       # Handle an extension.
+       if {$arg == ""} {
+           set arg $testfile.c
+       } elseif {[string range $arg 0 0] == "."} {
+           set arg $testfile$arg
+       }
+
+       set $varname $arg
+       lappend gdb_test_file_last_vars $varname
+
+       if {$suffix == ""} {
+           set suffix 2
+       } else {
+           incr suffix
+       }
+    }
+}
+
 # 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).
@@ -3208,7 +3431,7 @@ proc get_debug_format { } {
            return 1;
        }
        timeout {
-           warning "couldn't check debug format (timeout)."
+           warning "couldn't check debug format (timeout)."
            return 1;
        }
     }
@@ -3241,14 +3464,6 @@ proc setup_xfail_format { format } {
     return $ret;
 }
 
-# Like setup_kfail, but only call setup_kfail conditionally if
-# istarget[TARGET] returns true.
-proc setup_kfail_for_target { PR target } {
-    if { [istarget $target] } {
-       setup_kfail $PR $target
-    }
-}
-
 # gdb_get_line_number TEXT [FILE]
 #
 # Search the source file FILE, and return the line number of the
@@ -3656,29 +3871,31 @@ proc test_prefix_command_help { command_list expected_initial_lines args } {
     }
 }
 
-# Build executable named EXECUTABLE, from SOURCES.  If SOURCES are not
-# provided, uses $EXECUTABLE.c.  The TESTNAME paramer is the name of test
-# to pass to untested, if something is wrong.  OPTIONS are passed
-# to gdb_compile directly.
-proc build_executable { testname executable {sources ""} {options {debug}} } {
-
-    global objdir
+# Build executable named EXECUTABLE from specifications that allow
+# different options to be passed to different sub-compilations.
+# TESTNAME is the name of the test; this is passed to 'untested' if
+# something fails.
+# OPTIONS is passed to the final link, using gdb_compile.
+# ARGS is a flat list of source specifications, of the form:
+#    { SOURCE1 OPTIONS1 [ SOURCE2 OPTIONS2 ]... }
+# Each SOURCE is compiled to an object file using its OPTIONS,
+# using gdb_compile.
+# Returns 0 on success, -1 on failure.
+proc build_executable_from_specs {testname executable options args} {
     global subdir
     global srcdir
-    if {[llength $sources]==0} {
-        set sources ${executable}.c
-    }
 
-    set binfile ${objdir}/${subdir}/${executable}
+    set binfile [standard_output_file $executable]
 
     set objects {}
-    for {set i 0} "\$i<[llength $sources]" {incr i} {
-        set s [lindex $sources $i]
-        if  { [gdb_compile "${srcdir}/${subdir}/${s}" "${binfile}${i}.o" object $options] != "" } {
+    set i 0
+    foreach {s local_options} $args {
+        if  { [gdb_compile "${srcdir}/${subdir}/${s}" "${binfile}${i}.o" object $local_options] != "" } {
             untested $testname
             return -1
         }
         lappend objects "${binfile}${i}.o"
+       incr i
     }
     
     if  { [gdb_compile $objects "${binfile}" executable $options] != "" } {
@@ -3690,19 +3907,35 @@ proc build_executable { testname executable {sources ""} {options {debug}} } {
     if { [lsearch -exact $options "c++"] >= 0 } {
        set info_options "c++"
     }
-    if [get_compiler_info ${binfile} ${info_options}] {
+    if [get_compiler_info ${info_options}] {
         return -1
     }
     return 0
 }
 
+# Build executable named EXECUTABLE, from SOURCES.  If SOURCES are not
+# provided, uses $EXECUTABLE.c.  The TESTNAME paramer is the name of test
+# to pass to untested, if something is wrong.  OPTIONS are passed
+# to gdb_compile directly.
+proc build_executable { testname executable {sources ""} {options {debug}} } {
+    if {[llength $sources]==0} {
+        set sources ${executable}.c
+    }
+
+    set arglist [list $testname $executable $options]
+    foreach source $sources {
+       lappend arglist $source $options
+    }
+
+    return [eval build_executable_from_specs $arglist]
+}
+
 # Starts fresh GDB binary and loads EXECUTABLE into GDB. EXECUTABLE is
-# the name of binary in ${objdir}/${subdir}.
+# the basename of the binary.
 proc clean_restart { executable } {
     global srcdir
-    global objdir
     global subdir
-    set binfile ${objdir}/${subdir}/${executable}
+    set binfile [standard_output_file ${executable}]
 
     gdb_exit
     gdb_start
@@ -3710,6 +3943,25 @@ proc clean_restart { executable } {
     gdb_load ${binfile}
 }
 
+# Prepares for testing by calling build_executable_full, then
+# clean_restart.
+# TESTNAME is the name of the test.
+# Each element in ARGS is a list of the form
+#    { EXECUTABLE OPTIONS SOURCE_SPEC... }
+# These are passed to build_executable_from_specs, which see.
+# The last EXECUTABLE is passed to clean_restart.
+# Returns 0 on success, non-zero on failure.
+proc prepare_for_testing_full {testname args} {
+    foreach spec $args {
+       if {[eval build_executable_from_specs [list $testname] $spec] == -1} {
+           return -1
+       }
+       set executable [lindex $spec 0]
+    }
+    clean_restart $executable
+    return 0
+}
+
 # Prepares for testing, by calling build_executable, and then clean_restart.
 # Please refer to build_executable for parameter description.
 proc prepare_for_testing { testname executable {sources ""} {options {debug}}} {
@@ -3871,7 +4123,7 @@ proc core_find {binfile {deletefiles {}} {arg ""}} {
     # 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]"
+    set coredir [standard_output_file coredir.[getpid]]
     file mkdir $coredir
     catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >/dev/null 2>&1\""
     #      remote_exec host "${binfile}"
This page took 0.032267 seconds and 4 git commands to generate.