1 # Copyright
(C
) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000 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
, 59 Temple Place
- Suite
330, Boston
, MA
02111-1307, USA.
17 # Please email
any bugs
, comments
, and
/or additions to this file to
:
18 # bug
-dejagnu@gnu.org.
20 # This file was written by Rob Savoye.
(rob@cygnus.com
)
22 # The default option list can be overridden by
23 # TORTURE_OPTIONS
="{ { list1 } ... { listN } }"
25 if ![info exists TORTURE_OPTIONS
] {
26 set TORTURE_OPTIONS
[list \
27 { -O0
} { -O1
} { -O2
} \
28 { -O2
-fomit
-frame
-pointer
-finline
-functions
} \
29 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-loops
} \
30 { -O2
-fomit
-frame
-pointer
-finline
-functions
-funroll
-all
-loops
} \
36 # Split TORTURE_OPTIONS into two choices
: one
for testcases with loops and
37 # one
for testcases without loops.
39 set torture_with_loops $TORTURE_OPTIONS
40 set torture_without_loops
""
41 foreach option $TORTURE_OPTIONS
{
42 if ![string match
"*loop*" $option] {
43 lappend torture_without_loops $option
48 # f
-torture
-compile -- runs the Tege C
-torture test
50 # SRC is the full pathname of the testcase.
51 # OPTION is the specific compiler flag we
're testing (eg: -O2).
53 proc f-torture-compile { src option } {
58 set output "$tmpdir/[file tail [file rootname $src]].o"
60 regsub "^$srcdir/?" $src "" testcase
61 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
62 # The point is to reduce the unnecessary noise in the logs. Don't
strip
63 # out too much because different testcases with the same
name can confuse
65 if [string match "/*" $testcase] {
66 set testcase "[file tail [file dirname $src]]/[file tail $src]"
69 verbose "Testing $testcase, $option" 1
71 # Run the compiler and analyze the results.
73 lappend options "additional_flags=-w $option"
75 set comp_output [g77_target_compile "$src" "$output" object $options];
77 # Set a few common compiler messages.
78 set fatal_signal "*77*: Internal compiler error: program*got fatal signal"
80 if [string match "$fatal_signal 6" $comp_output] then {
81 g77_fail $testcase "Got Signal 6, $option"
82 remote_file build delete $output
86 if [string match "$fatal_signal 11" $comp_output] then {
87 g77_fail $testcase "Got Signal 11, $option"
88 remote_file build delete $output
92 # Prune warnings we know are unwanted.
93 set comp_output [prune_warnings $comp_output]
95 # We shouldn't
get these because of
-w
, but just in case.
96 if [string match
"*77*:*warning:*" $comp_output] then {
97 warning
"$testcase: (with warnings) $option"
98 send_log
"$comp_output\n"
99 unresolved
"$testcase, $option"
100 remote_file build
delete $output
104 set unsupported_message
[g77_check_unsupported_p $comp_output
]
105 if { $unsupported_message
!= "" } {
106 unsupported
"$testcase: $unsupported_message"
107 remote_file build
delete $output
111 # remove
any leftover LF
/CR to make sure
any output is legit
112 regsub
-all
-- "\[\r\n\]*" $comp_output "" comp_output
113 #
If any message remains
, we fail.
114 if ![string match
"" $comp_output] then {
115 g77_fail $testcase $option
116 remote_file build
delete $output
120 g77_pass $testcase $option
121 remote_file build
delete $output
125 # f
-torture
-execute -- utility to
compile and
execute a testcase
127 # SRC is the full pathname of the testcase.
129 #
If the testcase has an associated .x file
, we source that to run the
130 # test instead. We use .x so that we don
't lengthen the existing filename
131 # to more than 14 chars.
133 proc f-torture-execute { src } {
134 global tmpdir tool srcdir output compiler_conditional_xfail_data
136 # Check for alternate driver.
137 if [file exists [file rootname $src].x] {
138 verbose "Using alternate driver [file rootname [file tail $src]].x" 2
140 catch "set done_p \[source [file rootname $src].x\]"
146 # Look for a loop within the source code - if we don't find one
,
147 # don
't pass -funroll[-all]-loops.
148 global torture_with_loops torture_without_loops
149 if [expr [search_for_re $src "do *\[0-9\]"]+[search_for_re $src "end *do"]] then {
150 set option_list $torture_with_loops
152 set option_list $torture_without_loops
155 set executable $tmpdir/[file tail [file rootname $src].x]
157 regsub "^$srcdir/?" $src "" testcase
158 # If we couldn't rip $srcdir out of `src
' then just do the best we can.
159 # The point is to reduce the unnecessary noise in the logs. Don't
strip
160 # out too much because different testcases with the same
name can confuse
162 if [string match "/*" $testcase] {
163 set testcase "[file tail [file dirname $src]]/[file tail $src]"
166 foreach option $option_list {
167 # torture_{compile,execute}_xfail are set by the .x script
169 if [info exists torture_compile_xfail] {
170 setup_xfail $torture_compile_xfail
173 # 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 remote_file build delete $executable
180 verbose "Testing $testcase, $option" 1
183 lappend options "additional_flags=-w $option"
184 set comp_output [g77_target_compile "$src" "$executable" executable $options];
186 # Set a few common compiler messages.
187 set fatal_signal "*77*: Internal compiler error: program*got fatal signal"
189 if [string match "$fatal_signal 6" $comp_output] then {
190 g77_fail $testcase "Got Signal 6, $option"
191 remote_file build delete $executable
195 if [string match "$fatal_signal 11" $comp_output] then {
196 g77_fail $testcase "Got Signal 11, $option"
197 remote_file build delete $executable
201 # We shouldn't
get these because of
-w
, but just in case.
202 if [string match
"*77*:*warning:*" $comp_output] then {
203 warning
"$testcase: (with warnings) $option"
204 send_log
"$comp_output\n"
205 unresolved
"$testcase, $option"
206 remote_file build
delete $executable
210 set comp_output
[prune_warnings $comp_output
]
212 set unsupported_message
[g77_check_unsupported_p $comp_output
]
214 if { $unsupported_message
!= "" } {
215 unsupported
"$testcase: $unsupported_message"
217 } elseif
![file
exists $executable
] {
219 fail
"$testcase compilation, $option"
220 untested
"$testcase execution, $option"
223 # FIXME
: since we can
't test for the existance of a remote
224 # file without short of doing an remote file list, we assume
225 # that since we got no output, it must have compiled.
226 pass "$testcase compilation, $option"
229 pass "$testcase compilation, $option"
232 # See if this source file uses "long long" types, if it does, and
233 # no_long_long is set, skip execution of the test.
234 if [target_info exists no_long_long] then {
235 if [expr [search_for_re $src "integer\*8"]] then {
236 untested "$testcase execution, $option"
241 if [info exists torture_execute_xfail] {
242 setup_xfail $torture_execute_xfail
245 if [info exists torture_eval_before_execute] {
246 set ignore_me [eval $torture_eval_before_execute]
249 set result [g77_load "$executable" "" ""]
250 set status [lindex $result 0];
251 set output [lindex $result 1];
252 if { $status == "pass" } {
253 remote_file build delete $executable
255 $status "$testcase execution, $option"
260 # search_for_re -- looks for a case-insensitive regexp match in a file
262 proc search_for_re { file pattern } {
263 set fd [open $file r]
264 while { [gets $fd cur_line]>=0 } {
265 if [regexp -nocase -- "$pattern" $cur_line] then {
275 # f-torture -- the f-torture testcase source file processor
277 # This runs compilation only tests (no execute tests).
278 # SRC is the full pathname of the testcase, or just a file name in which case
279 # we prepend $srcdir/$subdir.
281 # If the testcase has an associated .x file, we source that to run the
282 # test instead. We use .x so that we don't lengthen the existing filename
283 # to more than
14 chars.
285 proc f
-torture
{ args } {
286 global srcdir subdir compiler_conditional_xfail_data
288 set src
[lindex $
args 0];
289 if { [llength $
args] > 1 } {
290 set options
[lindex $
args 1];
295 # Prepend $srdir
/$subdir
if missing.
296 if ![string match
"*/*" $src] {
297 set src
"$srcdir/$subdir/$src"
300 # Check
for alternate driver.
301 if [file
exists [file rootname $src
].x
] {
302 verbose
"Using alternate driver [file rootname [file tail $src]].x" 2
304 catch
"set done_p \[source [file rootname $src].x\]"
310 # Look
for a loop within the source code
- if we don
't find one,
311 # don't pass
-funroll
[-all
]-loops.
312 global torture_with_loops torture_without_loops
313 if [expr
[search_for_re $src
"do *\[0-9\]"]+[search_for_re $src "end *do"]] then {
314 set option_list $torture_with_loops
316 set option_list $torture_without_loops
319 # loop through all the options
320 foreach option $option_list
{
321 # torture_compile_xfail is
set by the .x script
(if present
)
322 if [info exists torture_compile_xfail
] {
323 setup_xfail $torture_compile_xfail
326 # torture_execute_before_compile is
set by the .x script
(if present
)
327 if [info exists torture_eval_before_compile
] {
328 set ignore_me
[eval $torture_eval_before_compile
]
331 f
-torture
-compile $src
"$option $options"