Get rid of "No such file or directory" in the testsuite's btrace support detection.
[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp
index 8715c5ee2f11ea945759b78a95a6728364d66947..d05257d0f3cbfc29d7104f8b7951d816dfec624e 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright 1992-2005, 2007-2012 Free Software Foundation, Inc.
+# Copyright 1992-2013 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
@@ -123,11 +123,12 @@ proc default_gdb_version {} {
 }
 
 proc gdb_version { } {
-    return [default_gdb_version];
+    return [default_gdb_version]
 }
 
 #
 # gdb_unload -- unload a file if one is loaded
+# Return 0 on success, -1 on error.
 #
 
 proc gdb_unload {} {
@@ -148,10 +149,11 @@ 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
        }
     }
+    return 0
 }
 
 # Many of the tests depend on setting breakpoints at various places and
@@ -308,7 +310,7 @@ proc gdb_start_cmd {args} {
            -re "$gdb_prompt $" { }
            default {
                perror "gdb_init_command for target failed";
-               return -1;
+               return -1
            }
        }
     }
@@ -334,29 +336,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 +382,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,32 +393,50 @@ 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
        }
     }
-    return 1;
+    if { $print_pass } {
+       pass $test_name
+    }
+    return 1
 }    
 
 # Set breakpoint at function and run gdb until it breaks there.
 # 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,8 +444,29 @@ proc runto { function args } {
 
     delete_breakpoints
 
-    if ![gdb_breakpoint $function [lindex $args 0]] {
-       return 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
     }
 
     gdb_run_cmd
@@ -419,33 +475,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 +530,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.
@@ -508,6 +583,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 {
@@ -681,7 +758,7 @@ proc gdb_test_multiple { command message user_code } {
                        perror "Couldn't send $command to GDB.";
                    }
                    fail "$message";
-                   return $result;
+                   return $result
                }
                # since we're checking if each line of the multi-line
                # command are 'accepted' by GDB here,
@@ -706,7 +783,7 @@ proc gdb_test_multiple { command message user_code } {
                    perror "Couldn't send $command to GDB.";
                }
                fail "$message";
-               return $result;
+               return $result
            }
        }
     }
