1 # Copyright
(C
) 2003 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
2 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 this
program; if not
, write to the Free Software
15 # Foundation
, 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA.
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 # The biggest change from g77 is that we always test all testcases with
24 # loop options
, because it is much harder to figure out whether a testcase
25 # has loops
if you have array syntax
, like Fortran
95. In fact
, the whole
26 # point of F95 is arrays
, so loops
show up in most testcases anyway.
29 # The default option list can be overridden by
30 # TORTURE_OPTIONS
="{ { list1 } ... { listN } }"
32 if ![info exists TORTURE_OPTIONS
] {
33 set TORTURE_OPTIONS
[list \
34 { -O0
} { -O1
} { -O2
} \
35 { -O2
-fomit
-frame
-pointer
-finline
-functions
} \
36 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-loops
} \
37 { -O2
-fbounds
-check
} \
38 { -O2
-fno
-repack
-arrays
} \
45 # fortran
-torture
-compile -- compile a gfortran.fortran
-torture testcase.
47 # SRC is the full pathname of the testcase.
48 # OPTION is the specific compiler flag we
're testing (eg: -O2).
50 proc fortran-torture-compile { src option } {
55 set output "$tmpdir/[file tail [file rootname $src]].o"
57 regsub "^$srcdir/?" $src "" testcase
59 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
60 # The point is to reduce the unnecessary noise in the logs. Don't
strip
61 # out too much because different testcases with the same
name can confuse
63 if [string match "/*" $testcase] {
64 set testcase "[file tail [file dirname $src]]/[file tail $src]"
67 verbose "Testing $testcase, $option" 1
69 # Run the compiler and get results in comp_output.
71 lappend options "additional_flags=-w $option"
73 set comp_output [gfortran_target_compile "$src" "$output" object $options]
75 # See if we got something bad.
76 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
78 if [string match "$fatal_signal 6" $comp_output] then {
79 gfortran_fail $testcase "Got Signal 6, $option"
80 catch { remote_file build delete $output }
84 if [string match "$fatal_signal 11" $comp_output] then {
85 gfortran_fail $testcase "Got Signal 11, $option"
86 catch { remote_file build delete $output }
90 # We shouldn't
get these because of
-w
, but just in case.
91 if [string match
"*95*:*warning:*" $comp_output] then {
92 warning
"$testcase: (with warnings) $option"
93 send_log
"$comp_output\n"
94 unresolved
"$testcase, $option"
95 catch
{ remote_file build
delete $output
}
99 # Prune warnings we know are unwanted.
100 set comp_output
[prune_warnings $comp_output
]
102 #
Report if the testcase is not supported.
103 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
104 if { $unsupported_message
!= "" } {
105 unsupported
"$testcase: $unsupported_message"
106 catch
{ remote_file build
delete $output
}
110 # remove
any leftover LF
/CR to make sure
any output is legit
111 regsub
-all
-- "\[\r\n\]*" $comp_output "" comp_output
113 #
If any message remains
, we fail.
114 if ![string match
"" $comp_output] then {
115 gfortran_fail $testcase $option
116 catch
{ remote_file build
delete $output
}
120 gfortran_pass $testcase $option
121 catch
{ remote_file build
delete $output
}
126 # fortran
-torture
-execute -- compile and
execute a testcase.
128 # SRC is the full pathname of the testcase.
130 #
If the testcase has an associated .x file
, we source that to run the
131 # test instead. We use .x so that we don
't lengthen the existing filename
132 # to more than 14 chars.
134 proc fortran-torture-execute { src } {
138 global compiler_conditional_xfail_data
139 global TORTURE_OPTIONS
141 # Check for alternate driver.
142 set additional_flags ""
143 if [file exists [file rootname $src].x] {
144 verbose "Using alternate driver [file rootname [file tail $src]].x" 2
146 catch "set done_p \[source [file rootname $src].x\]"
152 # Setup the options for the testcase run.
153 set option_list $TORTURE_OPTIONS
154 set executable $tmpdir/[file tail [file rootname $src].x]
155 regsub "^$srcdir/?" $src "" testcase
157 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
158 # The point is to reduce the unnecessary noise in the logs. Don't
strip
159 # out too much because different testcases with the same
name can confuse
161 if [string match "/*" $testcase] {
162 set testcase "[file tail [file dirname $src]]/[file tail $src]"
165 # Walk the list of options and copmile and run the testcase for all
166 # options that are not explicitly disabled by the .x script (if present).
167 foreach option $option_list {
169 # Torture_{compile,execute}_xfail are set by the .x script.
170 if [info exists torture_compile_xfail] {
171 setup_xfail $torture_compile_xfail
174 # Torture_execute_before_{compile,execute} can be set by the .x script.
175 if [info exists torture_eval_before_compile] {
176 set ignore_me [eval $torture_eval_before_compile]
179 # FIXME: We should make sure that the modules required by this testcase
180 # exist. If not, the testcase should XFAIL.
182 # Compile the testcase.
183 catch { remote_file build delete $executable }
184 verbose "Testing $testcase, $option" 1
187 lappend options "additional_flags=-w $option"
188 if { $additional_flags != "" } {
189 lappend options "additional_flags=$additional_flags"
191 set comp_output [gfortran_target_compile "$src" "$executable" executable $options]
193 # See if we got something bad.
194 set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
196 if [string match "$fatal_signal 6" $comp_output] then {
197 gfortran_fail $testcase "Got Signal 6, $option"
198 catch { remote_file build delete $executable }
202 if [string match "$fatal_signal 11" $comp_output] then {
203 gfortran_fail $testcase "Got Signal 11, $option"
204 catch { remote_file build delete $executable }
208 # We shouldn't
get these because of
-w
, but just in case.
209 if [string match
"*95*:*warning:*" $comp_output] then {
210 warning
"$testcase: (with warnings) $option"
211 send_log
"$comp_output\n"
212 unresolved
"$testcase, $option"
213 catch
{ remote_file build
delete $executable
}
217 # Prune warnings we know are unwanted.
218 set comp_output
[prune_warnings $comp_output
]
220 #
Report if the testcase is not supported.
221 set unsupported_message
[gfortran_check_unsupported_p $comp_output
]
222 if { $unsupported_message
!= "" } {
223 unsupported
"$testcase: $unsupported_message"
225 } elseif
![file
exists $executable
] {
227 fail
"$testcase compilation, $option"
228 untested
"$testcase execution, $option"
231 # FIXME
: since we can
't test for the existance of a remote
232 # file without short of doing an remote file list, we assume
233 # that since we got no output, it must have compiled.
234 pass "$testcase compilation, $option"
237 pass "$testcase compilation, $option"
240 # See if this source file uses INTEGER(KIND=8) types, if it does, and
241 # no_long_long is set, skip execution of the test.
242 # FIXME: We should also look for F95 style "_8" or select_int_kind()
243 # integers, but that is obviously much harder than just regexping this.
244 # So maybe we should just avoid those in testcases.
245 if [target_info exists no_long_long] then {
246 if [expr [search_for_re $src "integer\*8"] \
247 +[search_for_re $src "integer *( *8 *)"] \
248 +[search_for_re $src "integer *( *kind *= *8 *)"]] \
250 untested "$testcase execution, $option"
255 if [info exists torture_execute_xfail] {
256 setup_xfail $torture_execute_xfail
259 if [info exists torture_eval_before_execute] {
260 set ignore_me [eval $torture_eval_before_execute]
263 # Run the testcase, and analyse the output.
264 set result [gfortran_load "$executable" "" ""]
265 set status [lindex $result 0]
266 set output [lindex $result 1]
267 if { $status == "pass" } {
268 catch { remote_file build delete $executable }
270 $status "$testcase execution, $option"
276 # search_for_re -- looks for a string match in a file
278 proc search_for_re { file pattern } {
279 set fd [open $file r]
280 while { [gets $fd cur_line]>=0 } {
281 set lower [string tolower $cur_line]
282 if [regexp "$pattern" $lower] then {
293 # fortran-torture -- the fortran-torture testcase source file processor
295 # This runs compilation only tests (no execute tests).
297 # SRC is the full pathname of the testcase, or just a file name in which
298 # case we prepend $srcdir/$subdir.
300 # If the testcase has an associated .x file, we source that to run the
301 # test instead. We use .x so that we don't lengthen the existing filename
302 # to more than
14 chars.
304 proc fortran
-torture
{ args } {
306 global compiler_conditional_xfail_data
308 set src
[lindex $
args 0]
309 if { [llength $
args] > 1 } {
310 set options
[lindex $
args 1]
315 # Prepend $srdir
/$subdir
if missing.
316 if ![string match
"*/*" $src] {
317 set src
"$srcdir/$subdir/$src"
320 # Check
for alternate driver.
321 if [file
exists [file rootname $src
].x
] {
322 verbose
"Using alternate driver [file rootname [file tail $src]].x" 2
324 catch
"set done_p \[source [file rootname $src].x\]"
330 # loop through all the options
331 set option_list
[list
{ "-O" } ]
332 foreach option $option_list
{
334 # torture_compile_xfail is
set by the .x script
(if present
)
335 if [info exists torture_compile_xfail
] {
336 setup_xfail $torture_compile_xfail
339 # torture_execute_before_compile is
set by the .x script
(if present
)
340 if [info exists torture_eval_before_compile
] {
341 set ignore_me
[eval $torture_eval_before_compile
]
344 fortran
-torture
-compile $src
"$option $options"
349 # add
-ieee
-options
-- add options necessary
for 100% ieee conformance.
351 proc add
-ieee
-options
{ } {
352 # Ensure that excess precision does not cause problems.
353 if { [istarget
"i?86-*-*"]
354 ||
[istarget
"m68k-*-*"] } then {
355 uplevel
1 lappend additional_flags
"-ffloat-store"
358 # Enable full IEEE compliance
mode.
359 if { [istarget
"alpha*-*-*"]
360 ||
[istarget
"sh*-*-*"] } then {
361 uplevel
1 lappend additional_flags
"-mieee"