OSDN Git Service

* lib/target-supports-dg.exp (dg-require-cxa-atexit): New.
[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 # 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
195     set selector [list target [lindex $args 1]]
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]
235     set selector [list target [lindex $args 1]]
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 }