Add gdb.dlang to the gdb testsuite for the purpose of creating D
[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp
index ceaaa4150f6a7135ea2b8c32c1f27ba9c2d137ce..37164728a102b07aedbd29b1c44d04e9ea6b4b1b 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright 1992-2013 Free Software Foundation, Inc.
+# Copyright 1992-2014 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
@@ -112,6 +112,12 @@ proc default_gdb_version {} {
     global GDB
     global INTERNAL_GDBFLAGS GDBFLAGS
     global gdb_prompt
+    global inotify_pid
+
+    if {[info exists inotify_pid]} {
+       eval exec kill $inotify_pid
+    }
+
     set output [remote_exec host "$GDB $INTERNAL_GDBFLAGS --version"]
     set tmp [lindex $output 1]
     set version ""
@@ -1246,6 +1252,7 @@ proc default_gdb_exit {} {
     global INTERNAL_GDBFLAGS GDBFLAGS
     global verbose
     global gdb_spawn_id
+    global inotify_log_file
 
     gdb_stop_suppressing_tests
 
@@ -1255,6 +1262,20 @@ proc default_gdb_exit {} {
 
     verbose "Quitting $GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
 
+    if {[info exists inotify_log_file] && [file exists $inotify_log_file]} {
+       set fd [open $inotify_log_file]
+       set data [read -nonewline $fd]
+       close $fd
+
+       if {[string compare $data ""] != 0} {
+           warning "parallel-unsafe file creations noticed"
+
+           # Clear the log.
+           set fd [open $inotify_log_file w]
+           close $fd
+       }
+    }
+
     if { [is_remote host] && [board_info host exists fileid] } {
        send_gdb "quit\n"
        gdb_expect 10 {
@@ -1547,6 +1568,12 @@ proc skip_java_tests {} {
     return 0
 }
 
+# Return a 1 if I don't even want to try to test D.
+
+proc skip_d_tests {} {
+    return 0
+}
+
 # Return a 1 for configurations that do not support Python scripting.
 
 proc skip_python_tests {} {
@@ -1695,6 +1722,32 @@ proc with_test_prefix { prefix body } {
   }
 }
 
+# Run tests in BODY with GDB prompt and variable $gdb_prompt set to
+# PROMPT.  When BODY is finished, restore GDB prompt and variable
+# $gdb_prompt.
+# Returns the result of BODY.
+
+proc with_gdb_prompt { prompt body } {
+    global gdb_prompt
+
+    set saved $gdb_prompt
+
+    set gdb_prompt $prompt
+    gdb_test_no_output "set prompt $prompt " ""
+
+    set code [catch {uplevel 1 $body} result]
+
+    set gdb_prompt $saved
+    gdb_test_no_output "set prompt $saved " ""
+
+    if {$code == 1} {
+       global errorInfo errorCode
+       return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+    } else {
+       return -code $code $result
+    }
+}
+
 # Return 1 if _Complex types are supported, otherwise, return 0.
 
 gdb_caching_proc support_complex_tests {
@@ -1704,13 +1757,14 @@ gdb_caching_proc support_complex_tests {
     set src [standard_temp_file complex[pid].c]
     set exe [standard_temp_file complex[pid].x]
 
-    set f [open $src "w"]
-    puts $f "int main() {"
-    puts $f "_Complex float cf;"
-    puts $f "_Complex double cd;"
-    puts $f "_Complex long double cld;"
-    puts $f "  return 0; }"
-    close $f
+    gdb_produce_source $src {
+       int main() {
+           _Complex float cf;
+           _Complex double cd;
+           _Complex long double cld;
+           return 0;
+       }
+    }
 
     verbose "compiling testfile $src" 2
     set compile_flags {debug nowarnings quiet}
@@ -1753,7 +1807,8 @@ proc supports_process_record {} {
        return [target_info gdb,use_precord]
     }
 
-    if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+    if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
+         || [istarget "i\[34567\]86-*-linux*"] } {
        return 1
     }
 
@@ -1768,13 +1823,63 @@ proc supports_reverse {} {
        return [target_info gdb,can_reverse]
     }
 
-    if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+    if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
+         || [istarget "i\[34567\]86-*-linux*"] } {
        return 1
     }
 
     return 0
 }
 
+# Return 1 if target is ELF.
+gdb_caching_proc is_elf_target {
+    set me "is_elf_target"
+
+    set src [standard_temp_file is_elf_target[pid].c]
+    set obj [standard_temp_file is_elf_target[pid].o]
+
+    gdb_produce_source $src {
+       int foo () {return 0;}
+    }
+
+    verbose "$me:  compiling testfile $src" 2
+    set lines [gdb_compile $src $obj object {quiet}]
+
+    file delete $src
+
+    if ![string match "" $lines] then {
+       verbose "$me:  testfile compilation failed, returning 0" 2
+       return 0
+    }
+
+    set fp_obj [open $obj "r"]
+    fconfigure $fp_obj -translation binary
+    set data [read $fp_obj]
+    close $fp_obj
+
+    file delete $obj
+
+    set ELFMAG "\u007FELF"
+
+    if {[string compare -length 4 $data $ELFMAG] != 0} {
+       verbose "$me:  returning 0" 2
+       return 0
+    }
+
+    verbose "$me:  returning 1" 2
+    return 1
+}
+
+# Produce source file NAME and write SOURCES into it.
+
+proc gdb_produce_source { name sources } {
+    set index 0
+    set f [open $name "w"]
+
+    puts $f $sources
+    close $f
+}
+
 # Return 1 if target is ILP32.
 # This cannot be decided simply from looking at the target string,
 # as it might depend on externally passed compiler options like -m64.
@@ -1784,11 +1889,11 @@ gdb_caching_proc is_ilp32_target {
     set src [standard_temp_file ilp32[pid].c]
     set obj [standard_temp_file ilp32[pid].o]
 
-    set f [open $src "w"]
-    puts $f "int dummy\[sizeof (int) == 4"
-    puts $f "           && sizeof (void *) == 4"
-    puts $f "           && sizeof (long) == 4 ? 1 : -1\];"
-    close $f
+    gdb_produce_source $src {
+       int dummy[sizeof (int) == 4
+                 && sizeof (void *) == 4
+                 && sizeof (long) == 4 ? 1 : -1];
+    }
 
     verbose "$me:  compiling testfile $src" 2
     set lines [gdb_compile $src $obj object {quiet}]
@@ -1813,11 +1918,39 @@ gdb_caching_proc is_lp64_target {
     set src [standard_temp_file lp64[pid].c]
     set obj [standard_temp_file lp64[pid].o]
 
-    set f [open $src "w"]
-    puts $f "int dummy\[sizeof (int) == 4"
-    puts $f "           && sizeof (void *) == 8"
-    puts $f "           && sizeof (long) == 8 ? 1 : -1\];"
-    close $f
+    gdb_produce_source $src {
+       int dummy[sizeof (int) == 4
+                 && sizeof (void *) == 8
+                 && sizeof (long) == 8 ? 1 : -1];
+    }
+
+    verbose "$me:  compiling testfile $src" 2
+    set lines [gdb_compile $src $obj object {quiet}]
+    file delete $src
+    file delete $obj
+
+    if ![string match "" $lines] then {
+        verbose "$me:  testfile compilation failed, returning 0" 2
+        return 0
+    }
+
+    verbose "$me:  returning 1" 2
+    return 1
+}
+
+# Return 1 if target has 64 bit addresses.
+# This cannot be decided simply from looking at the target string,
+# as it might depend on externally passed compiler options like -m64.
+gdb_caching_proc is_64_target {
+    set me "is_64_target"
+
+    set src [standard_temp_file is64[pid].c]
+    set obj [standard_temp_file is64[pid].o]
+
+    gdb_produce_source $src {
+       int function(void) { return 3; }
+       int dummy[sizeof (&function) == 8 ? 1 : -1];
+    }
 
     verbose "$me:  compiling testfile $src" 2
     set lines [gdb_compile $src $obj object {quiet}]
@@ -1846,12 +1979,12 @@ gdb_caching_proc is_amd64_regs_target {
     set src [standard_temp_file reg64[pid].s]
     set obj [standard_temp_file reg64[pid].o]
 
-    set f [open $src "w"]
+    set list {}
     foreach reg \
-            {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
-       puts $f "\tincq %$reg"
-    }
-    close $f
+       {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
+           lappend list "\tincq %$reg"
+       }
+    gdb_produce_source $src [join $list \n]
 
     verbose "$me:  compiling testfile $src" 2
     set lines [gdb_compile $src $obj object {quiet}]
@@ -1922,15 +2055,16 @@ gdb_caching_proc skip_altivec_tests {
     set src [standard_temp_file vmx[pid].c]
     set exe [standard_temp_file vmx[pid].x]
 
-    set f [open $src "w"]
-    puts $f "int main() {"
-    puts $f "#ifdef __MACH__"
-    puts $f "  asm volatile (\"vor v0,v0,v0\");"
-    puts $f "#else"
-    puts $f "  asm volatile (\"vor 0,0,0\");"
-    puts $f "#endif"
-    puts $f "  return 0; }"
-    close $f
+    gdb_produce_source $src {
+       int main() {
+           #ifdef __MACH__
+           asm volatile ("vor v0,v0,v0");
+           #else
+           asm volatile ("vor 0,0,0");
+           #endif
+           return 0;
+       }
+    }
 
     verbose "$me:  compiling testfile $src" 2
     set lines [gdb_compile $src $exe executable $compile_flags]
@@ -2002,16 +2136,17 @@ gdb_caching_proc skip_vsx_tests {
     set src [standard_temp_file vsx[pid].c]
     set exe [standard_temp_file vsx[pid].x]
 
-    set f [open $src "w"]
-    puts $f "int main() {"
-    puts $f "  double a\[2\] = { 1.0, 2.0 };"
-    puts $f "#ifdef __MACH__"
-    puts $f "  asm volatile (\"lxvd2x v0,v0,%\[addr\]\" : : \[addr\] \"r\" (a));"
-    puts $f "#else"
-    puts $f "  asm volatile (\"lxvd2x 0,0,%\[addr\]\" : : \[addr\] \"r\" (a));"
-    puts $f "#endif"
-    puts $f "  return 0; }"
-    close $f
+    gdb_produce_source $src {
+       int main() {
+           double a[2] = { 1.0, 2.0 };
+           #ifdef __MACH__
+           asm volatile ("lxvd2x v0,v0,%[addr]" : : [addr] "r" (a));
+           #else
+           asm volatile ("lxvd2x 0,0,%[addr]" : : [addr] "r" (a));
+           #endif
+           return 0;
+       }
+    }
 
     verbose "$me:  compiling testfile $src" 2
     set lines [gdb_compile $src $exe executable $compile_flags]
@@ -2053,31 +2188,24 @@ gdb_caching_proc skip_vsx_tests {
 # 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
+gdb_caching_proc skip_btrace_tests {
     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]
+        return 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 src [standard_temp_file btrace[pid].c]
+    set exe [standard_temp_file btrace[pid].x]
 
-    set f [open $src "w"]
-    puts $f "int main(void) { return 0; }"
-    close $f
+    gdb_produce_source $src {
+       int main(void) { return 0; }
+    }
 
     verbose "$me:  compiling testfile $src" 2
     set compile_flags {debug nowarnings quiet}
@@ -2086,38 +2214,41 @@ proc skip_btrace_tests {} {
     if ![string match "" $lines] then {
         verbose "$me:  testfile compilation failed, returning 1" 2
        file delete $src
-        return [set skip_btrace_tests_saved 1]
+        return 1
     }
 
     # No error message, compilation succeeded so now run it via gdb.
 
-    clean_restart btrace[pid].x
+    gdb_exit
+    gdb_start
+    gdb_reinitialize_dir $srcdir/$subdir
+    gdb_load $exe
     if ![runto_main] {
        file delete $src
-        return [set skip_btrace_tests_saved 1]
+        return 1
     }
     file delete $src
     # In case of an unexpected output, we return 2 as a fail value.
-    set skip_btrace_tests_saved 2
+    set skip_btrace_tests 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
+            set skip_btrace_tests 1
         }
         -re "Target does not support branch tracing.*\r\n$gdb_prompt $" {
-            set skip_btrace_tests_saved 1
+            set skip_btrace_tests 1
         }
         -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
-            set skip_btrace_tests_saved 1
+            set skip_btrace_tests 1
         }
         -re "^record btrace\r\n$gdb_prompt $" {
-            set skip_btrace_tests_saved 0
+            set skip_btrace_tests 0
         }
     }
     gdb_exit
     remote_file build delete $exe
 
-    verbose "$me:  returning $skip_btrace_tests_saved" 2
-    return $skip_btrace_tests_saved
+    verbose "$me:  returning $skip_btrace_tests" 2
+    return $skip_btrace_tests
 }
 
 # Skip all the tests in the file if you are not on an hppa running
@@ -2361,6 +2492,7 @@ proc get_compiler_info {{arg ""}} {
 
     # Run $ifile through the right preprocessor.
     # Toggle gdb.log to keep the compiler output out of the log.
+    set saved_log [log_file -info]
     log_file
     if [is_remote host] {
        # We have to use -E and -o together, despite the comments
@@ -2373,7 +2505,7 @@ proc get_compiler_info {{arg ""}} {
     } else {
        set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ]
     }
-    log_file -a "$outdir/$tool.log" 
+    eval log_file $saved_log
 
     # Eval the output.
     set unknown 0
@@ -2685,12 +2817,19 @@ proc gdb_compile_pthreads {source dest type options} {
     }
 }
 
-# Build a shared library from SOURCES.  You must use get_compiler_info
-# first.
+# Build a shared library from SOURCES.
 
 proc gdb_compile_shlib {sources dest options} {
     set obj_options $options
 
+    set info_options ""
+    if { [lsearch -exact $options "c++"] >= 0 } {
+       set info_options "c++"
+    }
+    if [get_compiler_info ${info_options}] {
+       return -1
+    }
+
     switch -glob [test_compiler_info] {
         "xlc-*" {
             lappend obj_options "additional_flags=-qpic"
@@ -3138,7 +3277,7 @@ proc gdb_gcore_cmd {core test} {
            verbose -log "'gcore' command undefined in gdb_gcore_cmd"
        }
 
-       -re "Can't create a corefile\[\r\n\]+$gdb_prompt $" {
+       -re "(?:Can't create a corefile|Target does not support core file generation\\.)\[\r\n\]+$gdb_prompt $" {
            unsupported $test
        }
     }
@@ -3156,32 +3295,32 @@ proc gdb_gcore_cmd {core test} {
 proc gdb_core_cmd { core test } {
     global gdb_prompt
 
-    gdb_test_multiple "core $core" "re-load generated corefile" {
+    gdb_test_multiple "core $core" "$test" {
        -re "\\\[Thread debugging using \[^ \r\n\]* enabled\\\]\r\n" {
            exp_continue
        }
        -re " is not a core dump:.*\r\n$gdb_prompt $" {
-           fail "re-load generated corefile (bad file format)"
+           fail "$test (bad file format)"
            return -1
        }
        -re ": No such file or directory.*\r\n$gdb_prompt $" {
-           fail "re-load generated corefile (file not found)"
+           fail "$test (file not found)"
            return -1
        }
        -re "Couldn't find .* registers in core file.*\r\n$gdb_prompt $" {
-           fail "re-load generated corefile (incomplete note section)"
+           fail "$test (incomplete note section)"
            return 0
        }
        -re "Core was generated by .*\r\n$gdb_prompt $" {
-           pass "re-load generated corefile"
+           pass "$test"
            return 1
        }
        -re ".*$gdb_prompt $" {
-           fail "re-load generated corefile"
+           fail "$test"
            return -1
        }
        timeout {
-           fail "re-load generated corefile (timeout)"
+           fail "$test (timeout)"
            return -1
        }
     }
@@ -3242,6 +3381,23 @@ proc gdb_touch_execfile { binfile } {
     }
 }
 
+# Like remote_download but provides a gdb-specific behavior.  If DEST
+# is "host", and the host is not remote, and TOFILE is not specified,
+# then the [file tail] of FROMFILE is passed through
+# standard_output_file to compute the destination.
+
+proc gdb_remote_download {dest fromfile {tofile {}}} {
+    if {$dest == "host" && ![is_remote host] && $tofile == ""} {
+       set tofile [standard_output_file [file tail $fromfile]]
+    }
+
+    if { $tofile == "" } {
+       return [remote_download $dest $fromfile]
+    } else {
+       return [remote_download $dest $fromfile $tofile]
+    }
+}
+
 # gdb_download
 #
 # Copy a file to the remote target and return its target filename.
@@ -3349,15 +3505,27 @@ proc default_gdb_init { args } {
 # the directory is returned.
 
 proc standard_output_file {basename} {
-    global objdir subdir
+    global objdir subdir gdb_test_file_name GDB_PARALLEL
 
-    return [file join $objdir $subdir $basename]
+    if {[info exists GDB_PARALLEL]} {
+       set dir [file join $objdir outputs $subdir $gdb_test_file_name]
+       file mkdir $dir
+       return [file join $dir $basename]
+    } else {
+       return [file join $objdir $subdir $basename]
+    }
 }
 
 # Return the name of a file in our standard temporary directory.
 
 proc standard_temp_file {basename} {
-    return $basename
+    global objdir GDB_PARALLEL
+
+    if {[info exists GDB_PARALLEL]} {
+       return [file join $objdir temp $basename]
+    } else {
+       return $basename
+    }
 }
 
 # Set 'testfile', 'srcfile', and 'binfile'.
@@ -3463,6 +3631,31 @@ proc gdb_init { args } {
     global timeout
     set timeout $gdb_test_timeout
 
+    # If GDB_INOTIFY is given, check for writes to '.'.  This is a
+    # debugging tool to help confirm that the test suite is
+    # parallel-safe.  You need "inotifywait" from the
+    # inotify-tools package to use this.
+    global GDB_INOTIFY inotify_pid
+    if {[info exists GDB_INOTIFY] && ![info exists inotify_pid]} {
+       global outdir tool inotify_log_file
+
+       set exclusions {outputs temp gdb[.](log|sum) cache}
+       set exclusion_re ([join $exclusions |])
+
+       set inotify_log_file [standard_temp_file inotify.out]
+       set inotify_pid [exec inotifywait -r -m -e move,create,delete . \
+                            --exclude $exclusion_re \
+                            |& tee -a $outdir/$tool.log $inotify_log_file &]
+
+       # Wait for the watches; hopefully this is long enough.
+       sleep 2
+
+       # Clear the log so that we don't emit a warning the first time
+       # we check it.
+       set fd [open $inotify_log_file w]
+       close $fd
+    }
+
     # Block writes to all banned variables, and invocation of all
     # banned procedures...
     global banned_variables
@@ -3500,7 +3693,7 @@ proc gdb_init { args } {
     setenv TERM "vt100"
 
     # Some tests (for example gdb.base/maint.exp) shell out from gdb to use
-    # grep.  Clear GREP_OPTIONS to make the behavoiur predictable, 
+    # grep.  Clear GREP_OPTIONS to make the behavior predictable,
     # especially having color output turned on can cause tests to fail.
     setenv GREP_OPTIONS ""
 
@@ -3513,8 +3706,23 @@ proc gdb_init { args } {
 }
 
 proc gdb_finish { } {
+    global gdbserver_reconnect_p
+    global gdb_prompt
     global cleanfiles
 
+    # Give persistent gdbserver a chance to terminate before GDB is killed.
+    if {[info exists gdbserver_reconnect_p] && $gdbserver_reconnect_p} {
+       send_gdb "kill\n";
+       gdb_expect 10 {
+           -re "y or n" {
+               send_gdb "y\n";
+               exp_continue;
+           }
+           -re "$gdb_prompt $" {
+           }
+       }
+    }
+
     # Exit first, so that the files are no longer in use.
     gdb_exit
 
@@ -3707,11 +3915,8 @@ proc gdb_get_line_number { text { file "" } } {
     return $found
 }
 
-# gdb_continue_to_end:
-#      The case where the target uses stubs has to be handled specially. If a
-#       stub is used, we set a breakpoint at exit because we cannot rely on
-#       exit() behavior of a remote target.
-# 
+# Continue the program until it ends.
+#
 # MSSG is the error message that gets printed.  If not given, a
 #      default is used.
 # COMMAND is the command to invoke.  If not given, "continue" is
@@ -3734,7 +3939,19 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} {
   } else {
       set extra ""
   }
-  if $use_gdb_stub {
+
+  # By default, we don't rely on exit() behavior of remote stubs --
+  # it's common for exit() to be implemented as a simple infinite
+  # loop, or a forced crash/reset.  For native targets, by default, we
+  # assume process exit is reported as such.  If a non-reliable target
+  # is used, we set a breakpoint at exit, and continue to that.
+  if { [target_info exists exit_is_reliable] } {
+      set exit_is_reliable [target_info exit_is_reliable]
+  } else {
+      set exit_is_reliable [expr ! $use_gdb_stub]
+  }
+
+  if { ! $exit_is_reliable } {
     if {![gdb_breakpoint "exit"]} {
       return 0
     }
@@ -3845,7 +4062,7 @@ gdb_caching_proc gdb_skip_xml_test {
 # Return "" if no build-id found.
 proc build_id_debug_filename_get { exec } {
     set tmp [standard_output_file "${exec}-tmp"]
-    set objcopy_program [transform objcopy]
+    set objcopy_program [gdb_find_objcopy]
 
     set result [catch "exec $objcopy_program -j .note.gnu.build-id -O binary $exec $tmp" output]
     verbose "result is $result"
@@ -3883,7 +4100,7 @@ proc gdb_gnu_strip_debug { dest args } {
     set debug_file "${dest}.debug"
 
     set strip_to_file_program [transform strip]
-    set objcopy_program [transform objcopy]
+    set objcopy_program [gdb_find_objcopy]
 
     set debug_link [file tail $debug_file]
     set stripped_file "${dest}.stripped"
@@ -4030,8 +4247,6 @@ proc build_executable_from_specs {testname executable options args} {
         return -1
     }
 
-    set binfile [standard_output_file $executable]
-
     set func gdb_compile
     set func_index [lsearch -regexp $options {^(pthreads|shlib|shlib_pthreads)$}]
     if {$func_index != -1} {
@@ -4211,6 +4426,25 @@ proc set_remotetimeout { timeout } {
     }
 }
 
+# ROOT and FULL are file names.  Returns the relative path from ROOT
+# to FULL.  Note that FULL must be in a subdirectory of ROOT.
+# For example, given ROOT = /usr/bin and FULL = /usr/bin/ls, this
+# will return "ls".
+
+proc relative_filename {root full} {
+    set root_split [file split $root]
+    set full_split [file split $full]
+
+    set len [llength $root_split]
+
+    if {[eval file join $root_split]
+       != [eval file join [lrange $full_split 0 [expr {$len - 1}]]]} {
+       error "$full not a subdir of $root"
+    }
+
+    return [eval file join [lrange $full_split $len end]]
+}
+
 # Log gdb command line and script if requested.
 if {[info exists TRANSCRIPT]} {
   rename send_gdb real_send_gdb
@@ -4258,6 +4492,15 @@ if {[info exists TRANSCRIPT]} {
   }
 }
 
+# If GDB_PARALLEL exists, then set up the parallel-mode directories.
+if {[info exists GDB_PARALLEL]} {
+    if {[is_remote host]} {
+       unset GDB_PARALLEL
+    } else {
+       file mkdir outputs temp cache
+    }
+}
+
 proc core_find {binfile {deletefiles {}} {arg ""}} {
     global objdir subdir
 
@@ -4340,5 +4583,40 @@ proc gdb_target_symbol_prefix_flags {} {
     }
 }
 
+# A wrapper for 'remote_exec host' that passes or fails a test.
+# Returns 0 if all went well, nonzero on failure.
+# TEST is the name of the test, other arguments are as for remote_exec.
+
+proc run_on_host { test program args } {
+    verbose -log "run_on_host: $program $args"
+    # remote_exec doesn't work properly if the output is set but the
+    # input is the empty string -- so replace an empty input with
+    # /dev/null.
+    if {[llength $args] > 1 && [lindex $args 1] == ""} {
+       set args [lreplace $args 1 1 "/dev/null"]
+    }
+    set result [eval remote_exec host [list $program] $args]
+    verbose "result is $result"
+    set status [lindex $result 0]
+    set output [lindex $result 1]
+    if {$status == 0} {
+       pass $test
+       return 0
+    } else {
+       fail $test
+       return -1
+    }
+}
+
+# Return non-zero if "board_info debug_flags" mentions Fission.
+# http://gcc.gnu.org/wiki/DebugFission
+# Fission doesn't support everything yet.
+# This supports working around bug 15954.
+
+proc using_fission { } {
+    set debug_flags [board_info [target_info name] debug_flags]
+    return [regexp -- "-gsplit-dwarf" $debug_flags]
+}
+
 # Always load compatibility stuff.
 load_lib future.exp
This page took 0.035797 seconds and 4 git commands to generate.