]>
Commit | Line | Data |
---|---|---|
a29c731d JJ |
1 | # Copyright (C) 1997, 1999, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. |
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 | |
5 | # the Free Software Foundation; either version 2 of the License, or | |
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 | |
14 | # along with this program; if not, write to the Free Software | |
15 | # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
16 | ||
17 | # If this target does not support weak symbols, skip this test. | |
18 | ||
19 | proc dg-require-weak { args } { | |
20 | set weak_available [ check_weak_available ] | |
21 | if { $weak_available == -1 } { | |
22 | upvar name name | |
23 | unresolved "$name" | |
24 | } | |
25 | if { $weak_available != 1 } { | |
26 | upvar dg-do-what dg-do-what | |
27 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
28 | } | |
29 | } | |
30 | ||
31 | # If this target does not support the "visibility" attribute, skip this | |
32 | # test. | |
33 | ||
34 | proc dg-require-visibility { args } { | |
35 | set visibility_available [ check_visibility_available ] | |
36 | if { $visibility_available == -1 } { | |
37 | upvar name name | |
38 | unresolved "$name" | |
39 | } | |
40 | if { $visibility_available != 1 } { | |
41 | upvar dg-do-what dg-do-what | |
42 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
43 | } | |
44 | } | |
45 | ||
46 | # If this target does not support the "alias" attribute, skip this | |
47 | # test. | |
48 | ||
49 | proc dg-require-alias { args } { | |
50 | set alias_available [ check_alias_available ] | |
51 | if { $alias_available == -1 } { | |
52 | upvar name name | |
53 | unresolved "$name" | |
54 | } | |
55 | if { $alias_available < 2 } { | |
56 | upvar dg-do-what dg-do-what | |
57 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
58 | } | |
59 | } | |
60 | ||
61 | # If this target's linker does not support the --gc-sections flag, | |
62 | # skip this test. | |
63 | ||
64 | proc dg-require-gc-sections { args } { | |
65 | if { ![ check_gc_sections_available ] } { | |
66 | upvar dg-do-what dg-do-what | |
67 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
68 | } | |
69 | } | |
70 | ||
71 | # If this target does not support profiling, skip this test. | |
72 | ||
73 | proc dg-require-profiling { args } { | |
74 | if { ![ check_profiling_available ${args} ] } { | |
75 | upvar dg-do-what dg-do-what | |
76 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
77 | } | |
78 | } | |
79 | ||
80 | # If this target does not support DLL attributes skip this test. | |
81 | ||
82 | proc dg-require-dll { args } { | |
83 | global target_triplet | |
84 | # As a special case, the mcore-*-elf supports these attributes. | |
85 | # All Symbian OS targets also support these attributes. | |
86 | if { [string match "mcore-*-elf" $target_triplet] | |
87 | || [string match "*-*-symbianelf" $target_triplet]} { | |
88 | return | |
89 | } | |
90 | # PE/COFF targets support dllimport/dllexport. | |
91 | if { [gcc_target_object_format] == "pe" } { | |
92 | return | |
93 | } | |
94 | ||
95 | upvar dg-do-what dg-do-what | |
96 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
97 | } | |
98 | ||
99 | proc dg-require-iconv { args } { | |
100 | if { ![ check_iconv_available ${args} ] } { | |
101 | upvar dg-do-what dg-do-what | |
102 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
103 | } | |
104 | } | |
105 | ||
106 | # If this target does not support named sections skip this test. | |
107 | ||
108 | proc dg-require-named-sections { args } { | |
109 | if { ![ check_named_sections_available ] } { | |
110 | upvar dg-do-what dg-do-what | |
111 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
112 | } | |
113 | } | |
114 | ||
115 | # If the target does not match the required effective target, skip this test. | |
116 | ||
117 | proc dg-require-effective-target { args } { | |
118 | set args [lreplace $args 0 0] | |
119 | if { ![is-effective-target [lindex $args 0]] } { | |
120 | upvar dg-do-what dg-do-what | |
121 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
122 | } | |
123 | } | |
124 | ||
125 | # Check the flags with which the test will be run against options in | |
126 | # a test directive that will skip or xfail that test. The DejaGnu proc | |
127 | # check_conditional_xfail will look at the options in compiler_flags, so | |
128 | # set that up for this test based on flags we know about. | |
129 | ||
130 | proc check_test_flags { args } { | |
131 | global compiler_flags | |
132 | upvar 2 dg-extra-tool-flags extra_tool_flags | |
133 | ||
134 | # Pull the args out of the enclosing list. | |
135 | set args [lindex $args 0] | |
136 | ||
137 | # Start the list with a dummy tool name so the list will match "*" | |
138 | # if there are no flags. | |
139 | set compiler_flags " toolname " | |
140 | append compiler_flags $extra_tool_flags | |
141 | set dest [target_info name] | |
142 | if [board_info $dest exists multilib_flags] { | |
143 | append compiler_flags "[board_info $dest multilib_flags] " | |
144 | } | |
145 | ||
146 | set answer [check_conditional_xfail $args] | |
147 | ||
148 | # Any value in this variable originally was left over from an earlier test. | |
149 | set compiler_flags "" | |
150 | ||
151 | verbose "check_test_flags: $args $answer" 2 | |
152 | return $answer | |
153 | } | |
154 | ||
155 | # Skip the test (report it as UNSUPPORTED) if the target list and | |
156 | # included flags are matched and the excluded flags are not matched. | |
157 | # | |
158 | # The first argument is the line number of the dg-skip-if directive | |
159 | # within the test file. Remaining arguments are as for xfail lists: | |
160 | # message { targets } { include } { exclude } | |
161 | # | |
162 | # This tests against multilib flags plus either the default flags for this | |
163 | # group of tests or flags specified with a previous dg-options command. | |
164 | ||
165 | proc dg-skip-if { args } { | |
166 | set args [lreplace $args 0 0] | |
167 | ||
168 | set selector "target [join [lindex $args 1]]" | |
169 | if { [dg-process-target $selector] == "S" } { | |
170 | # The target list matched; now check the flags. The DejaGnu proc | |
171 | # check_conditional_xfail will look at the options in compiler_flags, | |
172 | # so set that up for this test based on flags we know about. Start | |
173 | # the list with a dummy tool name so the list will match "*" if | |
174 | # there are no flags. | |
175 | ||
176 | global compiler_flags | |
177 | upvar dg-extra-tool-flags extra_tool_flags | |
178 | ||
179 | set compiler_flags " toolname " | |
180 | append compiler_flags $extra_tool_flags | |
181 | set dest [target_info name] | |
182 | if [board_info $dest exists multilib_flags] { | |
183 | append compiler_flags "[board_info $dest multilib_flags] " | |
184 | } | |
185 | ||
186 | # The target list might be an effective-target keyword, so replace | |
187 | # the original list with "*-*-*". | |
188 | if [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]] { | |
189 | upvar dg-do-what dg-do-what | |
190 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
191 | } | |
192 | ||
193 | # Any value in this variable was left over from an earlier test. | |
194 | set compiler_flags "" | |
195 | } | |
196 | } | |
197 | ||
198 | # Like check_conditional_xfail, but callable from a dg test. | |
199 | ||
200 | proc dg-xfail-if { args } { | |
201 | # Don't change anything if we're already skipping the test. | |
202 | upvar dg-do-what dg-do-what | |
203 | if { [lindex ${dg-do-what} 1] == "N" } { | |
204 | return | |
205 | } | |
206 | ||
207 | set args [lreplace $args 0 0] | |
208 | set selector "target [join [lindex $args 1]]" | |
209 | if { [dg-process-target $selector] == "S" } { | |
210 | global compiler_conditional_xfail_data | |
211 | set compiler_conditional_xfail_data [lreplace $args 1 1 "*-*-*"] | |
212 | } | |
213 | } | |
214 | ||
215 | # Intercept the call to the DejaGnu version of dg-process-target to | |
216 | # support use of an effective-target keyword in place of a list of | |
217 | # target triplets to xfail or skip a test. | |
218 | # | |
219 | # selector is one of: | |
220 | # xfail target-triplet-1 ... | |
221 | # xfail effective-target-keyword | |
222 | # xfail selector-expression | |
223 | # target target-triplet-1 ... | |
224 | # target effective-target-keyword | |
225 | # target selector-expression | |
226 | # | |
227 | # For a target list the result is "S" if the target is selected, "N" otherwise. | |
228 | # For an xfail list the result is "F" if the target is affected, "P" otherwise. | |
229 | # | |
230 | # A selector expression appears within curly braces and uses a single logical | |
231 | # operator: !, &&, or ||. An operand is another selector expression, an | |
232 | # effective-target keyword, or a list of target triplets within quotes or | |
233 | # curly braces. | |
234 | ||
235 | if { [info procs saved-dg-process-target] == [list] } { | |
236 | rename dg-process-target saved-dg-process-target | |
237 | ||
238 | # Evaluate an operand within a selector expression. | |
239 | proc selector_opd { op } { | |
240 | set selector "target" | |
241 | lappend selector $op | |
242 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
243 | verbose "selector_opd: `$op' $answer" 2 | |
244 | return $answer | |
245 | } | |
246 | ||
247 | # Evaluate a target triplet list within a selector expression. | |
248 | # Unlike other operands, this needs to be expanded from a list to | |
249 | # the same string as "target". | |
250 | proc selector_list { op } { | |
251 | set selector "target [join $op]" | |
252 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
253 | verbose "selector_list: `$op' $answer" 2 | |
254 | return $answer | |
255 | } | |
256 | ||
257 | # Evaluate a selector expression. | |
258 | proc selector_expression { exp } { | |
259 | if { [llength $exp] == 2 } { | |
260 | if [string match "!" [lindex $exp 0]] { | |
261 | set op1 [lindex $exp 1] | |
262 | set answer [expr { ! [selector_opd $op1] }] | |
263 | } else { | |
264 | # Assume it's a list of target triplets. | |
265 | set answer [selector_list $exp] | |
266 | } | |
267 | } elseif { [llength $exp] == 3 } { | |
268 | set op1 [lindex $exp 0] | |
269 | set opr [lindex $exp 1] | |
270 | set op2 [lindex $exp 2] | |
271 | if [string match "&&" $opr] { | |
272 | set answer [expr { [selector_opd $op1] && [selector_opd $op2] }] | |
273 | } elseif [string match "||" $opr] { | |
274 | set answer [expr { [selector_opd $op1] || [selector_opd $op2] }] | |
275 | } else { | |
276 | # Assume it's a list of target triplets. | |
277 | set answer [selector_list $exp] | |
278 | } | |
279 | } else { | |
280 | # Assume it's a list of target triplets. | |
281 | set answer [selector_list $exp] | |
282 | } | |
283 | ||
284 | verbose "selector_expression: `$exp' $answer" 2 | |
285 | return $answer | |
286 | } | |
287 | ||
288 | proc dg-process-target { args } { | |
289 | verbose "replacement dg-process-target: `$args'" 2 | |
290 | ||
291 | # Extract the 'what' keyword from the argument list. | |
292 | set selector [string trim [lindex $args 0]] | |
293 | if [regexp "^xfail " $selector] { | |
294 | set what "xfail" | |
295 | } elseif [regexp "^target " $selector] { | |
296 | set what "target" | |
297 | } else { | |
298 | error "syntax error in target selector \"$selector\"" | |
299 | } | |
300 | ||
301 | # Extract the rest of the list, which might be a keyword. | |
302 | regsub "^${what}" $selector "" rest | |
303 | set rest [string trim $rest] | |
304 | ||
305 | if [is-effective-target-keyword $rest] { | |
306 | # The selector is an effective target keyword. | |
307 | if [is-effective-target $rest] { | |
308 | return [expr { $what == "xfail" ? "F" : "S" }] | |
309 | } else { | |
310 | return [expr { $what == "xfail" ? "P" : "N" }] | |
311 | } | |
312 | } | |
313 | ||
314 | if [string match "{*}" $rest] { | |
315 | if [selector_expression [lindex $rest 0]] { | |
316 | return [expr { $what == "xfail" ? "F" : "S" }] | |
317 | } else { | |
318 | return [expr { $what == "xfail" ? "P" : "N" }] | |
319 | } | |
320 | } | |
321 | ||
322 | # The selector is not an effective-target keyword, so process | |
323 | # the list of target triplets. | |
324 | return [saved-dg-process-target $selector] | |
325 | } | |
326 | } |