]>
Commit | Line | Data |
---|---|---|
1 | # Copyright (C) 2009-2020 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 3 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 GCC; see the file COPYING3. If not see | |
15 | # <http://www.gnu.org/licenses/>. | |
16 | ||
17 | # Contributed by Diego Novillo <dnovillo@google.com> | |
18 | ||
19 | # A subroutine of lto_handle_diagnostics: check TEXT for the expected | |
20 | # diagnostics for one specific source file, issuing PASS/FAIL results. | |
21 | # Return TEXT, stripped of any diagnostics that were handled. | |
22 | # | |
23 | # NAME is the testcase name to use when reporting PASS/FAIL results. | |
24 | # FILENAME is the name (with full path) of the file we're interested in. | |
25 | # MESSAGES_FOR_FILE is a list of expected messages, akin to DejaGnu's | |
26 | # "dg-messages" variable. | |
27 | # TEXT is the textual output from the LTO link. | |
28 | ||
29 | proc lto_handle_diagnostics_for_file { name filename messages_for_file text } { | |
30 | global dg-linenum-format | |
31 | ||
32 | set filename_without_path [file tail $filename] | |
33 | ||
34 | # This loop is adapted from the related part of DejaGnu's dg-test, | |
35 | # with changes as detailed below to cope with the LTO case. | |
36 | ||
37 | foreach i ${messages_for_file} { | |
38 | verbose "Scanning for message: $i" 4 | |
39 | ||
40 | # Remove all error messages for the line [lindex $i 0] | |
41 | # in the source file. If we find any, success! | |
42 | set line [lindex $i 0] | |
43 | set pattern [lindex $i 2] | |
44 | set comment [lindex $i 3] | |
45 | verbose "line: $line" 4 | |
46 | verbose "pattern: $pattern" 4 | |
47 | verbose "comment: $comment" 4 | |
48 | #send_user "Before:\n$text\n" | |
49 | ||
50 | # Unlike dg-test, we use $filename_without_path in this pattern. | |
51 | # This is to ensure that we have the correct file/line combination. | |
52 | # This imposes the restriction that the filename can't contain | |
53 | # any regexp control characters. We have to strip the path, since | |
54 | # e.g. the '+' in "g++.dg" wouldn't be valid. | |
55 | set pat "(^|\n)(\[^\n\]+$filename_without_path$line\[^\n\]*($pattern)\[^\n\]*\n?)+" | |
56 | if {[regsub -all $pat $text "\n" text]} { | |
57 | set text [string trimleft $text] | |
58 | set ok pass | |
59 | set uhoh fail | |
60 | } else { | |
61 | set ok fail | |
62 | set uhoh pass | |
63 | } | |
64 | #send_user "After:\n$text\n" | |
65 | ||
66 | # $line will either be a formatted line number or a number all by | |
67 | # itself. Delete the formatting. | |
68 | scan $line ${dg-linenum-format} line | |
69 | ||
70 | # Unlike dg-test, add the filename to the PASS/FAIL message (rather | |
71 | # than just the line number) so that the user can identify the | |
72 | # pertinent directive. | |
73 | set describe_where "$filename_without_path line $line" | |
74 | ||
75 | # Issue the PASS/FAIL, adding "LTO" to the messages (e.g. "LTO errors") | |
76 | # to distinguish them from the non-LTO case (in case we ever need to | |
77 | # support both). | |
78 | switch [lindex $i 1] { | |
79 | "ERROR" { | |
80 | $ok "$name $comment (test for LTO errors, $describe_where)" | |
81 | } | |
82 | "XERROR" { | |
83 | x$ok "$name $comment (test for LTO errors, $describe_where)" | |
84 | } | |
85 | "WARNING" { | |
86 | $ok "$name $comment (test for LTO warnings, $describe_where)" | |
87 | } | |
88 | "XWARNING" { | |
89 | x$ok "$name $comment (test for LTO warnings, $describe_where)" | |
90 | } | |
91 | "BOGUS" { | |
92 | $uhoh "$name $comment (test for LTO bogus messages, $describe_where)" | |
93 | } | |
94 | "XBOGUS" { | |
95 | x$uhoh "$name $comment (test for LTO bogus messages, $describe_where)" | |
96 | } | |
97 | "BUILD" { | |
98 | $uhoh "$name $comment (test for LTO build failure, $describe_where)" | |
99 | } | |
100 | "XBUILD" { | |
101 | x$uhoh "$name $comment (test for LTO build failure, $describe_where)" | |
102 | } | |
103 | "EXEC" { } | |
104 | "XEXEC" { } | |
105 | } | |
106 | } | |
107 | return $text | |
108 | } | |
109 | ||
110 | # Support for checking for link-time diagnostics: check for | |
111 | # the expected diagnostics within TEXT, issuing PASS/FAIL results. | |
112 | # Return TEXT, stripped of any diagnostics that were handled. | |
113 | # | |
114 | # TEXT is the textual output from the LTO link. | |
115 | ||
116 | proc lto_handle_diagnostics { text } { | |
117 | global testcase | |
118 | ||
119 | upvar dg-messages-by-file messages_by_file | |
120 | ||
121 | verbose "lto_handle_diagnostics: entry: $text" 2 | |
122 | ||
123 | if { ![array exists messages_by_file] } { | |
124 | error "lto_handle_diagnostics: messages_by_file not defined" | |
125 | } | |
126 | ||
127 | foreach src [lsort [array names messages_by_file]] { | |
128 | set dg-messages $messages_by_file($src) | |
129 | verbose " messages for $src: ${dg-messages}" 3 | |
130 | set text [lto_handle_diagnostics_for_file $testcase $src \ | |
131 | ${dg-messages} $text] | |
132 | } | |
133 | ||
134 | verbose "lto_handle_diagnostics: exit: $text" 2 | |
135 | ||
136 | return $text | |
137 | } | |
138 | ||
139 | # Prune messages that aren't useful. | |
140 | ||
141 | proc lto_prune_warns { text } { | |
142 | ||
143 | verbose "lto_prune_warns: entry: $text" 2 | |
144 | ||
145 | # Many tests that use visibility will still pass on platforms that don't support it. | |
146 | regsub -all "(^|\n)\[^\n\]*: warning: visibility attribute not supported in this configuration; ignored\[^\n\]*" $text "" text | |
147 | ||
148 | # Allow mixed-language LTO tests to pass with make check-c++0x | |
149 | regsub -all "(^|\n)\[^\n\]*: warning: command line option '-std=\[^\n\]*" $text "" text | |
150 | ||
151 | # And any stray location lines. | |
152 | regsub -all "(^|\n)\[^\n\]*: In function \[^\n\]*" $text "" text | |
153 | regsub -all "(^|\n)In file included from \[^\n\]*" $text "" text | |
154 | regsub -all "(^|\n)\[ \t\]*from \[^\n\]*" $text "" text | |
155 | ||
156 | # Sun ld warns about common symbols with differing sizes. Unlike GNU ld | |
157 | # --warn-common (off by default), they cannot be disabled. | |
158 | regsub -all "(^|\n)ld: warning: symbol \[`'\]\[^\n\]*' has differing sizes:" $text "" text | |
159 | regsub -all "(^|\n)\[ \t\]*\[\(\]file \[^\n\]* value=\[^\n\]*; file \[^\n\]* value=\[^\n\]*\[)\];" $text "" text | |
160 | regsub -all "(^|\n)\[ \t\]*\[^\n\]* definition taken" $text "" text | |
161 | ||
162 | # Ignore informational notes. | |
163 | regsub -all "(^|\n)\[^\n\]*: note: \[^\n\]*" $text "" text | |
164 | ||
165 | verbose "lto_prune_warns: exit: $text" 2 | |
166 | ||
167 | return $text | |
168 | } | |
169 | ||
170 | # lto_init -- called at the start of each subdir of tests | |
171 | ||
172 | proc lto_init { args } { | |
173 | global LTO_OPTIONS | |
174 | ||
175 | if {[info exists args] && $args == "no-mathlib"} { | |
176 | global board_info | |
177 | global saved_mathlib | |
178 | ||
179 | set dest [target_info name] | |
180 | if [board_info $dest exists mathlib] { | |
181 | set saved_mathlib [board_info $dest mathlib] | |
182 | } | |
183 | set board_info($dest,mathlib) " " | |
184 | } | |
185 | ||
186 | # Each test is run with the compiler options from this list. | |
187 | # The default option lists can be overridden by LTO_OPTIONS="[list | |
188 | # {opts_1} {opts_2}... {opts_n}]" where opts_i are lists of options. | |
189 | # You can put this in the environment before site.exp is written or | |
190 | # add it to site.exp directly. | |
191 | if ![info exists LTO_OPTIONS] { | |
192 | if [check_linker_plugin_available] { | |
193 | set LTO_OPTIONS [list \ | |
194 | {-O0 -flto -flto-partition=none -fuse-linker-plugin} \ | |
195 | {-O2 -flto -flto-partition=none -fuse-linker-plugin -fno-fat-lto-objects } \ | |
196 | {-O0 -flto -flto-partition=1to1 -fno-use-linker-plugin } \ | |
197 | {-O2 -flto -flto-partition=1to1 -fno-use-linker-plugin } \ | |
198 | {-O0 -flto -fuse-linker-plugin -fno-fat-lto-objects } \ | |
199 | {-O2 -flto -fuse-linker-plugin} \ | |
200 | ] | |
201 | } else { | |
202 | set LTO_OPTIONS [list \ | |
203 | {-O0 -flto -flto-partition=none } \ | |
204 | {-O2 -flto -flto-partition=none } \ | |
205 | {-O0 -flto -flto-partition=1to1 } \ | |
206 | {-O2 -flto -flto-partition=1to1 } \ | |
207 | {-O0 -flto } \ | |
208 | {-O2 -flto} \ | |
209 | ] | |
210 | } | |
211 | } | |
212 | } | |
213 | ||
214 | # | |
215 | # lto_finish -- called at the end of each subdir of tests if mathlib is | |
216 | # changed. | |
217 | # | |
218 | ||
219 | proc lto_finish { } { | |
220 | global board_info | |
221 | global saved_mathlib | |
222 | ||
223 | set dest [target_info name] | |
224 | if [info exists saved_mathlib] { | |
225 | set board_info($dest,mathlib) $saved_mathlib | |
226 | } elseif [board_info $dest exists mathlib] { | |
227 | unset board_info($dest,mathlib) | |
228 | } | |
229 | } | |
230 | ||
231 | # Subsets of tests can be selectively disabled by members of this list: | |
232 | # - ATTRIBUTE: disable all tests using the __attribute__ extension, | |
233 | # - COMPLEX: disable all tests using the complex types feature, | |
234 | # - COMPLEX_INT: disable all tests using the complex integral types extension, | |
235 | # - VA: disable all tests using the variable number of arguments feature, | |
236 | # - VLA_IN_STRUCT: disable all tests using the variable-length arrays as | |
237 | # structure members extension, | |
238 | # - ZERO_ARRAY: disable all tests using the zero-sized arrays extension. | |
239 | # The default skip lists can be overriden by | |
240 | # LTO_SKIPS="[list {skip_1}...{skip_n}]" | |
241 | # where skip_i are skip identifiers. You can put this in the environment | |
242 | # before site.exp is written or add it to site.exp directly. | |
243 | if ![info exists LTO_SKIPS] { | |
244 | set LTO_SKIPS [list {}] | |
245 | } | |
246 | ||
247 | global lto_skip_list | |
248 | set lto_skip_list $LTO_SKIPS | |
249 | ||
250 | load_lib dg.exp | |
251 | load_lib gcc-dg.exp | |
252 | load_lib gcc.exp | |
253 | ||
254 | # lto-obj -- compile to an object file | |
255 | # | |
256 | # SOURCE is the source file | |
257 | # DEST is the object file | |
258 | # OPTALL is the list of compiler options to use with all tests | |
259 | # OPTFILE is the list of compiler options to use with this file | |
260 | # OPTSTR is the options to print with test messages | |
261 | # XFAILDATA is the xfail data to be passed to the compiler | |
262 | proc lto-obj { source dest optall optfile optstr xfaildata } { | |
263 | global testcase | |
264 | global tool | |
265 | global compiler_conditional_xfail_data | |
266 | global lto_skip_list | |
267 | ||
268 | # Add the skip specifiers. | |
269 | foreach skip $lto_skip_list { | |
270 | if { ![string match $skip ""] } { | |
271 | lappend optall "-DSKIP_$skip" | |
272 | } | |
273 | } | |
274 | ||
275 | # Set up the options for compiling this file. | |
276 | set options "" | |
277 | lappend options "additional_flags=$optall $optfile" | |
278 | ||
279 | set compiler_conditional_xfail_data $xfaildata | |
280 | ||
281 | # Allow C source files to mix freely with other languages | |
282 | if [ string match "*.c" $source ] then { | |
283 | set comp_output [gcc_target_compile "$source" "$dest" object $options] | |
284 | } else { | |
285 | set comp_output [${tool}_target_compile "$source" "$dest" object $options] | |
286 | } | |
287 | # Prune unimportant visibility warnings before checking output. | |
288 | set comp_output [lto_prune_warns $comp_output] | |
289 | ${tool}_check_compile "$testcase $dest assemble" $optstr $dest $comp_output | |
290 | } | |
291 | ||
292 | # lto-link-and-maybe-run -- link the object files and run the executable | |
293 | # if compile_type is set to "run" | |
294 | # | |
295 | # TESTNAME is the mixture of object files to link | |
296 | # OBJLIST is the list of object files to link | |
297 | # DEST is the name of the executable | |
298 | # OPTALL is a list of compiler and linker options to use for all tests | |
299 | # OPTFILE is a list of compiler and linker options to use for this test | |
300 | # OPTSTR is the list of options to list in messages | |
301 | proc lto-link-and-maybe-run { testname objlist dest optall optfile optstr } { | |
302 | global testcase | |
303 | global tool | |
304 | global compile_type | |
305 | global board_info | |
306 | ||
307 | upvar dg-messages-by-file dg-messages-by-file | |
308 | ||
309 | verbose "lto-link-and-maybe-run" 2 | |
310 | ||
311 | # Check that all of the objects were built successfully. | |
312 | foreach obj [split $objlist] { | |
313 | if ![file_on_host exists $obj] then { | |
314 | unresolved "$testcase $testname link $optstr" | |
315 | unresolved "$testcase $testname execute $optstr" | |
316 | return | |
317 | } | |
318 | } | |
319 | ||
320 | # Set up the options for linking this test. | |
321 | set options "" | |
322 | lappend options "additional_flags=$optall $optfile" | |
323 | ||
324 | set target_board [target_info name] | |
325 | set relocatable 0 | |
326 | ||
327 | # Some LTO tests do relocatable linking. Some target boards set | |
328 | # a linker script which can't be used for relocatable linking. | |
329 | # Use the default linker script instead. | |
330 | if { [lsearch -exact [split "$optall $optfile"] "-r"] >= 0 } { | |
331 | set relocatable 1 | |
332 | } | |
333 | ||
334 | if { $relocatable } { | |
335 | set saved_ldscript [board_info $target_board ldscript] | |
336 | set board_info($target_board,ldscript) "" | |
337 | } | |
338 | ||
339 | # Link the objects into an executable. | |
340 | set comp_output [${tool}_target_compile "$objlist" $dest executable \ | |
341 | "$options"] | |
342 | ||
343 | if { $relocatable } { | |
344 | set board_info($target_board,ldscript) $saved_ldscript | |
345 | } | |
346 | ||
347 | # Check for diagnostics specified by directives | |
348 | set comp_output [lto_handle_diagnostics $comp_output] | |
349 | ||
350 | # Prune unimportant visibility warnings before checking output. | |
351 | set comp_output [lto_prune_warns $comp_output] | |
352 | ||
353 | if ![${tool}_check_compile "$testcase $testname link" $optstr \ | |
354 | $dest $comp_output] then { | |
355 | if { ![string compare "execute" $compile_type] } { | |
356 | unresolved "$testcase $testname execute $optstr" | |
357 | } | |
358 | return | |
359 | } | |
360 | ||
361 | # Return if we only needed to link. | |
362 | if { ![string compare "link" $compile_type] } { | |
363 | return | |
364 | } | |
365 | ||
366 | # Run the self-checking executable. | |
367 | if ![string match "*/*" $dest] then { | |
368 | set dest "./$dest" | |
369 | } | |
370 | set result [${tool}_load $dest "" ""] | |
371 | set status [lindex $result 0] | |
372 | if { $status == "pass" } then { | |
373 | file_on_host delete $dest | |
374 | } | |
375 | $status "$testcase $testname execute $optstr" | |
376 | } | |
377 | ||
378 | # Potentially handle the given dg- directive (a list) | |
379 | # Return true is the directive was handled, false otherwise. | |
380 | ||
381 | proc lto-can-handle-directive { op } { | |
382 | set cmd [lindex $op 0] | |
383 | ||
384 | # dg-warning and dg-message append to dg-messages. | |
385 | upvar dg-messages dg-messages | |
386 | ||
387 | # A list of directives to recognize, and a list of directives | |
388 | # to remap them to. | |
389 | # For example, "dg-lto-warning" is implemented by calling "dg-warning". | |
390 | set directives { dg-lto-warning dg-lto-message } | |
391 | set remapped_directives { dg-warning dg-message } | |
392 | ||
393 | set idx [lsearch -exact $directives $cmd] | |
394 | if { $idx != -1 } { | |
395 | verbose "remapping from: $op" 4 | |
396 | ||
397 | set remapped_cmd [lindex $remapped_directives $idx] | |
398 | set op [lreplace $op 0 0 $remapped_cmd] | |
399 | ||
400 | verbose "remapped to: $op" 4 | |
401 | ||
402 | set status [catch "$op" errmsg] | |
403 | if { $status != 0 } { | |
404 | if { 0 && [info exists errorInfo] } { | |
405 | # This also prints a backtrace which will just confuse | |
406 | # testcase writers, so it's disabled. | |
407 | perror "$name: $errorInfo\n" | |
408 | } else { | |
409 | perror "$name: $errmsg for \"$op\"\n" | |
410 | } | |
411 | # ??? The call to unresolved here is necessary to clear `errcnt'. | |
412 | # What we really need is a proc like perror that doesn't set errcnt. | |
413 | # It should also set exit_status to 1. | |
414 | unresolved "$name: $errmsg for \"$op\"" | |
415 | } | |
416 | ||
417 | return true | |
418 | } | |
419 | ||
420 | return false | |
421 | } | |
422 | ||
423 | # lto-get-options-main -- get target requirements for a test and | |
424 | # options for the primary source file and the test as a whole | |
425 | # | |
426 | # SRC is the full pathname of the primary source file. | |
427 | proc lto-get-options-main { src } { | |
428 | global compile_type | |
429 | global dg-extra-ld-options | |
430 | global dg-suppress-ld-options | |
431 | ||
432 | set dg-extra-ld-options "" | |
433 | set dg-suppress-ld-options "" | |
434 | ||
435 | # dg-options sets a variable called dg-extra-tool-flags. | |
436 | set dg-extra-tool-flags "" | |
437 | ||
438 | # dg-options sets a variable called tool_flags. | |
439 | set tool_flags "" | |
440 | ||
441 | # dg-require-* sets dg-do-what. | |
442 | upvar dg-do-what dg-do-what | |
443 | upvar dg-final-code dg-final-code | |
444 | set dg-final-code "" | |
445 | ||
446 | # dg-warning and dg-message append to dg-messages. | |
447 | upvar dg-messages-by-file dg-messages-by-file | |
448 | set dg-messages "" | |
449 | ||
450 | set tmp [dg-get-options $src] | |
451 | verbose "getting options for $src: $tmp" | |
452 | foreach op $tmp { | |
453 | set cmd [lindex $op 0] | |
454 | verbose "cmd is $cmd" | |
455 | if { [string match "dg-skip-if" $cmd] \ | |
456 | || [string match "dg-require-*" $cmd] } { | |
457 | set status [catch "$op" errmsg] | |
458 | if { $status != 0 } { | |
459 | perror "src: $errmsg for \"$op\"\n" | |
460 | unresolved "$src: $errmsg for \"$op\"" | |
461 | return | |
462 | } | |
463 | } elseif { [string match "dg-lto-options" $cmd] } { | |
464 | set op [lreplace $op 0 0 "dg-options"] | |
465 | set status [catch "$op" errmsg] | |
466 | if { $status != 0 } { | |
467 | perror "src: $errmsg for \"$op\"\n" | |
468 | unresolved "$src: $errmsg for \"$op\"" | |
469 | return | |
470 | } | |
471 | } elseif { ![string compare "dg-xfail-if" $cmd] \ | |
472 | || ![string compare "dg-options" $cmd] } { | |
473 | warning "lto.exp does not support $cmd in primary source file" | |
474 | } elseif { ![string compare "dg-lto-do" $cmd] } { | |
475 | if { [llength $op] > 3 } { | |
476 | set kw [lindex [lindex $op 3] 0] | |
477 | if [string match "target" $kw] { | |
478 | perror "$src: dg-lto-do does not support \"target\"" | |
479 | } elseif [string match "xfail" $kw] { | |
480 | perror "$src: dg-lto-do does not support \"xfail\"" | |
481 | } else { | |
482 | perror "$src: dg-lto-do takes a single argument" | |
483 | } | |
484 | } | |
485 | set dgdo [lindex $op 2] | |
486 | verbose "dg-lto-do command for \"$op\" is $dgdo" | |
487 | if { ![string compare "assemble" $dgdo] } { | |
488 | set compile_type "assemble" | |
489 | } elseif { ![string compare "run" $dgdo] } { | |
490 | set compile_type "run" | |
491 | } elseif { ![string compare "link" $dgdo] } { | |
492 | set compile_type "link" | |
493 | } else { | |
494 | warning "lto.exp does not support dg-lto-do $dgdo" | |
495 | } | |
496 | } elseif { ![string compare "dg-extra-ld-options" $cmd] } { | |
497 | if { [llength $op] > 4 } { | |
498 | error "[lindex $op 0]: too many arguments" | |
499 | } else { | |
500 | if { [llength $op] == 3 | |
501 | || ([llength $op] > 3 | |
502 | && [dg-process-target [lindex $op 3]] == "S") } { | |
503 | set dg-extra-ld-options [lindex $op 2] | |
504 | verbose \ | |
505 | "dg-extra-ld-options for main is ${dg-extra-ld-options}" | |
506 | } | |
507 | } | |
508 | } elseif { ![string compare "dg-suppress-ld-options" $cmd] } { | |
509 | if { [llength $op] > 4 } { | |
510 | error "[lindex $op 0]: too many arguments" | |
511 | } else { | |
512 | if { [llength $op] == 3 | |
513 | || ([llength $op] > 3 | |
514 | && [dg-process-target [lindex $op 3]] == "S") } { | |
515 | set dg-suppress-ld-options [lindex $op 2] | |
516 | verbose \ | |
517 | "dg-suppress-ld-options for main is ${dg-suppress-ld-options}" | |
518 | } | |
519 | } | |
520 | } elseif { ![string compare "dg-final" $cmd] } { | |
521 | if { [llength $op] > 3 } { | |
522 | error "[lindex $op 0]: too many arguments" | |
523 | } else { | |
524 | append dg-final-code "[lindex $op 2]\n" | |
525 | } | |
526 | } elseif { ![lto-can-handle-directive $op] } { | |
527 | # Ignore unrecognized dg- commands, but warn about them. | |
528 | warning "lto.exp does not support $cmd" | |
529 | } | |
530 | } | |
531 | ||
532 | verbose "dg-messages: ${dg-messages}" 3 | |
533 | set dg-messages-by-file($src) ${dg-messages} | |
534 | ||
535 | # Return flags to use for compiling the primary source file and for | |
536 | # linking. | |
537 | verbose "dg-extra-tool-flags for main is ${dg-extra-tool-flags}" | |
538 | return ${dg-extra-tool-flags} | |
539 | } | |
540 | ||
541 | ||
542 | # lto-get-options -- get special tool flags to use for a secondary | |
543 | # source file | |
544 | # | |
545 | # SRC is the full pathname of the source file. | |
546 | # The result is a list of options to use. | |
547 | # | |
548 | # This code is copied from proc dg-test in dg.exp from DejaGNU. | |
549 | proc lto-get-options { src } { | |
550 | # dg-options sets a variable called dg-extra-tool-flags. | |
551 | set dg-extra-tool-flags "" | |
552 | ||
553 | # dg-xfail-if sets compiler_conditional_xfail_data. | |
554 | global compiler_conditional_xfail_data | |
555 | set compiler_conditional_xfail_data "" | |
556 | ||
557 | # dg-xfail-if needs access to dg-do-what. | |
558 | upvar dg-do-what dg-do-what | |
559 | ||
560 | # dg-warning appends to dg-messages. | |
561 | upvar dg-messages-by-file dg-messages-by-file | |
562 | set dg-messages "" | |
563 | ||
564 | set tmp [dg-get-options $src] | |
565 | foreach op $tmp { | |
566 | set cmd [lindex $op 0] | |
567 | if { ![string compare "dg-options" $cmd] \ | |
568 | || ![string compare "dg-xfail-if" $cmd] } { | |
569 | set status [catch "$op" errmsg] | |
570 | if { $status != 0 } { | |
571 | perror "src: $errmsg for \"$op\"\n" | |
572 | unresolved "$src: $errmsg for \"$op\"" | |
573 | return | |
574 | } | |
575 | } elseif { [string match "dg-require-*" $cmd] } { | |
576 | warning "lto.exp does not support $cmd in secondary source files" | |
577 | } elseif { ![lto-can-handle-directive $op] } { | |
578 | # Ignore unrecognized dg- commands, but warn about them. | |
579 | warning "lto.exp does not support $cmd in secondary source files" | |
580 | } | |
581 | } | |
582 | ||
583 | verbose "dg-messages: ${dg-messages}" 3 | |
584 | if { [info exists dg-messages-by-file($src)] } { | |
585 | append dg-messages-by-file($src) ${dg-messages} | |
586 | } else { | |
587 | set dg-messages-by-file($src) ${dg-messages} | |
588 | } | |
589 | ||
590 | return ${dg-extra-tool-flags} | |
591 | } | |
592 | ||
593 | # lto-execute -- compile multi-file tests | |
594 | # | |
595 | # SRC1 is the full pathname of the main file of the testcase. | |
596 | # SID identifies a test suite in the names of temporary files. | |
597 | proc lto-execute { src1 sid } { | |
598 | global srcdir tmpdir | |
599 | global lto_option_list | |
600 | global tool | |
601 | global verbose | |
602 | global testcase | |
603 | global gluefile | |
604 | global compiler_conditional_xfail_data | |
605 | global dg-do-what-default | |
606 | global compile_type | |
607 | global dg-extra-ld-options | |
608 | global dg-suppress-ld-options | |
609 | global LTO_OPTIONS | |
610 | global dg-final-code | |
611 | global testname_with_flags | |
612 | ||
613 | # Get extra flags for this test from the primary source file, and | |
614 | # process other dg-* options that this suite supports. Warn about | |
615 | # unsupported flags. | |
616 | verbose "lto-execute: $src1" 1 | |
617 | set compile_type "run" | |
618 | set dg-do-what [list ${dg-do-what-default} "" P] | |
619 | array set dg-messages-by-file [list] | |
620 | set extra_flags(0) [lto-get-options-main $src1] | |
621 | set compile_xfail(0) "" | |
622 | ||
623 | # If the main file defines dg-options, those flags are used to | |
624 | # overwrite the default lto_option_list taken from LTO_OPTIONS. | |
625 | if { [string length $extra_flags(0)] > 0 } { | |
626 | set lto_option_list $extra_flags(0) | |
627 | set extra_flags(0) "" | |
628 | } else { | |
629 | set lto_option_list $LTO_OPTIONS | |
630 | } | |
631 | ||
632 | # Set up the names of the other source files. | |
633 | set dir [file dirname $src1] | |
634 | set base [file rootname $src1] | |
635 | set base [string range $base [string length $dir] end] | |
636 | regsub "_0" $base "" base | |
637 | regsub "/" $base "" base | |
638 | set src_list $src1 | |
639 | set i 1 | |
640 | set done 0 | |
641 | while { !$done } { | |
642 | set names [glob -nocomplain -types f -- "${dir}/${base}_${i}.*"] | |
643 | if { [llength ${names}] > 1 } { | |
644 | warning "lto-execute: more than one file matched ${dir}/${base}_${i}.*" | |
645 | } | |
646 | if { [llength ${names}] == 1 } { | |
647 | lappend src_list [lindex ${names} 0] | |
648 | incr i | |
649 | } else { | |
650 | set num_srcs ${i} | |
651 | set done 1 | |
652 | } | |
653 | } | |
654 | ||
655 | # Use the dg-options mechanism to specify extra flags for each | |
656 | # of the secondary files. | |
657 | # The extra flags in each file are used to compile that file, and the | |
658 | # extra flags in *_0.* are also used for linking. | |
659 | verbose "\tsrc_list is: $src_list" | |
660 | for {set i 1} {$i < $num_srcs} {incr i} { | |
661 | set extra_flags($i) [lto-get-options [lindex $src_list $i]] | |
662 | set compile_xfail($i) $compiler_conditional_xfail_data | |
663 | } | |
664 | ||
665 | # Define the names of the object files. | |
666 | set obj_list "" | |
667 | for {set i 0} {$i < $num_srcs} {incr i} { | |
668 | lappend obj_list "${sid}_${base}_${i}.o" | |
669 | } | |
670 | ||
671 | # Get the base name of this test, for use in messages. | |
672 | set testcase [lindex ${src_list} 0] | |
673 | ||
674 | # Remove the $srcdir and $tmpdir prefixes from $src1. (It would | |
675 | # be possible to use "regsub" here, if we were careful to escape | |
676 | # all regular expression characters in $srcdir and $tmpdir, but | |
677 | # that would be more complicated that this approach.) | |
678 | if {[string first "$srcdir/" "${testcase}"] == 0} { | |
679 | set testcase [string range "${testcase}" [string length "$srcdir/"] end] | |
680 | } | |
681 | if {[string first "$tmpdir/" "$testcase"] == 0} { | |
682 | set testcase [string range "$testcase" [string length "$tmpdir/"] end] | |
683 | set testcase "tmpdir-$testcase" | |
684 | } | |
685 | # If we couldn't rip $srcdir out of `src1' then just do the best we can. | |
686 | # The point is to reduce the unnecessary noise in the logs. Don't strip | |
687 | # out too much because different testcases with the same name can confuse | |
688 | # `test-tool'. | |
689 | if [string match "/*" $testcase] then { | |
690 | set testcase "[file tail [file dirname $src1]]/[file tail $src1]" | |
691 | } | |
692 | ||
693 | # Check whether this test is supported for this target. | |
694 | if { [lindex ${dg-do-what} 1 ] == "N" } { | |
695 | unsupported "$testcase" | |
696 | verbose "$testcase not supported on this target, skipping it" 3 | |
697 | return | |
698 | } | |
699 | # Should be safe for non-fortran too but be paranoid.. | |
700 | if {$sid eq "f_lto"} { | |
701 | list-module-names $src_list | |
702 | } | |
703 | regsub "_0.*" $testcase "" testcase | |
704 | ||
705 | # Set up the base name of executable files so they'll be unique. | |
706 | regsub -all "\[./\]" $testcase "-" execbase | |
707 | ||
708 | # Loop through all of the option lists used for this test. | |
709 | set count 0 | |
710 | foreach option $lto_option_list { | |
711 | verbose "Testing $testcase, $option" | |
712 | ||
713 | # There's a unique name for each executable we generate. | |
714 | set execname "${execbase}-${count}1.exe" | |
715 | ||
716 | # The LTO tests don't use dg-test, so testname_with_flags and | |
717 | # output_file need to be defined explicitly for each file. scan-symbol | |
718 | # directives rely on both of these to be defined to find the symbol to | |
719 | # scan and for the text to print in the PASS/FAIL since they can also | |
720 | # be called from dg-test. testname_with_flags is also used via | |
721 | # testname-for-summary when calling into generic function below to | |
722 | # clean temporary files. | |
723 | set output_file $execname | |
724 | set testname_with_flags $execname | |
725 | ||
726 | incr count | |
727 | ||
728 | file_on_host delete $execname | |
729 | ||
730 | # Compile pieces with the compiler under test. | |
731 | set i 0 | |
732 | foreach src $src_list obj $obj_list { | |
733 | lto-obj $src $obj $option $extra_flags($i) $option \ | |
734 | $compile_xfail($i) | |
735 | incr i | |
736 | } | |
737 | ||
738 | # Link (using the compiler under test), run, and clean up tests. | |
739 | if { ![string compare "run" $compile_type] \ | |
740 | || ![string compare "link" $compile_type] } { | |
741 | ||
742 | # Filter out any link options we were asked to suppress. | |
743 | set reduced {} | |
744 | foreach x [split $option] { | |
745 | if {[lsearch ${dg-suppress-ld-options} $x] == -1} { | |
746 | lappend reduced $x | |
747 | } | |
748 | } | |
749 | set filtered [join $reduced " "] | |
750 | ||
751 | lto-link-and-maybe-run \ | |
752 | "[lindex $obj_list 0]-[lindex $obj_list end]" \ | |
753 | $obj_list $execname $filtered ${dg-extra-ld-options} \ | |
754 | $filtered | |
755 | } | |
756 | ||
757 | ||
758 | # Are there any further tests to perform? | |
759 | # Note that if the program has special run-time requirements, running | |
760 | # of the program can be delayed until here. Ditto for other situations. | |
761 | # It would be a bit cumbersome though. | |
762 | ||
763 | if ![string match ${dg-final-code} ""] { | |
764 | regsub -all "\\\\(\[{}\])" ${dg-final-code} "\\1" dg-final-code | |
765 | # Note that the use of `args' here makes this a varargs proc. | |
766 | proc dg-final-proc { args } ${dg-final-code} | |
767 | verbose "Running dg-final tests." 3 | |
768 | verbose "dg-final-proc:\n[info body dg-final-proc]" 4 | |
769 | if [catch "dg-final-proc $src1" errmsg] { | |
770 | perror "$src1: error executing dg-final: $errmsg" | |
771 | # ??? The call to unresolved here is necessary to clear | |
772 | # `errcnt'. What we really need is a proc like perror that | |
773 | # doesn't set errcnt. It should also set exit_status to 1. | |
774 | unresolved "$src1: error executing dg-final: $errmsg" | |
775 | } | |
776 | } | |
777 | ||
778 | # Clean up object files. | |
779 | set files [glob -nocomplain ${sid}_*.o] | |
780 | if { $files != "" } { | |
781 | foreach objfile $files { | |
782 | if { ![info exists gluefile] || $objfile != $gluefile } { | |
783 | eval "file_on_host delete $objfile" | |
784 | } | |
785 | } | |
786 | } | |
787 | ||
788 | # Clean up after -save-temps. | |
789 | eval "cleanup-saved-temps" | |
790 | ||
791 | for {set i 0} {$i < $num_srcs} {incr i} { | |
792 | set testname_with_flags "${base}_${i}" | |
793 | eval "cleanup-saved-temps" | |
794 | set testname_with_flags "${sid}_${base}_${i}" | |
795 | eval "cleanup-saved-temps" | |
796 | } | |
797 | ||
798 | unset testname_with_flags | |
799 | ||
800 | if { ![string compare "run" $compile_type] \ | |
801 | || ![string compare "link" $compile_type] } { | |
802 | file_on_host delete $execname | |
803 | } | |
804 | # Should be safe for non-fortran too but be paranoid.. | |
805 | if {$sid eq "f_lto"} { | |
806 | cleanup-modules "" | |
807 | } | |
808 | } | |
809 | } | |
810 | ||
811 | # Call pass if object readelf is ok, otherwise fail. | |
812 | # example: /* { dg-final { object-readelf Tag_ABI_enum_size int} } */ | |
813 | proc object-readelf { args } { | |
814 | global readelf | |
815 | global base_dir | |
816 | upvar 2 execname execname | |
817 | ||
818 | if { [llength $args] < 2 } { | |
819 | error "object-readelf: too few arguments" | |
820 | return | |
821 | } | |
822 | if { [llength $args] > 3 } { | |
823 | error "object-readelf: too many arguments" | |
824 | return | |
825 | } | |
826 | if { [llength $args] >= 3 } { | |
827 | switch [dg-process-target [lindex $args 2]] { | |
828 | "S" { } | |
829 | "N" { return } | |
830 | "F" { setup_xfail "*-*-*" } | |
831 | "P" { } | |
832 | } | |
833 | } | |
834 | ||
835 | # Find size like we find g++ in g++.exp. | |
836 | if ![info exists readelf] { | |
837 | set readelf [findfile $base_dir/../../../binutils/readelf \ | |
838 | $base_dir/../../../binutils/readelf \ | |
839 | [findfile $base_dir/../../readelf $base_dir/../../readelf \ | |
840 | [findfile $base_dir/readelf $base_dir/readelf \ | |
841 | [transform readelf]]]] | |
842 | verbose -log "readelf is $readelf" | |
843 | } | |
844 | ||
845 | set what [lindex $args 0] | |
846 | set with [lindex $args 1] | |
847 | ||
848 | if ![file_on_host exists $execname] { | |
849 | verbose -log "$execname does not exist" | |
850 | unresolved "object-readelf $what " | |
851 | return | |
852 | } | |
853 | ||
854 | set output [remote_exec host "$readelf -A" "$execname"] | |
855 | set status [lindex $output 0] | |
856 | if { $status != 0 } { | |
857 | verbose -log "object-readelf: $readelf failed" | |
858 | unresolved "object-readelf $what $execname" | |
859 | return | |
860 | } | |
861 | ||
862 | set text [lindex $output 1] | |
863 | set lines [split $text "\n"] | |
864 | ||
865 | set done 0 | |
866 | set i 0 | |
867 | while { !$done } { | |
868 | set line_tex [lindex $lines $i] | |
869 | if { [llength ${line_tex}] > 1} { | |
870 | incr i | |
871 | if [regexp -- $what $line_tex] { | |
872 | set match [regexp -- $with $line_tex] | |
873 | set done 1 | |
874 | } | |
875 | } else { | |
876 | set done 1 | |
877 | } | |
878 | } | |
879 | ||
880 | verbose -log "$what size is $with;" | |
881 | if { $match == 1 } { | |
882 | pass "object-readelf $what size is correct." | |
883 | } else { | |
884 | fail "object-readelf $what size is incorrect." | |
885 | } | |
886 | } | |
887 | ||
888 |