OSDN Git Service

e8eac300e694ba5f5c5d304e20dafe171e522967
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / lib / target-supports-dg.exp
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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 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 [lindex $args 1 ] ]
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 # 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
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
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 # Compare flags for a test directive against flags that will be used to
183 # compile the test: multilib flags, flags for torture options, and either
184 # the default flags for this group of tests or flags specified with a
185 # previous dg-options directive.
186
187 proc check-flags { args } {
188     global compiler_flags
189     global TOOL_OPTIONS
190     # These variables are from DejaGnu's dg-test.
191     upvar dg-extra-tool-flags extra_tool_flags
192     upvar tool_flags tool_flags
193
194     # The args are within another list; pull them out.
195     set args [lindex $args 0]
196
197     # Start the list with a dummy tool name so the list will match "*"
198     # if there are no flags.
199     set compiler_flags " toolname "
200     append compiler_flags $extra_tool_flags
201     append compiler_flags $tool_flags
202     # If running a subset of the test suite, $TOOL_OPTIONS may not exist.
203     catch {append compiler_flags " $TOOL_OPTIONS "}
204     set dest [target_info name]
205     if [board_info $dest exists multilib_flags] {
206         append compiler_flags "[board_info $dest multilib_flags] "
207     }
208
209     # The target list might be an effective-target keyword, so replace
210     # the original list with "*-*-*", since we already know it matches.
211     set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]]
212
213     # Any value in this variable was left over from an earlier test.
214     set compiler_flags ""
215
216     return $result
217 }
218
219 # Skip the test (report it as UNSUPPORTED) if the target list and
220 # included flags are matched and the excluded flags are not matched.
221 #
222 # The first argument is the line number of the dg-skip-if directive
223 # within the test file.   Remaining arguments are as for xfail lists:
224 # message { targets } { include } { exclude }
225 #
226 # This tests against multilib flags plus either the default flags for this
227 # group of tests or flags specified with a previous dg-options command.
228
229 proc dg-skip-if { args } {
230     # Don't bother if we're already skipping the test.
231     upvar dg-do-what dg-do-what
232     if { [lindex ${dg-do-what} 1] == "N" } {
233       return
234     }
235
236     set args [lreplace $args 0 0]
237
238     set selector [list target [lindex $args 1]]
239     if { [dg-process-target $selector] == "S" } {
240         # These are defined in DejaGnu's dg-test, needed by check-flags.
241         upvar dg-extra-tool-flags dg-extra-tool-flags
242         upvar tool_flags tool_flags
243
244         if [check-flags $args] {
245             upvar dg-do-what dg-do-what
246             set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
247         }
248     }
249 }
250
251 # Like check_conditional_xfail, but callable from a dg test.
252
253 proc dg-xfail-if { args } {
254     # Don't change anything if we're already skipping the test.
255     upvar dg-do-what dg-do-what
256     if { [lindex ${dg-do-what} 1] == "N" } {
257       return
258     }
259
260     set args [lreplace $args 0 0]
261     set selector [list target [lindex $args 1]]
262     if { [dg-process-target $selector] == "S" } {
263         global compiler_conditional_xfail_data
264         set compiler_conditional_xfail_data [lreplace $args 1 1 "*-*-*"]
265     }
266 }
267
268 # Intercept the call to the DejaGnu version of dg-process-target to
269 # support use of an effective-target keyword in place of a list of
270 # target triplets to xfail or skip a test.
271 #
272 # selector is one of:
273 #    xfail target-triplet-1 ...
274 #    xfail effective-target-keyword
275 #    xfail selector-expression
276 #    target target-triplet-1 ...
277 #    target effective-target-keyword
278 #    target selector-expression
279 #
280 # For a target list the result is "S" if the target is selected, "N" otherwise.
281 # For an xfail list the result is "F" if the target is affected, "P" otherwise.
282 #
283 # A selector expression appears within curly braces and uses a single logical
284 # operator: !, &&, or ||.  An operand is another selector expression, an
285 # effective-target keyword, or a list of target triplets within quotes or
286 # curly braces.
287
288 if { [info procs saved-dg-process-target] == [list] } {
289     rename dg-process-target saved-dg-process-target
290
291     # Evaluate an operand within a selector expression.
292     proc selector_opd { op } {
293         set selector "target"
294         lappend selector $op
295         set answer [ expr { [dg-process-target $selector] == "S" } ]
296         verbose "selector_opd: `$op' $answer" 2
297         return $answer
298     }
299
300     # Evaluate a target triplet list within a selector expression.
301     # Unlike other operands, this needs to be expanded from a list to
302     # the same string as "target".
303     proc selector_list { op } {
304         set selector "target [join $op]"
305         set answer [ expr { [dg-process-target $selector] == "S" } ]
306         verbose "selector_list: `$op' $answer" 2
307         return $answer
308     }
309
310     # Evaluate a selector expression.
311     proc selector_expression { exp } {
312         if { [llength $exp] == 2 } {
313             if [string match "!" [lindex $exp 0]] {
314                 set op1 [lindex $exp 1]
315                 set answer [expr { ! [selector_opd $op1] }]
316             } else {
317                 # Assume it's a list of target triplets.
318                 set answer [selector_list $exp]
319             }
320         } elseif { [llength $exp] == 3 } {
321             set op1 [lindex $exp 0]
322             set opr [lindex $exp 1]
323             set op2 [lindex $exp 2]
324             if [string match "&&" $opr] {
325                 set answer [expr { [selector_opd $op1] && [selector_opd $op2] }]
326             } elseif [string match "||" $opr] {
327                 set answer [expr { [selector_opd $op1] || [selector_opd $op2] }]
328             } else {
329                 # Assume it's a list of target triplets.
330                 set answer [selector_list $exp]
331             }
332         } else {
333             # Assume it's a list of target triplets.
334             set answer [selector_list $exp]
335         }
336
337         verbose "selector_expression: `$exp' $answer" 2
338         return $answer
339     }
340
341     proc dg-process-target { args } {
342         verbose "replacement dg-process-target: `$args'" 2
343         
344         # Extract the 'what' keyword from the argument list.
345         set selector [string trim [lindex $args 0]]
346         if [regexp "^xfail " $selector] {
347             set what "xfail"
348         } elseif [regexp "^target " $selector] {
349             set what "target"
350         } else {
351             error "syntax error in target selector \"$selector\""
352         }
353
354         # Extract the rest of the list, which might be a keyword.
355         regsub "^${what}" $selector "" rest
356         set rest [string trim $rest]
357
358         if [is-effective-target-keyword $rest] {
359             # The selector is an effective target keyword.
360             if [is-effective-target $rest] {
361                 return [expr { $what == "xfail" ? "F" : "S" }]
362             } else {
363                 return [expr { $what == "xfail" ? "P" : "N" }]
364             }
365         }
366
367         if [string match "{*}" $rest] {
368             if [selector_expression [lindex $rest 0]] {
369                 return [expr { $what == "xfail" ? "F" : "S" }]
370             } else {
371                 return [expr { $what == "xfail" ? "P" : "N" }]
372             }
373         }
374
375         # The selector is not an effective-target keyword, so process
376         # the list of target triplets.
377         return [saved-dg-process-target $selector]
378     }
379 }