@@ -1131,7 +1208,7 @@ proc gdb_reinitialize_dir { subdir } {
     global gdb_prompt
 
     if [is_remote host] {
-       return "";
+       return ""
     }
     send_gdb "dir\n"
     gdb_expect 60 {
@@ -1203,6 +1280,8 @@ proc default_gdb_exit {} {
 #
 #   debug    file was loaded successfully and has debug information
 #   nodebug  file was loaded successfully and has no debug information
+#   lzma     file was loaded, .gnu_debugdata found, but no LZMA support
+#            compiled in
 #   fail     file was not loaded
 #
 # I tried returning this information as part of the return value,
@@ -1218,6 +1297,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.
@@ -1249,13 +1329,18 @@ proc gdb_file_cmd { arg } {
 
     send_gdb "file $arg\n"
     gdb_expect 120 {
+       -re "Reading symbols from.*LZMA support was disabled.*done.*$gdb_prompt $" {
+           verbose "\t\tLoaded $arg into $GDB; .gnu_debugdata found but no LZMA available"
+           set gdb_file_cmd_debug_info "lzma"
+           return 0
+       }
        -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,9 +1353,13 @@ 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 $" {
@@ -1278,23 +1367,23 @@ proc gdb_file_cmd { arg } {
            return -1
         }
        -re "A problem internal to GDB has been detected" {
-           fail "($arg) GDB internal error"
+           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
         }
     }
@@ -1329,7 +1418,7 @@ proc default_gdb_start { } {
     verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
 
     if [info exists gdb_spawn_id] {
-       return 0;
+       return 0
     }
 
     if ![is_remote host] {
@@ -1341,7 +1430,7 @@ proc default_gdb_start { } {
     set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS [host_info gdb_opts]"];
     if { $res < 0 || $res == "" } {
        perror "Spawning $GDB failed."
-       return 1;
+       return 1
     }
     gdb_expect 360 {
        -re "\[\r\n\]$gdb_prompt $" {
@@ -1379,7 +1468,7 @@ proc default_gdb_start { } {
            warning "Couldn't set the width to 0."
        }
     }
-    return 0;
+    return 0
 }
 
 # Examine the output of compilation to determine whether compilation
@@ -1461,7 +1550,10 @@ proc skip_java_tests {} {
 
 proc skip_python_tests {} {
     global gdb_prompt
-    gdb_test_multiple "python print 'test'" "verify python support" {
+    global gdb_py_is_py3k
+    global gdb_py_is_py24
+
+    gdb_test_multiple "python print ('test')" "verify python support" {
        -re "not supported.*$gdb_prompt $"      {
            unsupported "Python support is disabled."
            return 1
@@ -1469,6 +1561,26 @@ proc skip_python_tests {} {
        -re "$gdb_prompt $"     {}
     }
 
+    set gdb_py_is_py24 0
+    gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" {
+       -re "3.*$gdb_prompt $"  {
+            set gdb_py_is_py3k 1
+        }
+       -re ".*$gdb_prompt $"   {
+            set gdb_py_is_py3k 0
+        }
+    }
+    if { $gdb_py_is_py3k == 0 } {
+        gdb_test_multiple "python print (sys.version_info\[1\])" "check if python 2.4" {
+           -re "\[45\].*$gdb_prompt $" {
+                set gdb_py_is_py24 1
+            }
+           -re ".*$gdb_prompt $" {
+                set gdb_py_is_py24 0
+            }
+        }
+    }
+
     return 0
 }
 
@@ -1985,6 +2097,76 @@ proc skip_vsx_tests {} {
     return $skip_vsx_tests_saved
 }
 
+# Run a test on the target to see if it supports btrace hardware.  Return 0 if so,
+# 1 if it does not.  Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+proc skip_btrace_tests {} {
+    global skip_btrace_tests_saved
+    global srcdir subdir gdb_prompt inferior_exited_re
+
+    # Use the cached value, if it exists.
+    set me "skip_btrace_tests"
+    if [info exists skip_btrace_tests_saved] {
+        verbose "$me:  returning saved $skip_btrace_tests_saved" 2
+        return $skip_btrace_tests_saved
+    }
+
+    if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+        verbose "$me:  target does not support btrace, returning 1" 2
+        return [set skip_btrace_tests_saved 1]
+    }
+
+    # Set up, compile, and execute a test program.
+    # Include the current process ID in the file names to prevent conflicts
+    # with invocations for multiple testsuites.
+    set src [standard_output_file btrace[pid].c]
+    set exe [standard_output_file btrace[pid].x]
+
+    set f [open $src "w"]
+    puts $f "int main(void) { return 0; }"
+    close $f
+
+    verbose "$me:  compiling testfile $src" 2
+    set compile_flags {debug nowarnings quiet}
+    set lines [gdb_compile $src $exe executable $compile_flags]
+
+    if ![string match "" $lines] then {
+        verbose "$me:  testfile compilation failed, returning 1" 2
+       file delete $src
+        return [set skip_btrace_tests_saved 1]
+    }
+
+    # No error message, compilation succeeded so now run it via gdb.
+
+    clean_restart btrace[pid].x
+    if ![runto_main] {
+       file delete $src
+        return [set skip_btrace_tests_saved 1]
+    }
+    file delete $src
+    # In case of an unexpected output, we return 2 as a fail value.
+    set skip_btrace_tests_saved 2
+    gdb_test_multiple "record btrace" "check btrace support" {
+        -re "You can't do that when your target is.*\r\n$gdb_prompt $" {
+            set skip_btrace_tests_saved 1
+        }
+        -re "Target does not support branch tracing.*\r\n$gdb_prompt $" {
+            set skip_btrace_tests_saved 1
+        }
+        -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
+            set skip_btrace_tests_saved 1
+        }
+        -re "^record btrace\r\n$gdb_prompt $" {
+            set skip_btrace_tests_saved 0
+        }
+    }
+    gdb_exit
+    remote_file build delete $exe
+
+    verbose "$me:  returning $skip_btrace_tests_saved" 2
+    return $skip_btrace_tests_saved
+}
+
 # Skip all the tests in the file if you are not on an hppa running
 # hpux target.
 
@@ -2272,7 +2454,7 @@ proc get_compiler_info {{arg ""}} {
       uplevel \#0 { set false false }
     }
 
-    return 0;
+    return 0
 }
 
 proc test_compiler_info { {compiler ""} } {
@@ -2490,7 +2672,7 @@ proc gdb_compile {source dest type options} {
            clone_output "gdb compile failed, $result"
        }
     }
-    return $result;
+    return $result
 }
 
 
@@ -2683,9 +2865,9 @@ proc gdb_compile_objc {source dest type options} {
 proc send_gdb { string } {
     global suppress_flag;
     if { $suppress_flag } {
-       return "suppressed";
+       return "suppressed"
     }
-    return [remote_send host "$string"];
+    return [remote_send host "$string"]
 }
 
 #
@@ -2946,6 +3128,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.
@@ -3053,7 +3265,7 @@ proc gdb_reload { } {
 proc gdb_continue { function } {
     global decimal
 
-    return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"];
+    return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"]
 }
 
 proc default_gdb_init { args } {
@@ -3260,7 +3472,7 @@ proc gdb_init { args } {
     set gdbserver_reconnect_p 1
     unset gdbserver_reconnect_p
 
-    return [eval default_gdb_init $args];
+    return [eval default_gdb_init $args]
 }
 
 proc gdb_finish { } {
@@ -3310,19 +3522,19 @@ proc get_debug_format { } {
        -re "Compiled with (.*) debugging format.\r\n.*$gdb_prompt $" {
            set debug_format $expect_out(1,string)
            verbose "debug format is $debug_format"
-           return 1;
+           return 1
        }
        -re "No current source file.\r\n$gdb_prompt $" {
            perror "get_debug_format used when no current source file"
-           return 0;
+           return 0
        }
        -re "$gdb_prompt $" {
            warning "couldn't check debug format (no valid response)."
-           return 1;
+           return 1
        }
        timeout {
-           warning "couldn't check debug format (timeout)."
-           return 1;
+           warning "couldn't check debug format (timeout)."
+           return 1
        }
     }
 }
@@ -3351,15 +3563,7 @@ proc setup_xfail_format { format } {
     if {$ret} then {
        setup_xfail "*-*-*"
     }
-    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
-    }
+    return $ret
 }
 
 # gdb_get_line_number TEXT [FILE]
@@ -3543,9 +3747,9 @@ proc rerun_to_main {} {
 proc gdb_skip_float_test { msg } {
     if [target_info exists gdb,skip_float_tests] {
        verbose "Skipping test '$msg': no float tests.";
-       return 1;
+       return 1
     }
-    return 0;
+    return 0
 }
 
 # Print a message and return true if a test should be skipped
@@ -3554,13 +3758,13 @@ proc gdb_skip_float_test { msg } {
 proc gdb_skip_stdio_test { msg } {
     if [target_info exists gdb,noinferiorio] {
        verbose "Skipping test '$msg': no inferior i/o.";
-       return 1;
+       return 1
     }
-    return 0;
+    return 0
 }
 
 proc gdb_skip_bogus_test { msg } {
-    return 0;
+    return 0
 }
 
 # Return true if a test should be skipped due to lack of XML support
@@ -3630,7 +3834,7 @@ proc build_id_debug_filename_get { exec } {
     # Convert it to hex.
     binary scan $data H* data
     regsub {^..} $data {\0/} data
-    return ".build-id/${data}.debug";
+    return ".build-id/${data}.debug"
 }
 
 # Create stripped files for DEST, replacing it.  If ARGS is passed, it is a
@@ -3934,7 +4138,7 @@ proc get_remotetimeout { } {
 
     gdb_test_multiple "show remotetimeout" "" {
        -re "Timeout limit to wait for target to respond is ($decimal).*$gdb_prompt $" {
-           return $expect_out(1,string);
+           return $expect_out(1,string)
        }
     }
 
This page took 0.032172 seconds and 4 git commands to generate.