[gdb/testsuite] Remove stale exec in gdb_compile_ada

[binutils-gdb.git] / gdb / testsuite / lib / ada.exp

diff --git a/gdb/testsuite/lib/ada.exp b/gdb/testsuite/lib/ada.exp
index 4d1c3fe0f3b6e3ceb65caf2b1ba11796520a1bdf..9933cc951e3755b42d606991272a32747e3ddfa2 100644 (file)
--- a/gdb/testsuite/lib/ada.exp
+++ b/gdb/testsuite/lib/ada.exp
@@ -1,4 +1,4 @@
-# Copyright 2004-2017 Free Software Foundation, Inc.
+# Copyright 2004-2020 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
@@ -19,11 +19,36 @@
 
 proc target_compile_ada_from_dir {builddir source dest type options} {
     set saved_cwd [pwd]
+
+    global board
+    set board [target_info name]
+    set save_multilib_flag [board_info $board multilib_flags]
+    set multilib_flag ""
+    foreach op $save_multilib_flag {
+       if { $op == "-pie" || $op == "-no-pie" } {
+           # Pretend gnatmake supports -pie/-no-pie, route it to
+           # linker.
+           append multilib_flag " -largs $op -margs"
+       } else {
+           append multilib_flag " $op"
+       }
+    }
+    if { $multilib_flag != "" } {
+       unset_board_info "multilib_flags"
+       set_board_info multilib_flags "$multilib_flag"
+    }
+
     catch {
         cd $builddir
         return [target_compile $source $dest $type $options]
     } result options
     cd $saved_cwd
+
+    if { $save_multilib_flag != "" } {
+       unset_board_info "multilib_flags"
+       set_board_info multilib_flags $save_multilib_flag
+    }
+
     return -options $options $result
 }
 
@@ -35,6 +60,8 @@ proc gdb_compile_ada {source dest type options} {
     set gprdir [file dirname $srcdir]
     set objdir [file dirname $dest]
 
+    file delete $dest
+
     # Although strictly not necessary, we force the recompilation
     # of all units (additional_flags=-f).  This is what is done
     # when using GCC to build programs in the other languages,
@@ -78,3 +105,87 @@ proc standard_ada_testfile {base_file {dir ""}} {
     set srcfile $srcdir/$subdir/$testdir/$testfile.adb
     set binfile [standard_output_file $testfile]
 }
+
+# A helper function to find the appropriate version of a tool.
+# TOOL is the tool's name, e.g., "gnatbind" or "gnatlink".
+
+proc find_ada_tool {tool} {
+    set upper [string toupper $tool]
+
+    set targname ${upper}_FOR_TARGET
+    global $targname
+    if {[info exists $targname]} {
+       return $targname
+    }
+
+    global tool_root_dir
+    set root "$tool_root_dir/gcc"
+    set result ""
+
+    if {![is_remote host]} {
+        set result [lookfor_file $root $tool]
+    }
+
+    if {$result == ""} {
+        set result [transform $tool]
+    }
+
+    return $result
+}
+
+# Return 1 if gnatmake is at least version $MAJOR.x.x
+
+proc gnatmake_version_at_least { major } {
+    set gnatmake [gdb_find_gnatmake]
+    set gnatmake [lindex [split $gnatmake] 0]
+    if {[catch {exec $gnatmake --version} output]} {
+       return 0
+    }
+    if { [regexp {GNATMAKE ([^ .]+).([^ .]+).([^ .]+)} $output \
+             match gnatmake_major gnatmake_minor gnatmake_micro] } {
+       if { $gnatmake_major >= $major } {
+           return 1
+       } else {
+           return 0
+       }
+    }
+
+    # Unknown, return 1
+    return 1
+}
+
+# Return 1 if the GNAT runtime appears to have debug info.
+
+gdb_caching_proc gnat_runtime_has_debug_info {
+    global srcdir
+
+    set src "$srcdir/lib/gnat_debug_info_test.adb"
+    set dst [standard_output_file "gnat_debug_info_test"]
+
+    if { [gdb_compile_ada $src $dst executable {debug}] != "" } {
+       fail "failed to compile gnat-debug-info test binary"
+       return 0
+    }
+
+    clean_restart $dst
+
+    if { ! [runto "GNAT_Debug_Info_Test"] } {
+       fail "failed to run to GNAT_Debug_Info_Test"
+       return 0
+    }
+
+    set has_debug_info 0
+
+    gdb_test_multiple "whatis __gnat_debug_raise_exception" "" {
+       -re "type = <text variable, no debug info>" { }
+       -re "type = void" {
+           set has_debug_info 1
+       }
+       default {
+           # Some other unexpected output...
+           fail $gdb_test_name
+       }
+    }
+
+    return $has_debug_info
+}