1 # Copyright
(C
) 2003, 2006, 2007 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
25 #
Return the list of options to use
for fortran torture tests.
26 # The default option list can be overridden by
27 # TORTURE_OPTIONS
="{ { list1 } ... { listN } }"
28 proc
get-fortran
-torture
-options
{ } {
29 global TORTURE_OPTIONS
31 if [info exists TORTURE_OPTIONS
] {
32 return $TORTURE_OPTIONS
35 # determine
if host supports vectorization
, and the necessary
set
36 # of options
, based
on code from testsuite
/vect
/vect.exp
38 set vectorizer_options
[list
"-O2" "-ftree-vectorize"]
40 if { [istarget
"powerpc*-*-*"]
41 && [is
-effective
-target powerpc_altivec_ok
]
42 && [check_vmx_hw_available
] } {
43 lappend vectorizer_options
"-maltivec"
44 set test_tree_vectorize
1
45 } elseif
{ [istarget
"spu-*-*"] } {
46 set test_tree_vectorize
1
47 } elseif
{ [istarget
"i?86-*-*"] || [istarget "x86_64-*-*"] } {
48 lappend vectorizer_options
"-msse2"
49 set test_tree_vectorize
1
50 } elseif
{ [istarget
"mips*-*-*"]
51 && [check_effective_target_mpaired_single
]
52 && [check_effective_target_nomips16
] } {
53 lappend vectorizer_options
"-mpaired-single"
54 set test_tree_vectorize
1
55 } elseif
[istarget
"sparc*-*-*"] {
56 lappend vectorizer_options
"-mcpu=ultrasparc" "-mvis"
57 set test_tree_vectorize
1
58 } elseif
{ [istarget
"alpha*-*-*"]
59 && [check_alpha_max_hw_available
] } {
60 lappend vectorizer_options
"-mmax"
61 set test_tree_vectorize
1
62 } elseif
[istarget
"ia64-*-*"] {
63 set test_tree_vectorize
1
65 set test_tree_vectorize
0
74 { -O2
-fomit
-frame
-pointer
-finline
-functions
} \
75 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-loops
} \
76 { -O2
-fbounds
-check
} \
79 if { $test_tree_vectorize
} {
80 lappend options $vectorizer_options
88 # fortran
-torture
-compile -- compile a gfortran.fortran
-torture testcase.
90 # SRC is the full pathname of the testcase.
91 # OPTION is the specific compiler flag we
're testing (eg: -O2).
93 proc fortran-torture-compile { src option } {
98 set output "$tmpdir/[file tail [file rootname $src]].o"
100 regsub "(?q)$srcdir/" $src "" testcase
102 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
103 # The point is to reduce the unnecessary noise in the logs. Don't
strip
104 # out too much because different testcases with the same
name can confuse
106 if [string match "/*" $testcase] {
107 set testcase "[file tail [file dirname $src]]/[file tail $src]"
110 verbose "Testing $testcase, $option" 1
112 # Run the compiler and get results in comp_output.
114 lappend options "additional_flags=-w $option"
116 set comp_output [gfortran_target_compile "$src" "$output" object $options]
118 # See if we got something bad.
119 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
121 if [string match "$fatal_signal 6" $comp_output] then {
122 gfortran_fail $testcase "Got Signal 6, $option"
123 catch { remote_file build delete $output }
127 if [string match "$fatal_signal 11" $comp_output] then {
128 gfortran_fail $testcase "Got Signal 11, $option"
129 catch { remote_file build delete $output }
133 if [string match "*internal compiler error*" $comp_output] then {
134 gfortran_fail $testcase "$option (internal compiler error)"
135 catch { remote_file build delete $output }
139 # We shouldn't
get these because of
-w
, but just in case.
140 if [string match
"*95*:*warning:*" $comp_output] then {
141 warning
"$testcase: (with warnings) $option"
142 send_log
"$comp_output\n"
143 unresolved
"$testcase, $option"
144 catch
{ remote_file build
delete $output
}
148 # Prune warnings we know are unwanted.
149 set comp_output
[prune_warnings $comp_output
]
151 #
Report if the testcase is not supported.
152 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
153 if { $unsupported_message
!= "" } {
154 unsupported
"$testcase: $unsupported_message"
155 catch
{ remote_file build
delete $output
}
159 # remove
any leftover LF
/CR to make sure
any output is legit
160 regsub
-all
-- "\[\r\n\]*" $comp_output "" comp_output
162 #
If any message remains
, we fail.
163 if ![string match
"" $comp_output] then {
164 gfortran_fail $testcase $option
165 catch
{ remote_file build
delete $output
}
169 gfortran_pass $testcase $option
170 catch
{ remote_file build
delete $output
}
175 # fortran
-torture
-execute -- compile and
execute a testcase.
177 # SRC is the full pathname of the testcase.
179 #
If the testcase has an associated .x file
, we source that to run the
180 # test instead. We use .x so that we don
't lengthen the existing filename
181 # to more than 14 chars.
183 proc fortran-torture-execute { src } {
187 global compiler_conditional_xfail_data
188 global torture_with_loops
190 # Check for alternate driver.
191 set additional_flags ""
192 if [file exists [file rootname $src].x] {
193 verbose "Using alternate driver [file rootname [file tail $src]].x" 2
195 catch "set done_p \[source [file rootname $src].x\]"
201 # Setup the options for the testcase run.
202 set option_list $torture_with_loops
203 set executable $tmpdir/[file tail [file rootname $src].x]
204 regsub "(?q)$srcdir/" $src "" testcase
206 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
207 # The point is to reduce the unnecessary noise in the logs. Don't
strip
208 # out too much because different testcases with the same
name can confuse
210 if [string match "/*" $testcase] {
211 set testcase "[file tail [file dirname $src]]/[file tail $src]"
214 # Walk the list of options and copmile and run the testcase for all
215 # options that are not explicitly disabled by the .x script (if present).
216 foreach option $option_list {
218 # Torture_{compile,execute}_xfail are set by the .x script.
219 if [info exists torture_compile_xfail] {
220 setup_xfail $torture_compile_xfail
223 # Torture_execute_before_{compile,execute} can be set by the .x script.
224 if [info exists torture_eval_before_compile] {
225 set ignore_me [eval $torture_eval_before_compile]
228 # FIXME: We should make sure that the modules required by this testcase
229 # exist. If not, the testcase should XFAIL.
231 # Compile the testcase.
232 catch { remote_file build delete $executable }
233 verbose "Testing $testcase, $option" 1
236 lappend options "additional_flags=-w $option"
237 if { $additional_flags != "" } {
238 lappend options "additional_flags=$additional_flags"
240 set comp_output [gfortran_target_compile "$src" "$executable" executable $options]
242 # See if we got something bad.
243 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
245 if [string match "$fatal_signal 6" $comp_output] then {
246 gfortran_fail $testcase "Got Signal 6, $option"
247 catch { remote_file build delete $executable }
251 if [string match "$fatal_signal 11" $comp_output] then {
252 gfortran_fail $testcase "Got Signal 11, $option"
253 catch { remote_file build delete $executable }
257 if [string match "*internal compiler error*" $comp_output] then {
258 gfortran_fail $testcase "$option (internal compiler error)"
259 catch { remote_file build delete $executable }
263 # We shouldn't
get these because of
-w
, but just in case.
264 if [string match
"*95*:*warning:*" $comp_output] then {
265 warning
"$testcase: (with warnings) $option"
266 send_log
"$comp_output\n"
267 unresolved
"$testcase, $option"
268 catch
{ remote_file build
delete $executable
}
272 # Prune warnings we know are unwanted.
273 set comp_output
[prune_warnings $comp_output
]
275 #
Report if the testcase is not supported.
276 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
277 if { $unsupported_message
!= "" } {
278 unsupported
"$testcase: $unsupported_message"
280 } elseif
![file
exists $executable
] {
282 fail
"$testcase compilation, $option"
283 untested
"$testcase execution, $option"
286 # FIXME
: since we can
't test for the existence of a remote
287 # file without short of doing an remote file list, we assume
288 # that since we got no output, it must have compiled.
289 pass "$testcase compilation, $option"
292 pass "$testcase compilation, $option"
295 # See if this source file uses INTEGER(KIND=8) types, if it does, and
296 # no_long_long is set, skip execution of the test.
297 # FIXME: We should also look for F95 style "_8" or select_int_kind()
298 # integers, but that is obviously much harder than just regexping this.
299 # So maybe we should just avoid those in testcases.
300 if [target_info exists no_long_long] then {
301 if [expr [search_for_re $src "integer\*8"] \
302 +[search_for_re $src "integer *( *8 *)"] \
303 +[search_for_re $src "integer *( *kind *= *8 *)"]] \
305 untested "$testcase execution, $option"
310 if [info exists torture_execute_xfail] {
311 setup_xfail $torture_execute_xfail
314 if [info exists torture_eval_before_execute] {
315 set ignore_me [eval $torture_eval_before_execute]
318 # Run the testcase, and analyse the output.
319 set result [gfortran_load "$executable" "" ""]
320 set status [lindex $result 0]
321 set output [lindex $result 1]
322 if { $status == "pass" } {
323 catch { remote_file build delete $executable }
325 $status "$testcase execution, $option"
331 # search_for_re -- looks for a string match in a file
333 proc search_for_re { file pattern } {
334 set fd [open $file r]
335 while { [gets $fd cur_line]>=0 } {
336 set lower [string tolower $cur_line]
337 if [regexp "$pattern" $lower] then {
348 # fortran-torture -- the fortran-torture testcase source file processor
350 # This runs compilation only tests (no execute tests).
352 # SRC is the full pathname of the testcase, or just a file name in which
353 # case we prepend $srcdir/$subdir.
355 # If the testcase has an associated .x file, we source that to run the
356 # test instead. We use .x so that we don't lengthen the existing filename
357 # to more than
14 chars.
359 proc fortran
-torture
{ args } {
361 global compiler_conditional_xfail_data
362 global torture_with_loops
364 set src
[lindex $
args 0]
365 if { [llength $
args] > 1 } {
366 set options
[lindex $
args 1]
371 # Prepend $srdir
/$subdir
if missing.
372 if ![string match
"*/*" $src] {
373 set src
"$srcdir/$subdir/$src"
376 # Check
for alternate driver.
377 if [file
exists [file rootname $src
].x
] {
378 verbose
"Using alternate driver [file rootname [file tail $src]].x" 2
380 catch
"set done_p \[source [file rootname $src].x\]"
386 # loop through all the options
387 set option_list $torture_with_loops
388 foreach option $option_list
{
390 # torture_compile_xfail is
set by the .x script
(if present
)
391 if [info exists torture_compile_xfail
] {
392 setup_xfail $torture_compile_xfail
395 # torture_execute_before_compile is
set by the .x script
(if present
)
396 if [info exists torture_eval_before_compile
] {
397 set ignore_me
[eval $torture_eval_before_compile
]
400 fortran
-torture
-compile $src
"$option $options"
405 # add
-ieee
-options
-- add options necessary
for 100% ieee conformance.
407 proc add
-ieee
-options
{ } {
408 # Ensure that excess precision does not cause problems.
409 if { [istarget
"i?86-*-*"]
410 ||
[istarget
"m68k-*-*"] } then {
411 uplevel
1 lappend additional_flags
"-ffloat-store"
414 # Enable full IEEE compliance
mode.
415 if { [istarget
"alpha*-*-*"]
416 ||
[istarget
"sh*-*-*"] } then {
417 uplevel
1 lappend additional_flags
"-mieee"