]>
Commit | Line | Data |
---|---|---|
92456a4e | 1 | # Copyright (C) 2003, 2005, 2008, 2009, 2010, 2011, 2014, 2019 Free Software Foundation, Inc. |
8a6b509e AT |
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 | |
748086b7 | 5 | # the Free Software Foundation; either version 3 of the License, or |
8a6b509e | 6 | # (at your option) any later version. |
7a54c850 | 7 | # |
8a6b509e AT |
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. | |
7a54c850 | 12 | # |
8a6b509e | 13 | # You should have received a copy of the GNU General Public License |
748086b7 JJ |
14 | # along with this program; see the file COPYING3. If not see |
15 | # <http://www.gnu.org/licenses/>. | |
8a6b509e | 16 | |
fdc69597 | 17 | proc load_gcc_lib { filename } { |
4824ed41 L |
18 | global srcdir loaded_libs |
19 | load_file $srcdir/../../gcc/testsuite/lib/$filename | |
20 | set loaded_libs($filename) "" | |
fdc69597 RE |
21 | } |
22 | ||
8a6b509e AT |
23 | load_lib dg.exp |
24 | load_lib libgloss.exp | |
4824ed41 L |
25 | load_gcc_lib target-supports.exp |
26 | load_gcc_lib target-supports-dg.exp | |
1df8e834 | 27 | load_gcc_lib target-libpath.exp |
fdc69597 | 28 | load_gcc_lib wrapper.exp |
70d8f2a1 | 29 | |
92456a4e L |
30 | proc check_effective_target_gccbug { } { |
31 | global has_gccbug | |
32 | return $has_gccbug | |
33 | } | |
34 | ||
35 | # Return 1 if the target matches the effective target 'arg', 0 otherwise. | |
36 | # This can be used with any check_* proc that takes no argument and | |
37 | # returns only 1 or 0. It could be used with check_* procs that take | |
38 | # arguments with keywords that pass particular arguments. | |
39 | ||
40 | proc is-effective-target { arg } { | |
41 | global et_index | |
42 | set selected 0 | |
43 | if { ![info exists et_index] } { | |
44 | # Initialize the effective target index that is used in some | |
45 | # check_effective_target_* procs. | |
46 | set et_index 0 | |
47 | } | |
48 | if { [info procs check_effective_target_${arg}] != [list] } { | |
49 | set selected [check_effective_target_${arg}] | |
50 | } else { | |
51 | error "unknown effective target keyword `$arg'" | |
52 | } | |
53 | verbose "is-effective-target: $arg $selected" 2 | |
54 | return $selected | |
55 | } | |
56 | ||
57 | proc is-effective-target-keyword { arg } { | |
58 | if { [info procs check_effective_target_${arg}] != [list] } { | |
59 | return 1 | |
60 | } else { | |
61 | return 0 | |
62 | } | |
63 | } | |
64 | ||
65 | # Intercept the call to the DejaGnu version of dg-process-target to | |
66 | # support use of an effective-target keyword in place of a list of | |
67 | # target triplets to xfail or skip a test. | |
68 | # | |
69 | # The argument to dg-process-target is the keyword "target" or "xfail" | |
70 | # followed by a selector: | |
71 | # target-triplet-1 ... | |
72 | # effective-target-keyword | |
73 | # selector-expression | |
74 | # | |
75 | # For a target list the result is "S" if the target is selected, "N" otherwise. | |
76 | # For an xfail list the result is "F" if the target is affected, "P" otherwise. | |
77 | ||
78 | # In contexts that allow either "target" or "xfail" the argument can be | |
79 | # target selector1 xfail selector2 | |
80 | # which returns "N" if selector1 is not selected, otherwise the result of | |
81 | # "xfail selector2". | |
82 | # | |
83 | # A selector expression appears within curly braces and uses a single logical | |
84 | # operator: !, &&, or ||. An operand is another selector expression, an | |
85 | # effective-target keyword, or a list of target triplets within quotes or | |
86 | # curly braces. | |
87 | ||
88 | if { [info procs saved-dg-process-target] == [list] } { | |
89 | rename dg-process-target saved-dg-process-target | |
90 | ||
91 | # Evaluate an operand within a selector expression. | |
92 | proc selector_opd { op } { | |
93 | set selector "target" | |
94 | lappend selector $op | |
95 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
96 | verbose "selector_opd: `$op' $answer" 2 | |
97 | return $answer | |
98 | } | |
99 | ||
100 | # Evaluate a target triplet list within a selector expression. | |
101 | # Unlike other operands, this needs to be expanded from a list to | |
102 | # the same string as "target". | |
103 | proc selector_list { op } { | |
104 | set selector "target [join $op]" | |
105 | set answer [ expr { [dg-process-target $selector] == "S" } ] | |
106 | verbose "selector_list: `$op' $answer" 2 | |
107 | return $answer | |
108 | } | |
109 | ||
110 | # Evaluate a selector expression. | |
111 | proc selector_expression { exp } { | |
112 | if { [llength $exp] == 2 } { | |
113 | if [string match "!" [lindex $exp 0]] { | |
114 | set op1 [lindex $exp 1] | |
115 | set answer [expr { ! [selector_opd $op1] }] | |
116 | } else { | |
117 | # Assume it's a list of target triplets. | |
118 | set answer [selector_list $exp] | |
119 | } | |
120 | } elseif { [llength $exp] == 3 } { | |
121 | set op1 [lindex $exp 0] | |
122 | set opr [lindex $exp 1] | |
123 | set op2 [lindex $exp 2] | |
124 | if [string match "&&" $opr] { | |
125 | set answer [expr { [selector_opd $op1] && [selector_opd $op2] }] | |
126 | } elseif [string match "||" $opr] { | |
127 | set answer [expr { [selector_opd $op1] || [selector_opd $op2] }] | |
128 | } else { | |
129 | # Assume it's a list of target triplets. | |
130 | set answer [selector_list $exp] | |
131 | } | |
132 | } else { | |
133 | # Assume it's a list of target triplets. | |
134 | set answer [selector_list $exp] | |
135 | } | |
136 | ||
137 | verbose "selector_expression: `$exp' $answer" 2 | |
138 | return $answer | |
139 | } | |
140 | ||
141 | # Evaluate "target selector" or "xfail selector". | |
142 | ||
143 | proc dg-process-target-1 { args } { | |
144 | verbose "dg-process-target-1: `$args'" 2 | |
145 | ||
146 | # Extract the 'what' keyword from the argument list. | |
147 | set selector [string trim [lindex $args 0]] | |
148 | if [regexp "^xfail " $selector] { | |
149 | set what "xfail" | |
150 | } elseif [regexp "^target " $selector] { | |
151 | set what "target" | |
152 | } else { | |
153 | error "syntax error in target selector \"$selector\"" | |
154 | } | |
155 | ||
156 | # Extract the rest of the list, which might be a keyword. | |
157 | regsub "^${what}" $selector "" rest | |
158 | set rest [string trim $rest] | |
159 | ||
160 | if [is-effective-target-keyword $rest] { | |
161 | # The selector is an effective target keyword. | |
162 | if [is-effective-target $rest] { | |
163 | return [expr { $what == "xfail" ? "F" : "S" }] | |
164 | } else { | |
165 | return [expr { $what == "xfail" ? "P" : "N" }] | |
166 | } | |
167 | } | |
168 | ||
169 | if [string match "{*}" $rest] { | |
170 | if [selector_expression [lindex $rest 0]] { | |
171 | return [expr { $what == "xfail" ? "F" : "S" }] | |
172 | } else { | |
173 | return [expr { $what == "xfail" ? "P" : "N" }] | |
174 | } | |
175 | } | |
176 | ||
177 | # The selector is not an effective-target keyword, so process | |
178 | # the list of target triplets. | |
179 | return [saved-dg-process-target $selector] | |
180 | } | |
181 | ||
182 | # Intercept calls to the DejaGnu function. In addition to | |
183 | # processing "target selector" or "xfail selector", handle | |
184 | # "target selector1 xfail selector2". | |
185 | ||
186 | proc dg-process-target { args } { | |
187 | verbose "replacement dg-process-target: `$args'" 2 | |
188 | ||
189 | set selector [string trim [lindex $args 0]] | |
190 | ||
191 | # If the argument list contains both 'target' and 'xfail', | |
192 | # process 'target' and, if that succeeds, process 'xfail'. | |
193 | if [regexp "^target .* xfail .*" $selector] { | |
194 | set xfail_index [string first "xfail" $selector] | |
195 | set xfail_selector [string range $selector $xfail_index end] | |
196 | set target_selector [string range $selector 0 [expr $xfail_index-1]] | |
197 | set target_selector [string trim $target_selector] | |
198 | if { [dg-process-target-1 $target_selector] == "N" } { | |
199 | return "N" | |
200 | } | |
201 | return [dg-process-target-1 $xfail_selector] | |
202 | ||
203 | } | |
204 | return [dg-process-target-1 $selector] | |
205 | } | |
206 | } | |
70d8f2a1 | 207 | |
8a6b509e AT |
208 | # Define libffi callbacks for dg.exp. |
209 | ||
210 | proc libffi-dg-test-1 { target_compile prog do_what extra_tool_flags } { | |
727e729b HPN |
211 | |
212 | # To get all \n in dg-output test strings to match printf output | |
213 | # in a system that outputs it as \015\012 (i.e. not just \012), we | |
214 | # need to change all \n into \r?\n. As there is no dejagnu flag | |
215 | # or hook to do that, we simply change the text being tested. | |
216 | # Unfortunately, we have to know that the variable is called | |
217 | # dg-output-text and lives in the caller of libffi-dg-test, which | |
218 | # is two calls up. Overriding proc dg-output would be longer and | |
219 | # would necessarily have the same assumption. | |
220 | upvar 2 dg-output-text output_match | |
221 | ||
222 | if { [llength $output_match] > 1 } { | |
fc0ad8d9 | 223 | regsub -all "\n" [lindex $output_match 1] "\r?\n" x |
727e729b HPN |
224 | set output_match [lreplace $output_match 1 1 $x] |
225 | } | |
226 | ||
8a6b509e AT |
227 | # Set up the compiler flags, based on what we're going to do. |
228 | ||
229 | set options [list] | |
230 | switch $do_what { | |
231 | "compile" { | |
232 | set compile_type "assembly" | |
233 | set output_file "[file rootname [file tail $prog]].s" | |
234 | } | |
235 | "link" { | |
236 | set compile_type "executable" | |
237 | set output_file "[file rootname [file tail $prog]].exe" | |
238 | # The following line is needed for targets like the i960 where | |
239 | # the default output file is b.out. Sigh. | |
240 | } | |
241 | "run" { | |
242 | set compile_type "executable" | |
243 | # FIXME: "./" is to cope with "." not being in $PATH. | |
244 | # Should this be handled elsewhere? | |
245 | # YES. | |
246 | set output_file "./[file rootname [file tail $prog]].exe" | |
247 | # This is the only place where we care if an executable was | |
248 | # created or not. If it was, dg.exp will try to run it. | |
249 | remote_file build delete $output_file; | |
250 | } | |
251 | default { | |
252 | perror "$do_what: not a valid dg-do keyword" | |
253 | return "" | |
254 | } | |
255 | } | |
256 | ||
257 | if { $extra_tool_flags != "" } { | |
258 | lappend options "additional_flags=$extra_tool_flags" | |
259 | } | |
260 | ||
261 | set comp_output [libffi_target_compile "$prog" "$output_file" "$compile_type" $options]; | |
262 | ||
263 | ||
264 | return [list $comp_output $output_file] | |
265 | } | |
266 | ||
267 | ||
268 | proc libffi-dg-test { prog do_what extra_tool_flags } { | |
269 | return [libffi-dg-test-1 target_compile $prog $do_what $extra_tool_flags] | |
270 | } | |
271 | ||
92456a4e L |
272 | proc libffi-dg-prune { target_triplet text } { |
273 | # We get this with some qemu emulated systems (eg. ppc64le-linux-gnu) | |
274 | regsub -all "(^|\n)\[^\n\]*unable to perform all requested operations" $text "" text | |
275 | return $text | |
276 | } | |
277 | ||
8a6b509e AT |
278 | proc libffi-init { args } { |
279 | global gluefile wrap_flags; | |
280 | global srcdir | |
281 | global blddirffi | |
fdc69597 | 282 | global objdir |
4824ed41 | 283 | global blddircxx |
8a6b509e | 284 | global TOOL_OPTIONS |
fc9051dd | 285 | global tool |
8a6b509e | 286 | global libffi_include |
7a54c850 | 287 | global libffi_link_flags |
8a6b509e | 288 | global tool_root_dir |
1df8e834 | 289 | global ld_library_path |
b1760f7f | 290 | global compiler_vendor |
8a6b509e | 291 | |
4824ed41 | 292 | set blddirffi [lookfor_file [get_multilibs] libffi] |
92456a4e | 293 | verbose "libffi $blddirffi" |
4824ed41 L |
294 | set blddircxx [lookfor_file [get_multilibs] libstdc++-v3] |
295 | verbose "libstdc++ $blddircxx" | |
296 | ||
297 | set compiler_vendor "gnu" | |
b1760f7f | 298 | |
92456a4e L |
299 | if { [string match $compiler_vendor "gnu"] } { |
300 | set gccdir [lookfor_file $tool_root_dir gcc/libgcc.a] | |
301 | if {$gccdir != ""} { | |
302 | set gccdir [file dirname $gccdir] | |
303 | } | |
304 | verbose "gccdir $gccdir" | |
305 | ||
306 | set ld_library_path "." | |
307 | append ld_library_path ":${gccdir}" | |
308 | ||
309 | set compiler "${gccdir}/xgcc" | |
310 | if { [is_remote host] == 0 && [which $compiler] != 0 } { | |
311 | foreach i "[exec $compiler --print-multi-lib]" { | |
312 | set mldir "" | |
313 | regexp -- "\[a-z0-9=_/\.-\]*;" $i mldir | |
314 | set mldir [string trimright $mldir "\;@"] | |
315 | if { "$mldir" == "." } { | |
316 | continue | |
317 | } | |
318 | if { [llength [glob -nocomplain ${gccdir}/${mldir}/libgcc_s*.so.*]] >= 1 } { | |
319 | append ld_library_path ":${gccdir}/${mldir}" | |
320 | } | |
33cde516 | 321 | } |
92456a4e | 322 | } |
33d1a550 | 323 | } |
b1760f7f | 324 | |
8a6b509e | 325 | # add the library path for libffi. |
33cde516 | 326 | append ld_library_path ":${blddirffi}/.libs" |
4824ed41 L |
327 | # add the library path for libstdc++ as well. |
328 | append ld_library_path ":${blddircxx}/src/.libs" | |
8a6b509e AT |
329 | |
330 | verbose "ld_library_path: $ld_library_path" | |
331 | ||
332 | # Point to the Libffi headers in libffi. | |
333 | set libffi_include "${blddirffi}/include" | |
334 | verbose "libffi_include $libffi_include" | |
7a54c850 | 335 | |
8a6b509e AT |
336 | set libffi_dir "${blddirffi}/.libs" |
337 | verbose "libffi_dir $libffi_dir" | |
338 | if { $libffi_dir != "" } { | |
339 | set libffi_dir [file dirname ${libffi_dir}] | |
a0673ec5 IS |
340 | if [istarget *-*-darwin*] { |
341 | set libffi_link_flags "-B${libffi_dir}/.libs" | |
342 | lappend libffi_link_flags "-B${blddircxx}/src/.libs" | |
343 | } else { | |
344 | set libffi_link_flags "-L${libffi_dir}/.libs" | |
345 | lappend libffi_link_flags "-L${blddircxx}/src/.libs" | |
346 | } | |
8a6b509e | 347 | } |
7a54c850 | 348 | |
1df8e834 | 349 | set_ld_library_path_env_vars |
fdc69597 RE |
350 | libffi_maybe_build_wrapper "${objdir}/testglue.o" |
351 | } | |
352 | ||
353 | proc libffi_exit { } { | |
354 | global gluefile; | |
355 | ||
356 | if [info exists gluefile] { | |
357 | file_on_build delete $gluefile; | |
358 | unset gluefile; | |
359 | } | |
8a6b509e AT |
360 | } |
361 | ||
362 | proc libffi_target_compile { source dest type options } { | |
363 | global gluefile wrap_flags; | |
364 | global srcdir | |
365 | global blddirffi | |
366 | global TOOL_OPTIONS | |
8a6b509e AT |
367 | global libffi_link_flags |
368 | global libffi_include | |
70d8f2a1 | 369 | global target_triplet |
92456a4e | 370 | global compiler_vendor |
8a6b509e AT |
371 | |
372 | if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { | |
373 | lappend options "libs=${gluefile}" | |
374 | lappend options "ldflags=$wrap_flags" | |
375 | } | |
376 | ||
377 | # TOOL_OPTIONS must come first, so that it doesn't override testcase | |
378 | # specific options. | |
379 | if [info exists TOOL_OPTIONS] { | |
92456a4e | 380 | lappend options "additional_flags=$TOOL_OPTIONS" |
8a6b509e AT |
381 | } |
382 | ||
eb26c76c | 383 | # search for ffi_mips.h in srcdir, too |
5196736e | 384 | lappend options "additional_flags=-I${libffi_include} -I${srcdir}/../include -I${libffi_include}/.." |
8a6b509e | 385 | lappend options "additional_flags=${libffi_link_flags}" |
9e6c3ecb | 386 | |
7bbcc286 AT |
387 | # Darwin needs a stack execution allowed flag. |
388 | ||
389 | if { [istarget "*-*-darwin9*"] || [istarget "*-*-darwin1*"] | |
a0673ec5 | 390 | || [istarget "x86_64-*-darwin2*"] } { |
7bbcc286 | 391 | lappend options "additional_flags=-Wl,-allow_stack_execute" |
e4703bd0 | 392 | lappend options "additional_flags=-Wl,-search_paths_first" |
7bbcc286 AT |
393 | } |
394 | ||
0363db46 GK |
395 | # If you're building the compiler with --prefix set to a place |
396 | # where it's not yet installed, then the linker won't be able to | |
397 | # find the libgcc used by libffi.dylib. We could pass the | |
398 | # -dylib_file option, but that's complicated, and it's much easier | |
399 | # to just make the linker find libgcc using -L options. | |
400 | if { [string match "*-*-darwin*" $target_triplet] } { | |
401 | lappend options "libs= -shared-libgcc" | |
9e6c3ecb AT |
402 | } |
403 | ||
cb14fcb8 AT |
404 | if { [string match "*-*-openbsd*" $target_triplet] } { |
405 | lappend options "libs= -lpthread" | |
406 | } | |
407 | ||
9e6c3ecb | 408 | lappend options "libs= -lffi" |
70d8f2a1 | 409 | |
b4b575ce AG |
410 | if { [string match "aarch64*-*-linux*" $target_triplet] } { |
411 | lappend options "libs= -lpthread" | |
412 | } | |
413 | ||
92456a4e | 414 | if { [string match "*.cc" $source] } { |
4824ed41 | 415 | lappend options "ldflags=-shared-libgcc -lstdc++" |
92456a4e L |
416 | } |
417 | ||
418 | if { [string match "arc*-*-linux*" $target_triplet] } { | |
419 | lappend options "libs= -lpthread" | |
420 | } | |
421 | ||
8a6b509e AT |
422 | verbose "options: $options" |
423 | return [target_compile $source $dest $type $options] | |
424 | } | |
425 | ||
b1760f7f RH |
426 | # TEST should be a preprocessor condition. Returns true if it holds. |
427 | proc libffi_feature_test { test } { | |
7e5a3c96 | 428 | set src "ffitest[pid].c" |
b1760f7f RH |
429 | |
430 | set f [open $src "w"] | |
431 | puts $f "#include <ffi.h>" | |
432 | puts $f $test | |
7e5a3c96 TS |
433 | puts $f "/* OK */" |
434 | puts $f "#else" | |
435 | puts $f "# error Failed $test" | |
b1760f7f RH |
436 | puts $f "#endif" |
437 | close $f | |
438 | ||
7e5a3c96 | 439 | set lines [libffi_target_compile $src /dev/null assembly ""] |
b1760f7f RH |
440 | file delete $src |
441 | ||
7e5a3c96 | 442 | return [string match "" $lines] |
b1760f7f RH |
443 | } |
444 | ||
8a6b509e AT |
445 | # Utility routines. |
446 | ||
447 | # | |
448 | # search_for -- looks for a string match in a file | |
449 | # | |
450 | proc search_for { file pattern } { | |
451 | set fd [open $file r] | |
452 | while { [gets $fd cur_line]>=0 } { | |
453 | if [string match "*$pattern*" $cur_line] then { | |
454 | close $fd | |
455 | return 1 | |
456 | } | |
457 | } | |
458 | close $fd | |
459 | return 0 | |
460 | } | |
461 | ||
462 | # Modified dg-runtest that can cycle through a list of optimization options | |
463 | # as c-torture does. | |
b1760f7f | 464 | proc libffi-dg-runtest { testcases default-extra-flags } { |
8a6b509e AT |
465 | global runtests |
466 | ||
467 | foreach test $testcases { | |
7a54c850 | 468 | # If we're only testing specific files and this isn't one of |
8a6b509e AT |
469 | # them, skip it. |
470 | if ![runtest_file_p $runtests $test] { | |
471 | continue | |
7a54c850 | 472 | } |
8a6b509e AT |
473 | |
474 | # Look for a loop within the source code - if we don't find one, | |
475 | # don't pass -funroll[-all]-loops. | |
476 | global torture_with_loops torture_without_loops | |
477 | if [expr [search_for $test "for*("]+[search_for $test "while*("]] { | |
478 | set option_list $torture_with_loops | |
479 | } else { | |
480 | set option_list $torture_without_loops | |
481 | } | |
482 | ||
483 | set nshort [file tail [file dirname $test]]/[file tail $test] | |
484 | ||
b1760f7f RH |
485 | foreach flags $option_list { |
486 | verbose "Testing $nshort, $flags" 1 | |
487 | dg-test $test $flags ${default-extra-flags} | |
8a6b509e AT |
488 | } |
489 | } | |
490 | } | |
491 | ||
b1760f7f RH |
492 | proc run-many-tests { testcases extra_flags } { |
493 | global compiler_vendor | |
92456a4e L |
494 | global has_gccbug |
495 | global env | |
b1760f7f RH |
496 | switch $compiler_vendor { |
497 | "clang" { | |
92456a4e L |
498 | set common "-W -Wall" |
499 | if [info exists env(LIBFFI_TEST_OPTIMIZATION)] { | |
500 | set optimizations [ list $env(LIBFFI_TEST_OPTIMIZATION) ] | |
501 | } else { | |
502 | set optimizations { "-O0" "-O2" } | |
503 | } | |
b1760f7f RH |
504 | } |
505 | "gnu" { | |
506 | set common "-W -Wall -Wno-psabi" | |
92456a4e L |
507 | if [info exists env(LIBFFI_TEST_OPTIMIZATION)] { |
508 | set optimizations [ list $env(LIBFFI_TEST_OPTIMIZATION) ] | |
509 | } else { | |
510 | set optimizations { "-O0" "-O2" } | |
511 | } | |
b1760f7f RH |
512 | } |
513 | default { | |
514 | # Assume we are using the vendor compiler. | |
515 | set common "" | |
92456a4e L |
516 | if [info exists env(LIBFFI_TEST_OPTIMIZATION)] { |
517 | set optimizations [ list $env(LIBFFI_TEST_OPTIMIZATION) ] | |
518 | } else { | |
519 | set optimizations { "" } | |
520 | } | |
b1760f7f RH |
521 | } |
522 | } | |
523 | ||
92456a4e L |
524 | info exists env(LD_LIBRARY_PATH) |
525 | ||
b1760f7f RH |
526 | set targetabis { "" } |
527 | if [string match $compiler_vendor "gnu"] { | |
92456a4e | 528 | if [libffi_feature_test "#ifdef __i386__"] { |
b1760f7f RH |
529 | set targetabis { |
530 | "" | |
531 | "-DABI_NUM=FFI_STDCALL -DABI_ATTR=__STDCALL__" | |
532 | "-DABI_NUM=FFI_THISCALL -DABI_ATTR=__THISCALL__" | |
533 | "-DABI_NUM=FFI_FASTCALL -DABI_ATTR=__FASTCALL__" | |
534 | } | |
92456a4e L |
535 | } elseif { [istarget "x86_64-*-*"] \ |
536 | && [libffi_feature_test "#if !defined __ILP32__ \ | |
537 | && !defined __i386__"] } { | |
538 | set targetabis { | |
539 | "" | |
540 | "-DABI_NUM=FFI_GNUW64 -DABI_ATTR=__MSABI__" | |
541 | } | |
b1760f7f RH |
542 | } |
543 | } | |
544 | ||
545 | set common [ concat $common $extra_flags ] | |
546 | foreach test $testcases { | |
547 | set testname [file tail $test] | |
548 | if [search_for $test "ABI_NUM"] { | |
549 | set abis $targetabis | |
550 | } else { | |
551 | set abis { "" } | |
552 | } | |
553 | foreach opt $optimizations { | |
554 | foreach abi $abis { | |
555 | set options [concat $common $opt $abi] | |
92456a4e L |
556 | set has_gccbug false; |
557 | if { [string match $compiler_vendor "gnu"] \ | |
558 | && [string match "*MSABI*" $abi] \ | |
559 | && ( ( [string match "*DGTEST=57 *" $common] \ | |
560 | && [string match "*call.c*" $testname] ) \ | |
561 | || ( [string match "*DGTEST=54 *" $common] \ | |
562 | && [string match "*callback*" $testname] ) \ | |
563 | || [string match "*DGTEST=55 *" $common] \ | |
564 | || [string match "*DGTEST=56 *" $common] ) } then { | |
565 | if [libffi_feature_test "#if (__GNUC__ < 9) || ((__GNUC__ == 9) && (__GNUC_MINOR__ < 3))"] { | |
566 | set has_gccbug true; | |
567 | } | |
568 | } | |
569 | verbose "Testing $testname, $options" 1 | |
570 | verbose "has_gccbug = $has_gccbug" 1 | |
571 | dg-test $test $options "" | |
b1760f7f RH |
572 | } |
573 | } | |
574 | } | |
575 | } | |
8a6b509e AT |
576 | |
577 | # Like check_conditional_xfail, but callable from a dg test. | |
578 | ||
579 | proc dg-xfail-if { args } { | |
580 | set args [lreplace $args 0 0] | |
581 | set selector "target [join [lindex $args 1]]" | |
582 | if { [dg-process-target $selector] == "S" } { | |
583 | global compiler_conditional_xfail_data | |
584 | set compiler_conditional_xfail_data $args | |
585 | } | |
586 | } | |
587 | ||
46e0720d CLT |
588 | proc check-flags { args } { |
589 | ||
590 | # The args are within another list; pull them out. | |
591 | set args [lindex $args 0] | |
592 | ||
593 | # The next two arguments are optional. If they were not specified, | |
594 | # use the defaults. | |
595 | if { [llength $args] == 2 } { | |
596 | lappend $args [list "*"] | |
597 | } | |
598 | if { [llength $args] == 3 } { | |
599 | lappend $args [list ""] | |
600 | } | |
601 | ||
602 | # If the option strings are the defaults, or the same as the | |
603 | # defaults, there is no need to call check_conditional_xfail to | |
604 | # compare them to the actual options. | |
605 | if { [string compare [lindex $args 2] "*"] == 0 | |
606 | && [string compare [lindex $args 3] "" ] == 0 } { | |
607 | set result 1 | |
608 | } else { | |
609 | # The target list might be an effective-target keyword, so replace | |
610 | # the original list with "*-*-*", since we already know it matches. | |
611 | set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]] | |
612 | } | |
613 | ||
614 | return $result | |
615 | } | |
616 | ||
617 | proc dg-skip-if { args } { | |
618 | # Verify the number of arguments. The last two are optional. | |
619 | set args [lreplace $args 0 0] | |
620 | if { [llength $args] < 2 || [llength $args] > 4 } { | |
621 | error "dg-skip-if 2: need 2, 3, or 4 arguments" | |
622 | } | |
623 | ||
624 | # Don't bother if we're already skipping the test. | |
625 | upvar dg-do-what dg-do-what | |
626 | if { [lindex ${dg-do-what} 1] == "N" } { | |
627 | return | |
628 | } | |
629 | ||
630 | set selector [list target [lindex $args 1]] | |
631 | if { [dg-process-target $selector] == "S" } { | |
632 | if [check-flags $args] { | |
633 | upvar dg-do-what dg-do-what | |
634 | set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"] | |
635 | } | |
636 | } | |
637 | } | |
8a6b509e AT |
638 | |
639 | # We need to make sure that additional_files and additional_sources | |
640 | # are both cleared out after every test. It is not enough to clear | |
641 | # them out *before* the next test run because gcc-target-compile gets | |
642 | # run directly from some .exp files (outside of any test). (Those | |
7a54c850 | 643 | # uses should eventually be eliminated.) |
8a6b509e AT |
644 | |
645 | # Because the DG framework doesn't provide a hook that is run at the | |
646 | # end of a test, we must replace dg-test with a wrapper. | |
647 | ||
648 | if { [info procs saved-dg-test] == [list] } { | |
649 | rename dg-test saved-dg-test | |
650 | ||
651 | proc dg-test { args } { | |
652 | global additional_files | |
653 | global additional_sources | |
654 | global errorInfo | |
655 | ||
656 | if { [ catch { eval saved-dg-test $args } errmsg ] } { | |
657 | set saved_info $errorInfo | |
658 | set additional_files "" | |
659 | set additional_sources "" | |
660 | error $errmsg $saved_info | |
661 | } | |
662 | set additional_files "" | |
663 | set additional_sources "" | |
664 | } | |
665 | } | |
666 | ||
667 | # Local Variables: | |
668 | # tcl-indent-level:4 | |
70d8f2a1 | 669 | # End: |