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. Return "" if the compile was successful.
57 proc gdb_compile_ada_1 {source dest type options} {
59 set srcdir [file dirname $source]
60 set gprdir [file dirname $srcdir]
61 set objdir [file dirname $dest]
65 # Although strictly not necessary, we force the recompilation
66 # of all units (additional_flags=-f). This is what is done
67 # when using GCC to build programs in the other languages,
68 # and it avoids using a stray objfile file from a long-past
71 append options " additional_flags=-f"
72 append options " additional_flags=-I$srcdir"
74 set result [target_compile_ada_from_dir \
75 $objdir [file tail $source] $dest $type $options]
77 # The Ada build always produces some output, even when the build
78 # succeeds. Thus, we can not use the output the same way we do in
79 # gdb_compile to determine whether the build has succeeded or not.
80 # We therefore simply check whether the dest file has been created
81 # or not. Unless not present, the build has succeeded.
82 if [file exists $dest] { set result "" }
86 # Compile some Ada code. Generate "PASS: foo.exp: compilation SOURCE" if the
87 # compile was successful.
89 proc gdb_compile_ada {source dest type options} {
90 set result [gdb_compile_ada_1 $source $dest $type $options]
92 gdb_compile_test $source $result
96 # Like standard_testfile, but for Ada. Historically the Ada tests
97 # used a different naming convention from many of the other gdb tests,
98 # and this difference was preserved during the conversion to
99 # standard_testfile. DIR defaults to the base name of the test case;
100 # but can be overridden to find sources in a different subdirectory of
103 proc standard_ada_testfile {base_file {dir ""}} {
104 global gdb_test_file_name srcdir subdir
105 global testdir testfile srcfile binfile
108 set testdir $gdb_test_file_name
113 set testfile $base_file
114 set srcfile $srcdir/$subdir/$testdir/$testfile.adb
115 set binfile [standard_output_file $testfile]
118 # A helper function to find the appropriate version of a tool.
119 # TOOL is the tool's name, e.g., "gnatbind" or "gnatlink".
121 proc find_ada_tool {tool} {
122 set upper [string toupper $tool]
124 set targname ${upper}_FOR_TARGET
126 if {[info exists $targname]} {
131 set root "$tool_root_dir/gcc"
134 if {![is_remote host]} {
135 set result [lookfor_file $root $tool]
136 if { $result != "" && $tool == "gnatlink" } {
137 set result "$result --GCC=$root/xgcc -B$root"
142 set result [transform $tool]
148 # Return 1 if gnatmake is at least version $MAJOR.x.x
150 proc gnatmake_version_at_least { major } {
151 set gnatmake [gdb_find_gnatmake]
152 set gnatmake [lindex [split $gnatmake] 0]
153 if {[catch {exec $gnatmake --version} output]} {
156 if { [regexp {GNATMAKE ([^ .]+).([^ .]+).([^ .]+)} $output \
157 match gnatmake_major gnatmake_minor gnatmake_micro] } {
158 if { $gnatmake_major >= $major } {
169 # Return 1 if the GNAT runtime appears to have debug info.
171 gdb_caching_proc gnat_runtime_has_debug_info {
174 set src "$srcdir/lib/gnat_debug_info_test.adb"
175 set dst [standard_output_file "gnat_debug_info_test"]
177 if { [gdb_compile_ada_1 $src $dst executable {debug}] != "" } {
183 if { ! [runto "GNAT_Debug_Info_Test"] } {
184 fail "failed to run to GNAT_Debug_Info_Test"
190 gdb_test_multiple "whatis __gnat_debug_raise_exception" "" {
191 -re "type = <text variable, no debug info>" { }
196 # Some other unexpected output...
201 return $has_debug_info