1 # Copyright
(C
) 1997, 1999, 2000, 2003, 2004, 2005, 2007
2 # Free Software Foundation
, Inc.
4 # This
program is free software
; you can redistribute it and
/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation
; either version
3 of the License
, or
7 #
(at your option
) any later version.
9 # This
program is distributed in the hope that it will be useful
,
10 # but WITHOUT
ANY WARRANTY
; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License
for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with GCC
; see the file COPYING3.
If not see
16 #
<http
://www.gnu.org
/licenses
/>.
18 #
If this target does not support weak symbols
, skip this test.
20 proc dg
-require
-weak
{ args } {
21 set weak_available
[ check_weak_available
]
22 if { $weak_available
== -1 } {
26 if { $weak_available
!= 1 } {
27 upvar dg
-do-what dg
-do-what
28 set dg
-do-what
[list
[lindex $
{dg
-do-what
} 0] "N" "P"]
32 #
If this target does not support the
"visibility" attribute, skip this
35 proc dg
-require
-visibility
{ args } {
36 set visibility_available
[ check_visibility_available
[lindex $
args 1 ] ]
37 if { $visibility_available
== -1 } {
41 if { $visibility_available
!= 1 } {
42 upvar dg
-do-what dg
-do-what
43 set dg
-do-what
[list
[lindex $
{dg
-do-what
} 0] "N" "P"]
47 #
If this target does not support the
"alias" attribute, skip this
50 proc dg
-require
-alias
{ args } {
51 set alias_available
[ check_alias_available
]
52 if { $alias_available
== -1 } {
56 if { $alias_available
< 2 } {
57 upvar dg
-do-what dg
-do-what
58 set dg
-do-what
[list
[lindex $
{dg
-do-what
} 0] "N" "P"]
62 #
If this target
's linker does not support the --gc-sections flag,
65 proc dg-require-gc-sections { args } {
66 if { ![ check_gc_sections_available ] } {
67 upvar dg-do-what dg-do-what
68 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
72 # If this target does not support profiling, skip this test.
74 proc dg-require-profiling { args } {
75 if { ![ check_profiling_available ${args} ] } {
76 upvar dg-do-what dg-do-what
77 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
81 # If this target does not support DLL attributes skip this test.
83 proc dg-require-dll { args } {
85 # As a special case, the mcore-*-elf supports these attributes.
86 # All Symbian OS targets also support these attributes.
87 if { [string match "mcore-*-elf" $target_triplet]
88 || [string match "*-*-symbianelf" $target_triplet]} {
91 # PE/COFF targets support dllimport/dllexport.
92 if { [gcc_target_object_format] == "pe" } {
96 upvar dg-do-what dg-do-what
97 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
100 proc dg-require-iconv { args } {
101 if { ![ check_iconv_available ${args} ] } {
102 upvar dg-do-what dg-do-what
103 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
107 # If this target does not support named sections skip this test.
109 proc dg-require-named-sections { args } {
110 if { ![ check_named_sections_available ] } {
111 upvar dg-do-what dg-do-what
112 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
116 # If the target does not match the required effective target, skip this test.
118 proc dg-require-effective-target { args } {
119 set args [lreplace $args 0 0]
120 if { ![is-effective-target [lindex $args 0]] } {
121 upvar dg-do-what dg-do-what
122 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
126 # If this target does not have fork, skip this test.
128 proc dg-require-fork { args } {
129 if { ![check_fork_available] } {
130 upvar dg-do-what dg-do-what
131 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
135 # If this target does not have mkfifo, skip this test.
137 proc dg-require-mkfifo { args } {
138 if { ![check_mkfifo_available] } {
139 upvar dg-do-what dg-do-what
140 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
144 # If this target does not use __cxa_atexit, skip this test.
146 proc dg-require-cxa-atexit { args } {
147 if { ![ check_cxa_atexit_available ] } {
148 upvar dg-do-what dg-do-what
149 set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
153 # If the host is remote rather than the same as the build system, skip
154 # this test. Some tests are incompatible with DejaGnu's handling of
155 # remote hosts
, which involves copying the source file to the host and
156 # compiling it with a relative path and
"-o a.out".
158 proc dg
-require
-host
-local
{ args } {
159 if [ is_remote host
] {
160 upvar dg
-do-what dg
-do-what
161 set dg
-do-what
[list
[lindex $
{dg
-do-what
} 0] "N" "P"]
165 # Add
any target
-specific flags needed
for accessing the given list
166 # of features. This must come after all dg
-options.
168 proc dg
-add
-options
{ args } {
169 upvar dg
-extra
-tool
-flags extra
-tool
-flags
171 foreach
arg [lrange $
args 1 end
] {
172 if { [info procs add_options_for_$
arg] != "" } {
173 set extra
-tool
-flags \
174 [eval
[list add_options_for_$
arg $
{extra
-tool
-flags
}]]
176 error
"Unrecognized option type: $arg"
181 # Check the flags with which the test will be run against options in
182 # a test directive that will skip or xfail that test. The DejaGnu proc
183 # check_conditional_xfail will look at the options in compiler_flags
, so
184 #
set that up
for this test based
on flags we know about.
186 proc check_test_flags
{ args } {
187 global compiler_flags
188 upvar
2 dg
-extra
-tool
-flags extra_tool_flags
190 # Pull the
args out of the enclosing list.
191 set args [lindex $
args 0]
193 # Start the list with a dummy tool
name so the list will match
"*"
194 #
if there are no flags.
195 set compiler_flags
" toolname "
196 append compiler_flags $extra_tool_flags
197 set dest
[target_info
name]
198 if [board_info $dest
exists multilib_flags
] {
199 append compiler_flags
"[board_info $dest multilib_flags] "
202 set answer
[check_conditional_xfail $
args]
204 #
Any value in this
variable originally was left over from an earlier test.
205 set compiler_flags
""
207 verbose
"check_test_flags: $args $answer" 2
211 # Compare flags
for a test directive against flags that will be used to
212 #
compile the test
: multilib flags
, flags
for torture options
, and either
213 # the default flags
for this group of tests or flags specified with a
214 # previous dg
-options directive.
216 proc check
-flags
{ args } {
217 global compiler_flags
219 # These variables are from DejaGnu
's dg-test.
220 upvar dg-extra-tool-flags extra_tool_flags
221 upvar tool_flags tool_flags
223 # The args are within another list; pull them out.
224 set args [lindex $args 0]
226 # Start the list with a dummy tool name so the list will match "*"
227 # if there are no flags.
228 set compiler_flags " toolname "
229 append compiler_flags $extra_tool_flags
230 append compiler_flags $tool_flags
231 # If running a subset of the test suite, $TOOL_OPTIONS may not exist.
232 catch {append compiler_flags " $TOOL_OPTIONS "}
233 set dest [target_info name]
234 if [board_info $dest exists multilib_flags] {
235 append compiler_flags "[board_info $dest multilib_flags] "
238 # The target list might be an effective-target keyword, so replace
239 # the original list with "*-*-*", since we already know it matches.
240 set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]]
242 # Any value in this variable was left over from an earlier test.
243 set compiler_flags ""
248 # Skip the test (report it as UNSUPPORTED) if the target list and
249 # included flags are matched and the excluded flags are not matched.
251 # The first argument is the line number of the dg-skip-if directive
252 # within the test file. Remaining arguments are as for xfail lists:
253 # message { targets } { include } { exclude }
255 # This tests against multilib flags plus either the default flags for this
256 # group of tests or flags specified with a previous dg-options command.
258 proc dg-skip-if { args } {
259 # Don't bother
if we
're already skipping the test.
260 upvar dg-do-what dg-do-what
261 if { [lindex ${dg-do-what} 1] == "N" } {
265 set args [lreplace $args 0 0]
267 set selector [list target [lindex $args 1]]
268 if { [dg-process-target $selector] == "S" } {
269 # These are defined in DejaGnu's dg
-test
, needed by check
-flags.
270 upvar dg
-extra
-tool
-flags dg
-extra
-tool
-flags
271 upvar tool_flags tool_flags
273 if [check
-flags $
args] {
274 upvar dg
-do-what dg
-do-what
275 set dg
-do-what
[list
[lindex $
{dg
-do-what
} 0] "N" "P"]
280 # Like check_conditional_xfail
, but callable from a dg test.
282 proc dg
-xfail
-if { args } {
283 # Don
't change anything if we're already skipping the test.
284 upvar dg
-do-what dg
-do-what
285 if { [lindex $
{dg
-do-what
} 1] == "N" } {
289 set args [lreplace $
args 0 0]
290 set selector
[list target
[lindex $
args 1]]
291 if { [dg
-process
-target $selector
] == "S" } {
292 global compiler_conditional_xfail_data
293 set compiler_conditional_xfail_data
[lreplace $
args 1 1 "*-*-*"]
297 # Like dg
-xfail
-if but
for the
execute step.
299 proc dg
-xfail
-run
-if { args } {
300 # Don
't bother if we're already skipping the test.
301 upvar dg
-do-what dg
-do-what
302 if { [lindex $
{dg
-do-what
} 1] == "N" } {
306 set args [lreplace $
args 0 0]
308 set selector
[list target
[lindex $
args 1]]
309 if { [dg
-process
-target $selector
] == "S" } {
310 # These are defined in DejaGnu
's dg-test, needed by check-flags.
311 upvar dg-extra-tool-flags dg-extra-tool-flags
312 upvar tool_flags tool_flags
314 if [check-flags $args] {
315 upvar dg-do-what dg-do-what
316 set dg-do-what [list [lindex ${dg-do-what} 0] "S" "F"]
321 # Record whether the program is expected to return a nonzero status.
325 proc dg-shouldfail { args } {
326 # Don't bother
if we
're already skipping the test.
327 upvar dg-do-what dg-do-what
328 if { [lindex ${dg-do-what} 1] == "N" } {
334 set args [lreplace $args 0 0]
335 if { [llength $args] > 1 } {
336 set selector [list target [lindex $args 1]]
337 if { [dg-process-target $selector] == "S" } {
338 # The target matches, now check the flags. These variables
339 # are defined in DejaGnu's dg
-test
, needed by check
-flags.
340 upvar dg
-extra
-tool
-flags dg
-extra
-tool
-flags
341 upvar tool_flags tool_flags
343 if [check
-flags $
args] {
352 # Intercept the
call to the DejaGnu version of dg
-process
-target to
353 # support use of an effective
-target keyword in place of a list of
354 # target triplets to xfail or skip a test.
356 # selector is one of
:
357 # xfail target
-triplet
-1 ...
358 # xfail effective
-target
-keyword
359 # xfail selector
-expression
360 # target target
-triplet
-1 ...
361 # target effective
-target
-keyword
362 # target selector
-expression
364 #
For a target list the result is
"S" if the target is selected, "N" otherwise.
365 #
For an xfail list the result is
"F" if the target is affected, "P" otherwise.
367 # A selector expression appears within curly braces and uses a single logical
368 # operator
: !, &&, or ||. An operand is another selector expression
, an
369 # effective
-target keyword
, or a list of target triplets within quotes or
372 if { [info procs saved
-dg
-process
-target
] == [list
] } {
373 rename dg
-process
-target saved
-dg
-process
-target
375 # Evaluate an operand within a selector expression.
376 proc selector_opd
{ op
} {
377 set selector
"target"
379 set answer
[ expr
{ [dg
-process
-target $selector
] == "S" } ]
380 verbose
"selector_opd: `$op' $answer" 2
384 # Evaluate a target triplet list within a selector expression.
385 # Unlike other operands
, this needs to be expanded from a list to
386 # the same string as
"target".
387 proc selector_list
{ op
} {
388 set selector
"target [join $op]"
389 set answer
[ expr
{ [dg
-process
-target $selector
] == "S" } ]
390 verbose
"selector_list: `$op' $answer" 2
394 # Evaluate a selector expression.
395 proc selector_expression
{ exp
} {
396 if { [llength $exp
] == 2 } {
397 if [string match
"!" [lindex $exp 0]] {
398 set op1
[lindex $exp
1]
399 set answer
[expr
{ ! [selector_opd $op1
] }]
401 # Assume it
's a list of target triplets.
402 set answer [selector_list $exp]
404 } elseif { [llength $exp] == 3 } {
405 set op1 [lindex $exp 0]
406 set opr [lindex $exp 1]
407 set op2 [lindex $exp 2]
408 if [string match "&&" $opr] {
409 set answer [expr { [selector_opd $op1] && [selector_opd $op2] }]
410 } elseif [string match "||" $opr] {
411 set answer [expr { [selector_opd $op1] || [selector_opd $op2] }]
413 # Assume it's a list of target triplets.
414 set answer
[selector_list $exp
]
417 # Assume it
's a list of target triplets.
418 set answer [selector_list $exp]
421 verbose "selector_expression: `$exp' $answer
" 2
425 proc dg
-process
-target
{ args } {
426 verbose
"replacement dg-process-target: `$args'" 2
428 # Extract the
'what' keyword from the
argument list.
429 set selector
[string trim
[lindex $
args 0]]
430 if [regexp
"^xfail " $selector] {
432 } elseif
[regexp
"^target " $selector] {
435 error
"syntax error in target selector \"$selector\""
438 # Extract the rest of the list
, which might be a keyword.
439 regsub
"^${what}" $selector "" rest
440 set rest
[string trim $rest
]
442 if [is
-effective
-target
-keyword $rest
] {
443 # The selector is an effective target keyword.
444 if [is
-effective
-target $rest
] {
445 return [expr
{ $what
== "xfail" ? "F" : "S" }]
447 return [expr
{ $what
== "xfail" ? "P" : "N" }]
451 if [string match
"{*}" $rest] {
452 if [selector_expression
[lindex $rest
0]] {
453 return [expr
{ $what
== "xfail" ? "F" : "S" }]
455 return [expr
{ $what
== "xfail" ? "P" : "N" }]
459 # The selector is not an effective
-target keyword
, so process
460 # the list of target triplets.
461 return [saved
-dg
-process
-target $selector
]