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 # The default option list can be overridden by
26 # TORTURE_OPTIONS
="{ { list1 } ... { listN } }"
28 if ![info exists TORTURE_OPTIONS
] {
29 # determine
if host supports vectorization
, and the necessary
set
30 # of options
, based
on code from testsuite
/vect
/vect.exp
32 set vectorizer_options
[list
"-O2" "-ftree-vectorize"]
34 if { [istarget
"powerpc*-*-*"]
35 && [is
-effective
-target powerpc_altivec_ok
]
36 && [check_vmx_hw_available
] } {
37 lappend vectorizer_options
"-maltivec"
38 set test_tree_vectorize
1
39 } elseif
{ [istarget
"spu-*-*"] } {
40 set test_tree_vectorize
1
41 } elseif
{ [istarget
"i?86-*-*"] || [istarget "x86_64-*-*"] } {
42 lappend vectorizer_options
"-msse2"
43 set test_tree_vectorize
1
44 } elseif
{ [istarget
"mips*-*-*"]
45 && [check_effective_target_mpaired_single
]
46 && [check_effective_target_nomips16
] } {
47 lappend vectorizer_options
"-mpaired-single"
48 set test_tree_vectorize
1
49 } elseif
[istarget
"sparc*-*-*"] {
50 lappend vectorizer_options
"-mcpu=ultrasparc" "-mvis"
51 set test_tree_vectorize
1
52 } elseif
{ [istarget
"alpha*-*-*"]
53 && [check_alpha_max_hw_available
] } {
54 lappend vectorizer_options
"-mmax"
55 set test_tree_vectorize
1
56 } elseif
[istarget
"ia64-*-*"] {
57 set test_tree_vectorize
1
59 set test_tree_vectorize
0
62 set TORTURE_OPTIONS
[list \
63 { -O0
} { -O1
} { -O2
} \
64 { -O2
-fomit
-frame
-pointer
-finline
-functions
} \
65 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-loops
} \
66 { -O2
-fbounds
-check
} \
70 if { $test_tree_vectorize
} {
71 lappend TORTURE_OPTIONS $vectorizer_options
77 # fortran
-torture
-compile -- compile a gfortran.fortran
-torture testcase.
79 # SRC is the full pathname of the testcase.
80 # OPTION is the specific compiler flag we
're testing (eg: -O2).
82 proc fortran-torture-compile { src option } {
87 set output "$tmpdir/[file tail [file rootname $src]].o"
89 regsub "(?q)$srcdir/" $src "" testcase
91 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
92 # The point is to reduce the unnecessary noise in the logs. Don't
strip
93 # out too much because different testcases with the same
name can confuse
95 if [string match "/*" $testcase] {
96 set testcase "[file tail [file dirname $src]]/[file tail $src]"
99 verbose "Testing $testcase, $option" 1
101 # Run the compiler and get results in comp_output.
103 lappend options "additional_flags=-w $option"
105 set comp_output [gfortran_target_compile "$src" "$output" object $options]
107 # See if we got something bad.
108 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
110 if [string match "$fatal_signal 6" $comp_output] then {
111 gfortran_fail $testcase "Got Signal 6, $option"
112 catch { remote_file build delete $output }
116 if [string match "$fatal_signal 11" $comp_output] then {
117 gfortran_fail $testcase "Got Signal 11, $option"
118 catch { remote_file build delete $output }
122 if [string match "*internal compiler error*" $comp_output] then {
123 gfortran_fail $testcase "$option (internal compiler error)"
124 catch { remote_file build delete $output }
128 # We shouldn't
get these because of
-w
, but just in case.
129 if [string match
"*95*:*warning:*" $comp_output] then {
130 warning
"$testcase: (with warnings) $option"
131 send_log
"$comp_output\n"
132 unresolved
"$testcase, $option"
133 catch
{ remote_file build
delete $output
}
137 # Prune warnings we know are unwanted.
138 set comp_output
[prune_warnings $comp_output
]
140 #
Report if the testcase is not supported.
141 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
142 if { $unsupported_message
!= "" } {
143 unsupported
"$testcase: $unsupported_message"
144 catch
{ remote_file build
delete $output
}
148 # remove
any leftover LF
/CR to make sure
any output is legit
149 regsub
-all
-- "\[\r\n\]*" $comp_output "" comp_output
151 #
If any message remains
, we fail.
152 if ![string match
"" $comp_output] then {
153 gfortran_fail $testcase $option
154 catch
{ remote_file build
delete $output
}
158 gfortran_pass $testcase $option
159 catch
{ remote_file build
delete $output
}
164 # fortran
-torture
-execute -- compile and
execute a testcase.
166 # SRC is the full pathname of the testcase.
168 #
If the testcase has an associated .x file
, we source that to run the
169 # test instead. We use .x so that we don
't lengthen the existing filename
170 # to more than 14 chars.
172 proc fortran-torture-execute { src } {
176 global compiler_conditional_xfail_data
177 global TORTURE_OPTIONS
179 # Check for alternate driver.
180 set additional_flags ""
181 if [file exists [file rootname $src].x] {
182 verbose "Using alternate driver [file rootname [file tail $src]].x" 2
184 catch "set done_p \[source [file rootname $src].x\]"
190 # Setup the options for the testcase run.
191 set option_list $TORTURE_OPTIONS
192 set executable $tmpdir/[file tail [file rootname $src].x]
193 regsub "(?q)$srcdir/" $src "" testcase
195 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
196 # The point is to reduce the unnecessary noise in the logs. Don't
strip
197 # out too much because different testcases with the same
name can confuse
199 if [string match "/*" $testcase] {
200 set testcase "[file tail [file dirname $src]]/[file tail $src]"
203 # Walk the list of options and copmile and run the testcase for all
204 # options that are not explicitly disabled by the .x script (if present).
205 foreach option $option_list {
207 # Torture_{compile,execute}_xfail are set by the .x script.
208 if [info exists torture_compile_xfail] {
209 setup_xfail $torture_compile_xfail
212 # Torture_execute_before_{compile,execute} can be set by the .x script.
213 if [info exists torture_eval_before_compile] {
214 set ignore_me [eval $torture_eval_before_compile]
217 # FIXME: We should make sure that the modules required by this testcase
218 # exist. If not, the testcase should XFAIL.
220 # Compile the testcase.
221 catch { remote_file build delete $executable }
222 verbose "Testing $testcase, $option" 1
225 lappend options "additional_flags=-w $option"
226 if { $additional_flags != "" } {
227 lappend options "additional_flags=$additional_flags"
229 set comp_output [gfortran_target_compile "$src" "$executable" executable $options]
231 # See if we got something bad.
232 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
234 if [string match "$fatal_signal 6" $comp_output] then {
235 gfortran_fail $testcase "Got Signal 6, $option"
236 catch { remote_file build delete $executable }
240 if [string match "$fatal_signal 11" $comp_output] then {
241 gfortran_fail $testcase "Got Signal 11, $option"
242 catch { remote_file build delete $executable }
246 if [string match "*internal compiler error*" $comp_output] then {
247 gfortran_fail $testcase "$option (internal compiler error)"
248 catch { remote_file build delete $executable }
252 # We shouldn't
get these because of
-w
, but just in case.
253 if [string match
"*95*:*warning:*" $comp_output] then {
254 warning
"$testcase: (with warnings) $option"
255 send_log
"$comp_output\n"
256 unresolved
"$testcase, $option"
257 catch
{ remote_file build
delete $executable
}
261 # Prune warnings we know are unwanted.
262 set comp_output
[prune_warnings $comp_output
]
264 #
Report if the testcase is not supported.
265 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
266 if { $unsupported_message
!= "" } {
267 unsupported
"$testcase: $unsupported_message"
269 } elseif
![file
exists $executable
] {
271 fail
"$testcase compilation, $option"
272 untested
"$testcase execution, $option"
275 # FIXME
: since we can
't test for the existence of a remote
276 # file without short of doing an remote file list, we assume
277 # that since we got no output, it must have compiled.
278 pass "$testcase compilation, $option"
281 pass "$testcase compilation, $option"
284 # See if this source file uses INTEGER(KIND=8) types, if it does, and
285 # no_long_long is set, skip execution of the test.
286 # FIXME: We should also look for F95 style "_8" or select_int_kind()
287 # integers, but that is obviously much harder than just regexping this.
288 # So maybe we should just avoid those in testcases.
289 if [target_info exists no_long_long] then {
290 if [expr [search_for_re $src "integer\*8"] \
291 +[search_for_re $src "integer *( *8 *)"] \
292 +[search_for_re $src "integer *( *kind *= *8 *)"]] \
294 untested "$testcase execution, $option"
299 if [info exists torture_execute_xfail] {
300 setup_xfail $torture_execute_xfail
303 if [info exists torture_eval_before_execute] {
304 set ignore_me [eval $torture_eval_before_execute]
307 # Run the testcase, and analyse the output.
308 set result [gfortran_load "$executable" "" ""]
309 set status [lindex $result 0]
310 set output [lindex $result 1]
311 if { $status == "pass" } {
312 catch { remote_file build delete $executable }
314 $status "$testcase execution, $option"
320 # search_for_re -- looks for a string match in a file
322 proc search_for_re { file pattern } {
323 set fd [open $file r]
324 while { [gets $fd cur_line]>=0 } {
325 set lower [string tolower $cur_line]
326 if [regexp "$pattern" $lower] then {
337 # fortran-torture -- the fortran-torture testcase source file processor
339 # This runs compilation only tests (no execute tests).
341 # SRC is the full pathname of the testcase, or just a file name in which
342 # case we prepend $srcdir/$subdir.
344 # If the testcase has an associated .x file, we source that to run the
345 # test instead. We use .x so that we don't lengthen the existing filename
346 # to more than
14 chars.
348 proc fortran
-torture
{ args } {
350 global compiler_conditional_xfail_data
351 global TORTURE_OPTIONS
353 set src
[lindex $
args 0]
354 if { [llength $
args] > 1 } {
355 set options
[lindex $
args 1]
360 # Prepend $srdir
/$subdir
if missing.
361 if ![string match
"*/*" $src] {
362 set src
"$srcdir/$subdir/$src"
365 # Check
for alternate driver.
366 if [file
exists [file rootname $src
].x
] {
367 verbose
"Using alternate driver [file rootname [file tail $src]].x" 2
369 catch
"set done_p \[source [file rootname $src].x\]"
375 # loop through all the options
376 set option_list $TORTURE_OPTIONS
377 foreach option $option_list
{
379 # torture_compile_xfail is
set by the .x script
(if present
)
380 if [info exists torture_compile_xfail
] {
381 setup_xfail $torture_compile_xfail
384 # torture_execute_before_compile is
set by the .x script
(if present
)
385 if [info exists torture_eval_before_compile
] {
386 set ignore_me
[eval $torture_eval_before_compile
]
389 fortran
-torture
-compile $src
"$option $options"
394 # add
-ieee
-options
-- add options necessary
for 100% ieee conformance.
396 proc add
-ieee
-options
{ } {
397 # Ensure that excess precision does not cause problems.
398 if { [istarget
"i?86-*-*"]
399 ||
[istarget
"m68k-*-*"] } then {
400 uplevel
1 lappend additional_flags
"-ffloat-store"
403 # Enable full IEEE compliance
mode.
404 if { [istarget
"alpha*-*-*"]
405 ||
[istarget
"sh*-*-*"] } then {
406 uplevel
1 lappend additional_flags
"-mieee"