summaryrefslogtreecommitdiff
path: root/gcc/testsuite/lib/fortran-torture.exp
blob: 9d875a00bb5f69860b88fb06f98e4614c1637c96 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
# Copyright (C) 2003, 2006, 2007, 2008, 2010 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3.  If not see
# <http://www.gnu.org/licenses/>.

# Please email any bugs, comments, and/or additions to this file to
# the author.

# This file was written by Steven Bosscher (s.bosscher@student.tudelft.nl)
# based on f-torture.exp, which was written by Rob Savoye.

load_lib target-supports.exp
load_lib fortran-modules.exp

# Return the list of options to use for fortran torture tests.
# The default option list can be overridden by
# TORTURE_OPTIONS="{ { list1 } ... { listN } }"
proc get-fortran-torture-options { } {
    global TORTURE_OPTIONS

    if [info exists TORTURE_OPTIONS] {
	return $TORTURE_OPTIONS
    }

    # determine if host supports vectorization, and the necessary set
    # of options, based on code from testsuite/vect/vect.exp

    set vectorizer_options [list "-O2" "-ftree-vectorize"]

    if { [istarget powerpc*-*-*]
	 && [is-effective-target powerpc_altivec_ok]
	 && [check_vmx_hw_available] } {
	lappend vectorizer_options "-maltivec"
	set test_tree_vectorize 1
    } elseif { [istarget spu-*-*] } {
	set test_tree_vectorize 1
    } elseif { ( [istarget i?86-*-*] || [istarget x86_64-*-*] )
	       && [check_effective_target_sse2]
	       && [check_sse2_hw_available]
	       && [check_sse_os_support_available] } {
	lappend vectorizer_options "-msse2"
	set test_tree_vectorize 1
    } elseif { [istarget mips*-*-*]
	       && [check_effective_target_mpaired_single]
	       && [check_effective_target_nomips16] } {
	lappend vectorizer_options "-mpaired-single"
	set test_tree_vectorize 1
    } elseif { [istarget sparc*-*-*]
	       && [check_effective_target_ultrasparc_hw] } {
	lappend vectorizer_options "-mcpu=ultrasparc" "-mvis"
	set test_tree_vectorize 1
    } elseif { [istarget alpha*-*-*]
	       && [check_alpha_max_hw_available] } {
	lappend vectorizer_options "-mmax"
	set test_tree_vectorize 1
    } elseif [istarget ia64-*-*] {
	set test_tree_vectorize 1
    } else {
	set test_tree_vectorize 0
    }

    set options {}

    lappend options \
	{ -O0 } \
	{ -O1 } \
	{ -O2 } \
	{ -O2 -fomit-frame-pointer -finline-functions } \
	{ -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \
	{ -O2 -fbounds-check } \
	{ -O3 -g } \
	{ -Os }
    if { $test_tree_vectorize } {
	lappend options $vectorizer_options
    }

    if [info exists ADDITIONAL_TORTURE_OPTIONS] {
	set options [concat $options $ADDITIONAL_TORTURE_OPTIONS]
    }

    return $options
}


#
# fortran-torture-compile -- compile a gfortran.fortran-torture testcase.
#
# SRC is the full pathname of the testcase.
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc fortran-torture-compile { src option } {
    global output
    global srcdir tmpdir
    global host_triplet

    set output "$tmpdir/[file tail [file rootname $src]].o"

    regsub "(?q)$srcdir/" $src "" testcase

    # If we couldn't rip $srcdir out of `src' then just do the best we can.
    # The point is to reduce the unnecessary noise in the logs.  Don't strip
    # out too much because different testcases with the same name can confuse
    # `test-tool'.
    if [string match "/*" $testcase] {
	set testcase "[file tail [file dirname $src]]/[file tail $src]"
    }

    verbose "Testing $testcase, $option" 1

    # Run the compiler and get results in comp_output.
    set options ""
    lappend options "additional_flags=-w $option"

    set comp_output [gfortran_target_compile "$src" "$output" object $options]
    
    # See if we got something bad.
    set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
 
    if [string match "$fatal_signal 6" $comp_output] then {
	gfortran_fail $testcase "Got Signal 6, $option"
	catch { remote_file build delete $output }
	return
    }

    if [string match "$fatal_signal 11" $comp_output] then {
	gfortran_fail $testcase "Got Signal 11, $option"
	catch { remote_file build delete $output }
	return
    }

    if [string match "*internal compiler error*" $comp_output] then {
	gfortran_fail $testcase "$option (internal compiler error)"
	catch { remote_file build delete $output }
	return
    }

    # We shouldn't get these because of -w, but just in case.
    if [string match "*95*:*warning:*" $comp_output] then {
	warning "$testcase: (with warnings) $option"
	send_log "$comp_output\n"
	unresolved "$testcase, $option"
	catch { remote_file build delete $output }
	return
    }

    # Prune warnings we know are unwanted.
    set comp_output [prune_warnings $comp_output]

    # Report if the testcase is not supported.
    set unsupported_message [gfortran_check_unsupported_p $comp_output]
    if { $unsupported_message != "" } {
	unsupported "$testcase: $unsupported_message"
	catch { remote_file build delete $output }
	return
    }

    # remove any leftover LF/CR to make sure any output is legit
    regsub -all -- "\[\r\n\]*" $comp_output "" comp_output

    # If any message remains, we fail.
    if ![string match "" $comp_output] then {
	gfortran_fail $testcase $option
	catch { remote_file build delete $output }
	return
    }

    gfortran_pass $testcase $option
    catch { remote_file build delete $output }
}


#
# fortran-torture-execute -- compile and execute a testcase.
#
# SRC is the full pathname of the testcase.
#
# If the testcase has an associated .x file, we source that to run the
# test instead.  We use .x so that we don't lengthen the existing filename
# to more than 14 chars.
#
proc fortran-torture-execute { src } {
    global output
    global srcdir tmpdir
    global tool
    global compiler_conditional_xfail_data
    global torture_with_loops

    # Check for alternate driver.
    set additional_flags ""
    if [file exists [file rootname $src].x] {
	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
	set done_p 0
	catch "set done_p \[source [file rootname $src].x\]"
	if { $done_p } {
	    return
	}
    }

    # Setup the options for the testcase run.
    set option_list $torture_with_loops
    set executable $tmpdir/[file tail [file rootname $src].x]
    regsub "(?q)$srcdir/" $src "" testcase

    # If we couldn't rip $srcdir out of `src' then just do the best we can.
    # The point is to reduce the unnecessary noise in the logs.  Don't strip
    # out too much because different testcases with the same name can confuse
    # `test-tool'.
    if [string match "/*" $testcase] {
	set testcase "[file tail [file dirname $src]]/[file tail $src]"
    }
    list-module-names $src

    # Walk the list of options and copmile and run the testcase for all
    # options that are not explicitly disabled by the .x script (if present).
    foreach option $option_list {

	# Torture_{compile,execute}_xfail are set by the .x script.
	if [info exists torture_compile_xfail] {
	    setup_xfail $torture_compile_xfail
	}

	# Torture_execute_before_{compile,execute} can be set by the .x script.
	if [info exists torture_eval_before_compile] {
            set ignore_me [eval $torture_eval_before_compile]
	}

	# FIXME: We should make sure that the modules required by this testcase
	# exist.  If not, the testcase should XFAIL.

	# Compile the testcase.
	catch { remote_file build delete $executable }
	verbose "Testing $testcase, $option" 1

	set options ""
	lappend options "additional_flags=-w $option"
	if { $additional_flags != "" } {
	    lappend options "additional_flags=$additional_flags"
	}
	set comp_output [gfortran_target_compile "$src" "$executable" executable $options]

	# See if we got something bad.
	set fatal_signal "*95*: Internal compiler error: program*got fatal signal"
	
	if [string match "$fatal_signal 6" $comp_output] then {
	    gfortran_fail $testcase "Got Signal 6, $option"
	    catch { remote_file build delete $executable }
	    continue
	}
	
	if [string match "$fatal_signal 11" $comp_output] then {
	    gfortran_fail $testcase "Got Signal 11, $option"
	    catch { remote_file build delete $executable }
	    continue
	}

	if [string match "*internal compiler error*" $comp_output] then {
	    gfortran_fail $testcase "$option (internal compiler error)"
	    catch { remote_file build delete $executable }
	    continue
	}
	
	# We shouldn't get these because of -w, but just in case.
	if [string match "*95*:*warning:*" $comp_output] then {
	    warning "$testcase: (with warnings) $option"
	    send_log "$comp_output\n"
	    unresolved "$testcase, $option"
	    catch { remote_file build delete $executable }
	    continue
	}
	
	# Prune warnings we know are unwanted.
	set comp_output [prune_warnings $comp_output]

	# Report if the testcase is not supported.
	set unsupported_message [gfortran_check_unsupported_p $comp_output]
	if { $unsupported_message != "" } {
	    unsupported "$testcase: $unsupported_message"
	    continue
	} elseif ![file exists $executable] {
	    if ![is3way] {
		fail "$testcase compilation, $option"
		untested "$testcase execution, $option"
		continue
	    } else {
		# FIXME: since we can't test for the existence of a remote
		# file without short of doing an remote file list, we assume
		# that since we got no output, it must have compiled.
		pass "$testcase compilation, $option"		
	    }
	} else {
	    pass "$testcase compilation, $option"
	}

	# See if this source file uses INTEGER(KIND=8) types, if it does, and
	# no_long_long is set, skip execution of the test.
	# FIXME: We should also look for F95 style "_8" or select_int_kind()
	# integers, but that is obviously much harder than just regexping this.
	# So maybe we should just avoid those in testcases.
	if [target_info exists no_long_long] then {
	    if [expr [search_for_re $src "integer\*8"] \
	             +[search_for_re $src "integer *( *8 *)"] \
	             +[search_for_re $src "integer *( *kind *= *8 *)"]] \
	      then {
		untested "$testcase execution, $option"
		continue
	    }
	}

	if [info exists torture_execute_xfail] {
	    setup_xfail $torture_execute_xfail
	}

	if [info exists torture_eval_before_execute] {
            set ignore_me [eval $torture_eval_before_execute]
	}

	# Run the testcase, and analyse the output.
	set result [gfortran_load "$executable" "" ""]
	set status [lindex $result 0]
	set output [lindex $result 1]
        if { $status == "pass" } {
	    catch { remote_file build delete $executable }
        }
	$status "$testcase execution, $option"
    }
    cleanup-modules ""
}


#
# search_for_re -- looks for a string match in a file
#
proc search_for_re { file pattern } {
    set fd [open $file r]
    while { [gets $fd cur_line]>=0 } {
	set lower [string tolower $cur_line]
	if [regexp "$pattern" $lower] then {
	    close $fd
	    return 1
	}
    }
    close $fd
    return 0
}


#
# fortran-torture -- the fortran-torture testcase source file processor
#
# This runs compilation only tests (no execute tests).
#
# SRC is the full pathname of the testcase, or just a file name in which
# case we prepend $srcdir/$subdir.
#
# If the testcase has an associated .x file, we source that to run the
# test instead.  We use .x so that we don't lengthen the existing filename
# to more than 14 chars.
#
proc fortran-torture { args } {
    global srcdir subdir
    global compiler_conditional_xfail_data
    global torture_with_loops

    set src [lindex $args 0]
    if { [llength $args] > 1 } {
	set options [lindex $args 1]
    } else {
	set options ""
    }

    # Prepend $srdir/$subdir if missing.
    if ![string match "*/*" $src] {
	set src "$srcdir/$subdir/$src"
    }

    # Check for alternate driver.
    if [file exists [file rootname $src].x] {
	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
	set done_p 0
	catch "set done_p \[source [file rootname $src].x\]"
	if { $done_p } {
	    return
	}
    }
    list-module-names $src

    # loop through all the options
    set option_list $torture_with_loops
    foreach option $option_list {

	# torture_compile_xfail is set by the .x script (if present)
	if [info exists torture_compile_xfail] {
	    setup_xfail $torture_compile_xfail
	}

	# torture_execute_before_compile is set by the .x script (if present)
	if [info exists torture_eval_before_compile] {
            set ignore_me [eval $torture_eval_before_compile]
	}

	fortran-torture-compile $src "$option $options"
	cleanup-modules ""
    }
}

#
# add-ieee-options -- add options necessary for 100% ieee conformance.
#
proc add-ieee-options { } {
    # Ensure that excess precision does not cause problems.
    if { [istarget i?86-*-*]
	 || [istarget m68k-*-*] } then {
      uplevel 1 lappend additional_flags "-ffloat-store"
    }

    # Enable full IEEE compliance mode.
    if { [istarget alpha*-*-*]
         || [istarget sh*-*-*] } then {
      uplevel 1 lappend additional_flags "-mieee"
    }
}