]>
Commit | Line | Data |
---|---|---|
f1717362 | 1 | # Copyright (C) 2006-2016 Free Software Foundation, Inc. |
66f39e51 | 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 | |
f63ff66b | 5 | # the Free Software Foundation; either version 3 of the License, or |
66f39e51 | 6 | # (at your option) any later version. |
7 | # | |
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. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
f63ff66b | 14 | # along with GCC; see the file COPYING3. If not see |
15 | # <http://www.gnu.org/licenses/>. | |
66f39e51 | 16 | |
17 | load_lib gcc-dg.exp | |
18 | ||
9c669ef2 | 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] | |
24 | } | |
25 | ||
66f39e51 | 26 | # Define gcc callbacks for dg.exp. |
27 | ||
28 | proc gnat-dg-test { prog do_what extra_tool_flags } { | |
9c669ef2 | 29 | if { $do_what == "compile" } { |
30 | lappend extra_tool_flags "-c" | |
56bfbd8d | 31 | lappend extra_tool_flags "-u" |
9c669ef2 | 32 | } |
33 | set result [gcc-dg-test-1 gnat_target_compile $prog $do_what $extra_tool_flags] | |
34 | ||
35 | # Remove additional output files apart from $output_file, which may be | |
36 | # needed by dg-final. | |
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 | |
48 | } | |
49 | ||
50 | return $result | |
66f39e51 | 51 | } |
52 | ||
53 | proc gnat-dg-prune { system text } { | |
54 | global additional_prunes | |
55 | ||
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" | |
60 | ||
61 | return [gcc-dg-prune $system $text] | |
62 | } | |
63 | ||
64 | # Utility routines. | |
65 | ||
4d1f6da3 | 66 | # |
67 | # gnat_load -- wrapper around default gnat_load to declare tasking tests | |
68 | # unsupported on platforms that lack such support | |
69 | # | |
70 | ||
71 | if { [info procs gnat_load] != [list] \ | |
72 | && [info procs prev_gnat_load] == [list] } { | |
73 | rename gnat_load prev_gnat_load | |
74 | ||
75 | proc gnat_load { program args } { | |
76 | upvar name testcase | |
77 | ||
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] | |
82 | } | |
83 | return $result | |
84 | } | |
85 | } | |
9c669ef2 | 86 | |
87 | # Local Variables: | |
88 | # tcl-indent-level:4 | |
89 | # End: |