OSDN Git Service

* g++.dg/ext/visibility/pragma-override1.C: Mark as requiring
[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., 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 [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 # 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 }