1 # Copyright 2004-2020 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 3 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
16 # Call target_compile with SOURCE DEST TYPE and OPTIONS as argument,
17 # after having temporarily changed the current working directory to
20 proc target_compile_ada_from_dir {builddir source dest type options} {
24 set board [target_info name]
25 set save_multilib_flag [board_info $board multilib_flags]
27 foreach op $save_multilib_flag {
28 if { $op == "-pie" || $op == "-no-pie" } {
29 # Pretend gnatmake supports -pie/-no-pie, route it to
31 append multilib_flag " -largs $op -margs"
33 append multilib_flag " $op"
36 if { $multilib_flag != "" } {
37 unset_board_info "multilib_flags"
38 set_board_info multilib_flags "$multilib_flag"
43 return [target_compile $source $dest $type $options]
47 if { $save_multilib_flag != "" } {
48 unset_board_info "multilib_flags"
49 set_board_info multilib_flags $save_multilib_flag
52 return -options $options $result
55 # Compile some Ada code.
57 proc gdb_compile_ada {source dest type options} {
59 set srcdir [file dirname $source]
60 set gprdir [file dirname $srcdir]
61 set objdir [file dirname $dest]
63 # Although strictly not necessary, we force the recompilation
64 # of all units (additional_flags=-f). This is what is done
65 # when using GCC to build programs in the other languages,
66 # and it avoids using a stray objfile file from a long-past
69 append options " additional_flags=-f"
70 append options " additional_flags=-I$srcdir"
72 set result [target_compile_ada_from_dir \
73 $objdir [file tail $source] $dest $type $options]
75 # The Ada build always produces some output, even when the build
76 # succeeds. Thus, we can not use the output the same way we do in
77 # gdb_compile to determine whether the build has succeeded or not.
78 # We therefore simply check whether the dest file has been created
79 # or not. Unless not present, the build has succeeded.
80 if [file exists $dest] { set result "" }
81 gdb_compile_test $source $result
85 # Like standard_testfile, but for Ada. Historically the Ada tests
86 # used a different naming convention from many of the other gdb tests,
87 # and this difference was preserved during the conversion to
88 # standard_testfile. DIR defaults to the base name of the test case;
89 # but can be overridden to find sources in a different subdirectory of
92 proc standard_ada_testfile {base_file {dir ""}} {
93 global gdb_test_file_name srcdir subdir
94 global testdir testfile srcfile binfile
97 set testdir $gdb_test_file_name
102 set testfile $base_file
103 set srcfile $srcdir/$subdir/$testdir/$testfile.adb
104 set binfile [standard_output_file $testfile]
107 # A helper function to find the appropriate version of a tool.
108 # TOOL is the tool's name, e.g., "gnatbind" or "gnatlink".
110 proc find_ada_tool {tool} {
111 set upper [string toupper $tool]
113 set targname ${upper}_FOR_TARGET
115 if {[info exists $targname]} {
120 set root "$tool_root_dir/gcc"
123 if {![is_remote host]} {
124 set result [lookfor_file $root $tool]
128 set result [transform $tool]
134 # Return 1 if gnatmake is at least version $MAJOR.x.x
136 proc gnatmake_version_at_least { major } {
137 set gnatmake [gdb_find_gnatmake]
138 set gnatmake [lindex [split $gnatmake] 0]
139 if {[catch {exec $gnatmake --version} output]} {
142 if { [regexp {GNATMAKE ([^ .]+).([^ .]+).([^ .]+)} $output \
143 match gnatmake_major gnatmake_minor gnatmake_micro] } {
144 if { $gnatmake_major >= $major } {
155 # Return 1 if the GNAT runtime appears to have debug info.
157 gdb_caching_proc gnat_runtime_has_debug_info {
160 set src "$srcdir/lib/gnat_debug_info_test.adb"
161 set dst [standard_output_file "gnat_debug_info_test"]
163 if { [gdb_compile_ada $src $dst executable {debug}] != "" } {
164 fail "failed to compile gnat-debug-info test binary"
170 if { ! [runto "GNAT_Debug_Info_Test"] } {
171 fail "failed to run to GNAT_Debug_Info_Test"
177 gdb_test_multiple "whatis __gnat_debug_raise_exception" "" {
178 -re "type = <text variable, no debug info>" { }
183 # Some other unexpected output...
188 return $has_debug_info