1 # Copyright
(C
) 2006-2019 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 GCC
; see the file COPYING3.
If not see
15 #
<http
://www.gnu.org
/licenses
/>.
19 # Remove VALUE from LIST_VARIABLE.
20 proc lremove
{list_variable value
} {
21 upvar
1 $list_variable var
22 set idx
[lsearch
-exact $var $value
]
23 set var
[lreplace $var $idx $idx
]
26 #
Define gcc callbacks
for dg.exp.
28 proc gnat
-dg
-test
{ prog do_what extra_tool_flags
} {
29 if { $do_what
== "compile" } {
30 lappend extra_tool_flags
"-c"
31 lappend extra_tool_flags
"-u"
33 set result
[gcc
-dg
-test
-1 gnat_target_compile $prog $do_what $extra_tool_flags
]
35 # Remove additional output files apart from $output_file
, which may be
37 set output_file
[lindex $result
1]
38 set basename
[file rootname $output_file
]
39 set clean_result
[remote_exec host
[find_gnatclean
] "-c -q -n $basename"]
40 if { [lindex $clean_result
0] != -1 } {
41 set clean_files
[lindex $clean_result
1]
42 # Purge NL from clean_files.
43 regsub
-all
"\[\r\n\]+" $clean_files " " clean_files
44 # Remove .
/ so lremove works.
45 regsub
-all
"\./" $clean_files "" clean_files
46 lremove clean_files $output_file
47 eval remote_file host
delete $clean_files
53 proc gnat
-dg
-prune
{ system text } {
54 global additional_prunes
56 lappend additional_prunes
"gnatmake"
57 lappend additional_prunes
"compilation abandoned"
58 lappend additional_prunes
"fatal error: maximum errors reached"
59 lappend additional_prunes
"linker input file"
61 return [gcc
-dg
-prune $
system $
text]
67 # gnat_load
-- wrapper around default gnat_load to declare tasking tests
68 # unsupported
on platforms that lack such support
71 if { [info procs gnat_load
] != [list
] \
72 && [info procs prev_gnat_load
] == [list
] } {
73 rename gnat_load prev_gnat_load
75 proc gnat_load
{ program args } {
78 set result
[eval
[list prev_gnat_load $
program] $
args]
79 set output
[lindex $result
1]
80 if { [regexp
"tasking not implemented" $output] } {
81 return [list
"unsupported" $output]