Commit | Line | Data |
---|---|---|
b811d2c2 | 1 | # Copyright 2004-2020 Free Software Foundation, Inc. |
d40d2c92 JB |
2 | # |
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 | |
e22f8b7c | 5 | # the Free Software Foundation; either version 3 of the License, or |
d40d2c92 | 6 | # (at your option) any later version. |
e22f8b7c | 7 | # |
d40d2c92 JB |
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. | |
e22f8b7c | 12 | # |
d40d2c92 | 13 | # You should have received a copy of the GNU General Public License |
e22f8b7c | 14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
d40d2c92 | 15 | |
ab8314b3 JB |
16 | # Call target_compile with SOURCE DEST TYPE and OPTIONS as argument, |
17 | # after having temporarily changed the current working directory to | |
18 | # BUILDDIR. | |
19 | ||
20 | proc target_compile_ada_from_dir {builddir source dest type options} { | |
21 | set saved_cwd [pwd] | |
abcf2cc8 TV |
22 | |
23 | global board | |
24 | set board [target_info name] | |
25 | set save_multilib_flag [board_info $board multilib_flags] | |
26 | set multilib_flag "" | |
27 | foreach op $save_multilib_flag { | |
28 | if { $op == "-pie" || $op == "-no-pie" } { | |
29 | # Pretend gnatmake supports -pie/-no-pie, route it to | |
30 | # linker. | |
31 | append multilib_flag " -largs $op -margs" | |
32 | } else { | |
33 | append multilib_flag " $op" | |
34 | } | |
35 | } | |
36 | if { $multilib_flag != "" } { | |
37 | unset_board_info "multilib_flags" | |
38 | set_board_info multilib_flags "$multilib_flag" | |
39 | } | |
40 | ||
ab8314b3 JB |
41 | catch { |
42 | cd $builddir | |
43 | return [target_compile $source $dest $type $options] | |
44 | } result options | |
45 | cd $saved_cwd | |
abcf2cc8 TV |
46 | |
47 | if { $save_multilib_flag != "" } { | |
48 | unset_board_info "multilib_flags" | |
49 | set_board_info multilib_flags $save_multilib_flag | |
50 | } | |
51 | ||
ab8314b3 JB |
52 | return -options $options $result |
53 | } | |
54 | ||
d4295de4 | 55 | # Compile some Ada code. Return "" if the compile was successful. |
034cb681 | 56 | |
d4295de4 | 57 | proc gdb_compile_ada_1 {source dest type options} { |
034cb681 | 58 | |
464dd14d JB |
59 | set srcdir [file dirname $source] |
60 | set gprdir [file dirname $srcdir] | |
034cb681 JB |
61 | set objdir [file dirname $dest] |
62 | ||
8f432634 TV |
63 | file delete $dest |
64 | ||
ab8314b3 JB |
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 | |
69 | # run, for instance. | |
034cb681 | 70 | append options " ada" |
ab8314b3 JB |
71 | append options " additional_flags=-f" |
72 | append options " additional_flags=-I$srcdir" | |
034cb681 | 73 | |
ab8314b3 | 74 | set result [target_compile_ada_from_dir \ |
4f5946a8 | 75 | $objdir [file tail $source] $dest $type $options] |
034cb681 JB |
76 | |
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. | |
ec3c07fc | 82 | if [file exists $dest] { set result "" } |
d4295de4 TV |
83 | return $result |
84 | } | |
85 | ||
86 | # Compile some Ada code. Generate "PASS: foo.exp: compilation SOURCE" if the | |
87 | # compile was successful. | |
88 | ||
89 | proc gdb_compile_ada {source dest type options} { | |
90 | set result [gdb_compile_ada_1 $source $dest $type $options] | |
91 | ||
ec3c07fc NS |
92 | gdb_compile_test $source $result |
93 | return $result | |
034cb681 JB |
94 | } |
95 | ||
8223e12c TT |
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 | |
101 | # gdb.ada. | |
102 | ||
103 | proc standard_ada_testfile {base_file {dir ""}} { | |
104 | global gdb_test_file_name srcdir subdir | |
105 | global testdir testfile srcfile binfile | |
106 | ||
107 | if {$dir == ""} { | |
108 | set testdir $gdb_test_file_name | |
109 | } else { | |
110 | set testdir $dir | |
111 | } | |
8223e12c | 112 | |
f0464b23 SM |
113 | set testfile $base_file |
114 | set srcfile $srcdir/$subdir/$testdir/$testfile.adb | |
115 | set binfile [standard_output_file $testfile] | |
8223e12c | 116 | } |
2ff0a947 TT |
117 | |
118 | # A helper function to find the appropriate version of a tool. | |
119 | # TOOL is the tool's name, e.g., "gnatbind" or "gnatlink". | |
120 | ||
121 | proc find_ada_tool {tool} { | |
122 | set upper [string toupper $tool] | |
123 | ||
124 | set targname ${upper}_FOR_TARGET | |
125 | global $targname | |
126 | if {[info exists $targname]} { | |
127 | return $targname | |
128 | } | |
129 | ||
130 | global tool_root_dir | |
131 | set root "$tool_root_dir/gcc" | |
132 | set result "" | |
133 | ||
134 | if {![is_remote host]} { | |
135 | set result [lookfor_file $root $tool] | |
136 | } | |
137 | ||
138 | if {$result == ""} { | |
139 | set result [transform $tool] | |
140 | } | |
141 | ||
142 | return $result | |
143 | } | |
d1b70248 TV |
144 | |
145 | # Return 1 if gnatmake is at least version $MAJOR.x.x | |
146 | ||
147 | proc gnatmake_version_at_least { major } { | |
148 | set gnatmake [gdb_find_gnatmake] | |
149 | set gnatmake [lindex [split $gnatmake] 0] | |
f3b0f7fe TV |
150 | if {[catch {exec $gnatmake --version} output]} { |
151 | return 0 | |
152 | } | |
d1b70248 TV |
153 | if { [regexp {GNATMAKE ([^ .]+).([^ .]+).([^ .]+)} $output \ |
154 | match gnatmake_major gnatmake_minor gnatmake_micro] } { | |
155 | if { $gnatmake_major >= $major } { | |
156 | return 1 | |
157 | } else { | |
158 | return 0 | |
159 | } | |
160 | } | |
161 | ||
162 | # Unknown, return 1 | |
163 | return 1 | |
164 | } | |
b28a729d SM |
165 | |
166 | # Return 1 if the GNAT runtime appears to have debug info. | |
167 | ||
168 | gdb_caching_proc gnat_runtime_has_debug_info { | |
169 | global srcdir | |
170 | ||
171 | set src "$srcdir/lib/gnat_debug_info_test.adb" | |
172 | set dst [standard_output_file "gnat_debug_info_test"] | |
173 | ||
d4295de4 | 174 | if { [gdb_compile_ada_1 $src $dst executable {debug}] != "" } { |
b28a729d SM |
175 | return 0 |
176 | } | |
177 | ||
178 | clean_restart $dst | |
179 | ||
180 | if { ! [runto "GNAT_Debug_Info_Test"] } { | |
181 | fail "failed to run to GNAT_Debug_Info_Test" | |
182 | return 0 | |
183 | } | |
184 | ||
185 | set has_debug_info 0 | |
186 | ||
187 | gdb_test_multiple "whatis __gnat_debug_raise_exception" "" { | |
188 | -re "type = <text variable, no debug info>" { } | |
189 | -re "type = void" { | |
190 | set has_debug_info 1 | |
191 | } | |
192 | default { | |
193 | # Some other unexpected output... | |
194 | fail $gdb_test_name | |
195 | } | |
196 | } | |
197 | ||
198 | return $has_debug_info | |
199 | } |