]>
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 | |
f115b653 | 15 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
a29c731d JJ |
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 } { | |
d3d9a67f | 35 | set visibility_available [ check_visibility_available [lindex $args 1 ] ] |
a29c731d JJ |
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 | ||
34f4edf8 MM |
125 | # If this target does not have fork, skip this test. |
126 | ||
127 | proc dg-require-fork { args } { | |
128 | if { ![check_fork_available] } { | |
129 | upvar dg-do-what dg-do-what | |
130 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
131 | } | |
132 | } | |
133 | ||
134 | # If this target does not have mkfifo, skip this test. | |
135 | ||
136 | proc dg-require-mkfifo { args } { | |
137 | if { ![check_mkfifo_available] } { | |
138 | upvar dg-do-what dg-do-what | |
139 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
140 | } | |
141 | } | |
142 | ||
21f638b9 SE |
143 | # If this target does not use __cxa_atexit, skip this test. |
144 | ||
145 | proc dg-require-cxa-atexit { args } { | |
146 | if { ![ check_cxa_atexit_available ] } { | |
147 | upvar dg-do-what dg-do-what | |
148 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
149 | } | |
150 | } | |
151 | ||
a29c731d JJ |
152 | # Check the flags with which the test will be run against options in |
153 | # a test directive that will skip or xfail that test. The DejaGnu proc | |
154 | # check_conditional_xfail will look at the options in compiler_flags, so | |
155 | # set that up for this test based on flags we know about. | |
156 | ||
157 | proc check_test_flags { args } { | |
158 | global compiler_flags | |
159 | upvar 2 dg-extra-tool-flags extra_tool_flags | |
160 | ||
161 | # Pull the args out of the enclosing list. | |
162 | set args [lindex $args 0] | |
163 | ||
164 | # Start the list with a dummy tool name so the list will match "*" | |
165 | # if there are no flags. | |
166 | set compiler_flags " toolname " | |
167 | append compiler_flags $extra_tool_flags | |
168 | set dest [target_info name] | |
169 | if [board_info $dest exists multilib_flags] { | |
170 | append compiler_flags "[board_info $dest multilib_flags] " | |
171 | } | |
172 | ||
173 | set answer [check_conditional_xfail $args] | |
174 | ||
175 | # Any value in this variable originally was left over from an earlier test. | |
176 | set compiler_flags "" | |
177 | ||
178 | verbose "check_test_flags: $args $answer" 2 | |
179 | return $answer | |
180 | } | |
181 | ||
182 | # Skip the test (report it as UNSUPPORTED) if the target list and | |
183 | # included flags are matched and the excluded flags are not matched. | |
184 | # | |
185 | # The first argument is the line number of the dg-skip-if directive | |
186 | # within the test file. Remaining arguments are as for xfail lists: | |
187 | # message { targets } { include } { exclude } | |
188 | # | |
189 | # This tests against multilib flags plus either the default flags for this | |
190 | # group of tests or flags specified with a previous dg-options command. | |
191 | ||
192 | proc dg-skip-if { args } { | |
193 | set args [lreplace $args 0 0] | |
194 | ||
c44ca162 | 195 | set selector [list target [lindex $args 1]] |
a29c731d JJ |
196 | if { [dg-process-target $selector] == "S" } { |
197 | # The target list matched; now check the flags. The DejaGnu proc | |
198 | # check_conditional_xfail will look at the options in compiler_flags, | |
199 | # so set that up for this test based on flags we know about. Start | |
200 | # the list with a dummy tool name so the list will match "*" if | |
201 | # there are no flags. | |
202 | ||
203 | global compiler_flags | |
204 | upvar dg-extra-tool-flags extra_tool_flags | |
205 | ||
206 | set compiler_flags " toolname " | |
207 | append compiler_flags $extra_tool_flags | |
208 | set dest [target_info name] | |
209 | if [board_info $dest exists multilib_flags] { | |
210 | append compiler_flags "[board_info $dest multilib_flags] " | |
211 | } | |
212 | ||
213 | # The target list might be an effective-target keyword, so replace | |
214 | # the original list with "*-*-*". | |
215 | if [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]] { | |
216 | upvar dg-do-what dg-do-what | |
217 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
218 | } | |
219 | ||
220 | # Any value in this variable was left over from an earlier test. | |
221 | set compiler_flags "" | |
222 | } | |
223 | } | |
224 | ||
225 | # Like check_conditional_xfail, but callable from a dg test. | |
226 | ||
227 | proc dg-xfail-if { args } { | |
228 | # Don't change anything if we're already skipping the test. | |
229 | upvar dg-do-what dg-do-what | |
230 | if { [lindex ${dg-do-what} 1] == "N" } { | |
231 | return | |
232 | } | |
233 | ||
234 | set args [lreplace $args 0 0] | |
c44ca162 | 235 | set selector [list target [lindex $args 1]] |
a29c731d JJ |
236 | if { [dg-process-target $selector] == "S" } { |
237 | global compiler_conditional_xfail_data | |
238 | set compiler_conditional_xfail_data [lreplace $args 1 1 "*-*-*"] | |
239 | } | |
240 | } | |
241 | ||
242 | # Intercept the call to the DejaGnu version of dg-process-target to | |
243 | # support use of an effective-target keyword in place of a list of | |
244 | # target triplets to xfail or skip a test. | |
245 | # | |
246 | # selector is one of: | |
247 | # xfail target-triplet-1 ... | |
248 | # xfail effective-target-keyword | |
249 | # xfail selector-expression | |
250 | # target target-triplet-1 ... | |
251 | # target effective-target-keyword | |
252 | # target selector-expression | |
253 | # | |
254 | # For a target list the result is "S" if the target is selected, "N" otherwise. | |
255 | # For an xfail list the result is "F" if the target is affected, "P" otherwise. | |
256 | # | |
257 | # A selector expression appears within curly braces and uses a single logical | |
258 | # operator: !, &&, or ||. An operand is another selector expression, an | |
259 | # effective-target keyword, or a list of target triplets within quotes or | |
260 | # curly braces. | |
261 | ||
262 | if { [info procs saved-dg-process-target] == [list] } { | |
263 | rename dg-process-target saved-dg-process-target | |
264 | ||
265 | # Evaluate an operand within a selector expression. | |
266 | proc selector_opd { op } { | |
267 | set selector "target" | |
268 | lappend selector $op | |
269 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
270 | verbose "selector_opd: `$op' $answer" 2 | |
271 | return $answer | |
272 | } | |
273 | ||
274 | # Evaluate a target triplet list within a selector expression. | |
275 | # Unlike other operands, this needs to be expanded from a list to | |
276 | # the same string as "target". | |
277 | proc selector_list { op } { | |
278 | set selector "target [join $op]" | |
279 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
280 | verbose "selector_list: `$op' $answer" 2 | |
281 | return $answer | |
282 | } | |
283 | ||
284 | # Evaluate a selector expression. | |
285 | proc selector_expression { exp } { | |
286 | if { [llength $exp] == 2 } { | |
287 | if [string match "!" [lindex $exp 0]] { | |
288 | set op1 [lindex $exp 1] | |
289 | set answer [expr { ! [selector_opd $op1] }] | |
290 | } else { | |
291 | # Assume it's a list of target triplets. | |
292 | set answer [selector_list $exp] | |
293 | } | |
294 | } elseif { [llength $exp] == 3 } { | |
295 | set op1 [lindex $exp 0] | |
296 | set opr [lindex $exp 1] | |
297 | set op2 [lindex $exp 2] | |
298 | if [string match "&&" $opr] { | |
299 | set answer [expr { [selector_opd $op1] && [selector_opd $op2] }] | |
300 | } elseif [string match "||" $opr] { | |
301 | set answer [expr { [selector_opd $op1] || [selector_opd $op2] }] | |
302 | } else { | |
303 | # Assume it's a list of target triplets. | |
304 | set answer [selector_list $exp] | |
305 | } | |
306 | } else { | |
307 | # Assume it's a list of target triplets. | |
308 | set answer [selector_list $exp] | |
309 | } | |
310 | ||
311 | verbose "selector_expression: `$exp' $answer" 2 | |
312 | return $answer | |
313 | } | |
314 | ||
315 | proc dg-process-target { args } { | |
316 | verbose "replacement dg-process-target: `$args'" 2 | |
317 | ||
318 | # Extract the 'what' keyword from the argument list. | |
319 | set selector [string trim [lindex $args 0]] | |
320 | if [regexp "^xfail " $selector] { | |
321 | set what "xfail" | |
322 | } elseif [regexp "^target " $selector] { | |
323 | set what "target" | |
324 | } else { | |
325 | error "syntax error in target selector \"$selector\"" | |
326 | } | |
327 | ||
328 | # Extract the rest of the list, which might be a keyword. | |
329 | regsub "^${what}" $selector "" rest | |
330 | set rest [string trim $rest] | |
331 | ||
332 | if [is-effective-target-keyword $rest] { | |
333 | # The selector is an effective target keyword. | |
334 | if [is-effective-target $rest] { | |
335 | return [expr { $what == "xfail" ? "F" : "S" }] | |
336 | } else { | |
337 | return [expr { $what == "xfail" ? "P" : "N" }] | |
338 | } | |
339 | } | |
340 | ||
341 | if [string match "{*}" $rest] { | |
342 | if [selector_expression [lindex $rest 0]] { | |
343 | return [expr { $what == "xfail" ? "F" : "S" }] | |
344 | } else { | |
345 | return [expr { $what == "xfail" ? "P" : "N" }] | |
346 | } | |
347 | } | |
348 | ||
349 | # The selector is not an effective-target keyword, so process | |
350 | # the list of target triplets. | |
351 | return [saved-dg-process-target $selector] | |
352 | } | |
353 | } |