1 # Copyright
(C
) 2003-2020 Free Software Foundation
, Inc.
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.
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.
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
/>.
17 # Please email
any bugs
, comments
, and
/or additions to this file to
20 # This file was written by Steven Bosscher
(s.bosscher@student.tudelft.nl
)
21 # based
on f
-torture.exp
, which was written by Rob Savoye.
23 load_lib target
-supports.exp
24 load_lib fortran
-modules.exp
25 load_lib target
-utils.exp
27 #
Return the list of options to use
for fortran torture tests.
28 # The default option list can be overridden by
29 # TORTURE_OPTIONS
="{ { list1 } ... { listN } }"
30 proc
get-fortran
-torture
-options
{ } {
31 global TORTURE_OPTIONS
33 if [info exists TORTURE_OPTIONS
] {
34 return $TORTURE_OPTIONS
37 # determine
if host supports vectorization
, and the necessary
set
38 # of options
, based
on code from testsuite
/vect
/vect.exp
40 set vectorizer_options
[list
"-O2" "-ftree-vectorize"]
42 if { [istarget powerpc
*-*-*]
43 && [is
-effective
-target powerpc_altivec_ok
]
44 && [check_vmx_hw_available
] } {
45 lappend vectorizer_options
"-maltivec"
46 set test_tree_vectorize
1
47 } elseif
{ ( [istarget i?
86-*-*] ||
[istarget x86_64
-*-*] )
48 && [check_effective_target_sse2
]
49 && [check_sse2_hw_available
]
50 && [check_sse_os_support_available
] } {
51 lappend vectorizer_options
"-msse2"
52 set test_tree_vectorize
1
53 } elseif
{ [istarget mips
*-*-*]
54 && [check_effective_target_mpaired_single
]
55 && [check_effective_target_nomips16
] } {
56 lappend vectorizer_options
"-mpaired-single"
57 set test_tree_vectorize
1
58 } elseif
{ [istarget sparc
*-*-*]
59 && [check_effective_target_ultrasparc_hw
] } {
60 lappend vectorizer_options
"-mcpu=ultrasparc" "-mvis"
61 set test_tree_vectorize
1
62 } elseif
{ [istarget alpha
*-*-*]
63 && [check_alpha_max_hw_available
] } {
64 lappend vectorizer_options
"-mmax"
65 set test_tree_vectorize
1
66 } elseif
[istarget ia64
-*-*] {
67 set test_tree_vectorize
1
69 set test_tree_vectorize
0
78 { -O2
-fomit
-frame
-pointer
-finline
-functions
} \
79 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-loops
} \
80 { -O2
-fbounds
-check
} \
83 if { $test_tree_vectorize
} {
84 lappend options $vectorizer_options
87 if [info exists ADDITIONAL_TORTURE_OPTIONS
] {
88 set options
[concat $options $ADDITIONAL_TORTURE_OPTIONS
]
96 # fortran
-torture
-compile -- compile a gfortran.fortran
-torture testcase.
98 # SRC is the full pathname of the testcase.
99 # OPTION is the specific compiler flag we
're testing (eg: -O2).
101 proc fortran-torture-compile { src option } {
106 set output "$tmpdir/[file tail [file rootname $src]].o"
108 regsub "(?q)$srcdir/" $src "" testcase
110 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
111 # The point is to reduce the unnecessary noise in the logs. Don't
strip
112 # out too much because different testcases with the same
name can confuse
114 if [string match "/*" $testcase] {
115 set testcase "[file tail [file dirname $src]]/[file tail $src]"
118 verbose "Testing $testcase, $option" 1
120 # Run the compiler and get results in comp_output.
122 lappend options "additional_flags=-w $option"
124 set comp_output [gfortran_target_compile "$src" "$output" object $options]
126 # See if we got something bad.
127 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
129 if [string match "$fatal_signal 6" $comp_output] then {
130 gfortran_fail $testcase "Got Signal 6, $option"
131 catch { remote_file build delete $output }
135 if [string match "$fatal_signal 11" $comp_output] then {
136 gfortran_fail $testcase "Got Signal 11, $option"
137 catch { remote_file build delete $output }
141 if [string match "*internal compiler error*" $comp_output] then {
142 gfortran_fail $testcase "$option (internal compiler error)"
143 catch { remote_file build delete $output }
147 # We shouldn't
get these because of
-w
, but just in case.
148 if [string match
"*95*:*warning:*" $comp_output] then {
149 warning
"$testcase: (with warnings) $option"
150 send_log
"$comp_output\n"
151 unresolved
"$testcase, $option"
152 catch
{ remote_file build
delete $output
}
156 # Prune warnings we know are unwanted.
157 set comp_output
[prune_warnings $comp_output
]
159 #
Report if the testcase is not supported.
160 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
161 if { $unsupported_message
!= "" } {
162 unsupported
"$testcase: $unsupported_message"
163 catch
{ remote_file build
delete $output
}
167 # remove
any leftover LF
/CR to make sure
any output is legit
168 regsub
-all
-- "\[\r\n\]*" $comp_output "" comp_output
170 #
If any message remains
, we fail.
171 if ![string match
"" $comp_output] then {
172 gfortran_fail $testcase $option
173 catch
{ remote_file build
delete $output
}
177 gfortran_pass $testcase $option
178 catch
{ remote_file build
delete $output
}
183 # fortran
-torture
-execute -- compile and
execute a testcase.
185 # SRC is the full pathname of the testcase.
187 #
If the testcase has an associated .x file
, we source that to run the
188 # test instead. We use .x so that we don
't lengthen the existing filename
189 # to more than 14 chars.
191 proc fortran-torture-execute { src } {
195 global compiler_conditional_xfail_data
196 global torture_with_loops
198 # Check for alternate driver.
199 set additional_flags ""
200 if [file exists [file rootname $src].x] {
201 verbose "Using alternate driver [file rootname [file tail $src]].x" 2
203 catch "set done_p \[source [file rootname $src].x\]"
209 # Setup the options for the testcase run.
210 set option_list $torture_with_loops
211 set executable $tmpdir/[file tail [file rootname $src].x]
212 regsub "(?q)$srcdir/" $src "" testcase
214 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
215 # The point is to reduce the unnecessary noise in the logs. Don't
strip
216 # out too much because different testcases with the same
name can confuse
218 if [string match "/*" $testcase] {
219 set testcase "[file tail [file dirname $src]]/[file tail $src]"
221 list-module-names $src
223 # Walk the list of options and copmile and run the testcase for all
224 # options that are not explicitly disabled by the .x script (if present).
225 foreach option $option_list {
227 # Torture_{compile,execute}_xfail are set by the .x script.
228 if [info exists torture_compile_xfail] {
229 setup_xfail $torture_compile_xfail
232 # Torture_execute_before_{compile,execute} can be set by the .x script.
233 if [info exists torture_eval_before_compile] {
234 set ignore_me [eval $torture_eval_before_compile]
237 # FIXME: We should make sure that the modules required by this testcase
238 # exist. If not, the testcase should XFAIL.
240 # Compile the testcase.
241 catch { remote_file build delete $executable }
242 verbose "Testing $testcase, $option" 1
245 lappend options "additional_flags=-w $option"
246 if { $additional_flags != "" } {
247 lappend options "additional_flags=$additional_flags"
249 set comp_output [gfortran_target_compile "$src" "$executable" executable $options]
251 # See if we got something bad.
252 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
254 if [string match "$fatal_signal 6" $comp_output] then {
255 gfortran_fail $testcase "Got Signal 6, $option"
256 catch { remote_file build delete $executable }
260 if [string match "$fatal_signal 11" $comp_output] then {
261 gfortran_fail $testcase "Got Signal 11, $option"
262 catch { remote_file build delete $executable }
266 if [string match "*internal compiler error*" $comp_output] then {
267 gfortran_fail $testcase "$option (internal compiler error)"
268 catch { remote_file build delete $executable }
272 # We shouldn't
get these because of
-w
, but just in case.
273 if [string match
"*95*:*warning:*" $comp_output] then {
274 warning
"$testcase: (with warnings) $option"
275 send_log
"$comp_output\n"
276 unresolved
"$testcase, $option"
277 catch
{ remote_file build
delete $executable
}
281 # Prune warnings we know are unwanted.
282 set comp_output
[prune_warnings $comp_output
]
284 #
Report if the testcase is not supported.
285 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
286 if { $unsupported_message
!= "" } {
287 unsupported
"$testcase: $unsupported_message"
289 } elseif
![file
exists $executable
] {
291 fail
"$testcase compilation, $option"
292 untested
"$testcase execution, $option"
295 # FIXME
: since we can
't test for the existence of a remote
296 # file without short of doing an remote file list, we assume
297 # that since we got no output, it must have compiled.
298 pass "$testcase compilation, $option"
301 pass "$testcase compilation, $option"
304 # See if this source file uses INTEGER(KIND=8) types, if it does, and
305 # no_long_long is set, skip execution of the test.
306 # FIXME: We should also look for F95 style "_8" or select_int_kind()
307 # integers, but that is obviously much harder than just regexping this.
308 # So maybe we should just avoid those in testcases.
309 if [target_info exists no_long_long] then {
310 if [expr [search_for_re $src "integer\*8"] \
311 +[search_for_re $src "integer *( *8 *)"] \
312 +[search_for_re $src "integer *( *kind *= *8 *)"]] \
314 untested "$testcase execution, $option"
319 if [info exists torture_execute_xfail] {
320 setup_xfail $torture_execute_xfail
323 if [info exists torture_eval_before_execute] {
324 set ignore_me [eval $torture_eval_before_execute]
327 # Run the testcase, and analyse the output.
328 set result [gfortran_load "$executable" "" ""]
329 set status [lindex $result 0]
330 set output [lindex $result 1]
331 if { $status == "pass" } {
332 catch { remote_file build delete $executable }
334 $status "$testcase execution, $option"
341 # search_for_re -- looks for a string match in a file
343 proc search_for_re { file pattern } {
344 set fd [open $file r]
345 while { [gets $fd cur_line]>=0 } {
346 set lower [string tolower $cur_line]
347 if [regexp "$pattern" $lower] then {
358 # fortran-torture -- the fortran-torture testcase source file processor
360 # This runs compilation only tests (no execute tests).
362 # SRC is the full pathname of the testcase, or just a file name in which
363 # case we prepend $srcdir/$subdir.
365 # If the testcase has an associated .x file, we source that to run the
366 # test instead. We use .x so that we don't lengthen the existing filename
367 # to more than
14 chars.
369 proc fortran
-torture
{ args } {
371 global compiler_conditional_xfail_data
372 global torture_with_loops
374 set src
[lindex $
args 0]
375 if { [llength $
args] > 1 } {
376 set options
[lindex $
args 1]
381 # Prepend $srdir
/$subdir
if missing.
382 if ![string match
"*/*" $src] {
383 set src
"$srcdir/$subdir/$src"
386 # Check
for alternate driver.
387 if [file
exists [file rootname $src
].x
] {
388 verbose
"Using alternate driver [file rootname [file tail $src]].x" 2
390 catch
"set done_p \[source [file rootname $src].x\]"
395 list
-module
-names $src
397 # loop through all the options
398 set option_list $torture_with_loops
399 foreach option $option_list
{
401 # torture_compile_xfail is
set by the .x script
(if present
)
402 if [info exists torture_compile_xfail
] {
403 setup_xfail $torture_compile_xfail
406 # torture_execute_before_compile is
set by the .x script
(if present
)
407 if [info exists torture_eval_before_compile
] {
408 set ignore_me
[eval $torture_eval_before_compile
]
411 fortran
-torture
-compile $src
"$option $options"
417 # add
-ieee
-options
-- add options necessary
for 100% ieee conformance.
419 proc add
-ieee
-options
{ } {
420 # Ensure that excess precision does not cause problems.
421 if { [istarget i?
86-*-*]
422 ||
[istarget m68k
-*-*] } then {
423 uplevel
1 lappend additional_flags
"-ffloat-store"
426 # Enable full IEEE compliance
mode.
427 if { [istarget alpha
*-*-*]
428 ||
[istarget sh
*-*-*] } then {
429 uplevel
1 lappend additional_flags
"-mieee"