1# Copyright (C) 2009-2016 Free Software Foundation, Inc.
2
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.
7#
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.
12#
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/>.
16
17# Please email any bugs, comments, and/or additions to this file to
18# the author.
19
20# This file was written by Ian Lance Taylor <iant@google.com> based on
21# fortran-torture.exp by Steven Bosscher and Rob Savoye.
22
23load_lib target-supports.exp
24
25load_lib target-utils.exp
26
27# The default option list can be overridden by
28# TORTURE_OPTIONS="{ { list1 } ... { listN } }"
29
30if ![info exists TORTURE_OPTIONS] {
31    set TORTURE_OPTIONS [list \
32	{ -O0 } { -O1 } { -O2 } \
33	{ -O2 -fomit-frame-pointer -finline-functions } \
34	{ -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \
35	{ -O2 -fbounds-check } \
36	{ -O3 -g } \
37	{ -Os }]
38}
39
40
41#
42# go-torture-compile -- compile a go.go-torture testcase.
43#
44# SRC is the full pathname of the testcase.
45# OPTION is the specific compiler flag we're testing (eg: -O2).
46#
47proc go-torture-compile { src option } {
48    global output
49    global srcdir tmpdir
50    global host_triplet
51
52    set output "$tmpdir/[file tail [file rootname $src]].o"
53
54    regsub "(?q)$srcdir/" $src "" testcase
55
56    # If we couldn't rip $srcdir out of `src' then just do the best we can.
57    # The point is to reduce the unnecessary noise in the logs.  Don't strip
58    # out too much because different testcases with the same name can confuse
59    # `test-tool'.
60    if [string match "/*" $testcase] {
61	set testcase "[file tail [file dirname $src]]/[file tail $src]"
62    }
63
64    verbose "Testing $testcase, $option" 1
65
66    # Run the compiler and get results in comp_output.
67    set options ""
68    lappend options "additional_flags=-w $option"
69
70    set comp_output [go_target_compile "$src" "$output" object $options]
71
72    # See if we got something bad.
73    set fatal_signal "*go*: Internal compiler error: program*got fatal signal"
74
75    if [string match "$fatal_signal 6" $comp_output] then {
76	go_fail $testcase "Got Signal 6, $option"
77	catch { remote_file build delete $output }
78	return
79    }
80
81    if [string match "$fatal_signal 11" $comp_output] then {
82	go_fail $testcase "Got Signal 11, $option"
83	catch { remote_file build delete $output }
84	return
85    }
86
87    if [string match "*internal compiler error*" $comp_output] then {
88	go_fail $testcase "$option (internal compiler error)"
89	catch { remote_file build delete $output }
90	return
91    }
92
93    # We shouldn't get these because of -w, but just in case.
94    if [string match "*go*:*warning:*" $comp_output] then {
95	warning "$testcase: (with warnings) $option"
96	send_log "$comp_output\n"
97	unresolved "$testcase, $option"
98	catch { remote_file build delete $output }
99	return
100    }
101
102    # Prune warnings we know are unwanted.
103    set comp_output [prune_warnings $comp_output]
104
105    # Report if the testcase is not supported.
106    set unsupported_message [go_check_unsupported_p $comp_output]
107    if { $unsupported_message != "" } {
108	unsupported "$testcase: $unsupported_message"
109	catch { remote_file build delete $output }
110	return
111    }
112
113    # remove any leftover LF/CR to make sure any output is legit
114    regsub -all -- "\[\r\n\]*" $comp_output "" comp_output
115
116    # If any message remains, we fail.
117    if ![string match "" $comp_output] then {
118	go_fail $testcase $option
119	catch { remote_file build delete $output }
120	return
121    }
122
123    go_pass $testcase $option
124    catch { remote_file build delete $output }
125}
126
127
128#
129# go-torture-execute -- compile and execute a testcase.
130#
131# SRC is the full pathname of the testcase.
132#
133# If the testcase has an associated .x file, we source that to run the
134# test instead.  We use .x so that we don't lengthen the existing filename
135# to more than 14 chars.
136#
137proc go-torture-execute { src } {
138    global output
139    global srcdir tmpdir
140    global tool
141    global compiler_conditional_xfail_data
142    global TORTURE_OPTIONS
143    global go_compile_args
144    global go_execute_args
145
146    # Check for alternate driver.
147    set additional_flags ""
148    if [file exists [file rootname $src].x] {
149	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
150	set done_p 0
151	catch "set done_p \[source [file rootname $src].x\]"
152	if { $done_p } {
153	    return
154	}
155    }
156
157    # Setup the options for the testcase run.
158    set option_list $TORTURE_OPTIONS
159    set executable $tmpdir/[file tail [file rootname $src].x]
160    regsub "(?q)$srcdir/" $src "" testcase
161
162    if { ! [info exists go_compile_args] } {
163	set go_compile_args ""
164    }
165    if { ! [info exists go_execute_args] } {
166	set go_execute_args ""
167    }
168
169    # If we couldn't rip $srcdir out of `src' then just do the best we can.
170    # The point is to reduce the unnecessary noise in the logs.  Don't strip
171    # out too much because different testcases with the same name can confuse
172    # `test-tool'.
173    if [string match "/*" $testcase] {
174	set testcase "[file tail [file dirname $src]]/[file tail $src]"
175    }
176
177    # Walk the list of options and copmile and run the testcase for all
178    # options that are not explicitly disabled by the .x script (if present).
179    foreach option $option_list {
180
181	# Torture_{compile,execute}_xfail are set by the .x script.
182	if [info exists torture_compile_xfail] {
183	    setup_xfail $torture_compile_xfail
184	}
185
186	# Torture_execute_before_{compile,execute} can be set by the .x script.
187	if [info exists torture_eval_before_compile] {
188            set ignore_me [eval $torture_eval_before_compile]
189	}
190
191	# FIXME: We should make sure that the modules required by this testcase
192	# exist.  If not, the testcase should XFAIL.
193
194	# Compile the testcase.
195	catch { remote_file build delete $executable }
196	verbose "Testing $testcase, $option" 1
197
198	set options ""
199	lappend options "additional_flags=-w $option"
200	if { $additional_flags != "" } {
201	    lappend options "additional_flags=$additional_flags"
202	}
203	if { $go_compile_args != "" } {
204	    lappend options "additional_flags=$go_compile_args"
205	}
206	set comp_output [go_target_compile "$src" "$executable" executable $options]
207
208	# See if we got something bad.
209	set fatal_signal "*go*: Internal compiler error: program*got fatal signal"
210
211	if [string match "$fatal_signal 6" $comp_output] then {
212	    go_fail $testcase "Got Signal 6, $option"
213	    catch { remote_file build delete $executable }
214	    continue
215	}
216
217	if [string match "$fatal_signal 11" $comp_output] then {
218	    go_fail $testcase "Got Signal 11, $option"
219	    catch { remote_file build delete $executable }
220	    continue
221	}
222
223	if [string match "*internal compiler error*" $comp_output] then {
224	    go_fail $testcase "$option (internal compiler error)"
225	    catch { remote_file build delete $executable }
226	    continue
227	}
228
229	# We shouldn't get these because of -w, but just in case.
230	if [string match "*go*:*warning:*" $comp_output] then {
231	    warning "$testcase: (with warnings) $option"
232	    send_log "$comp_output\n"
233	    unresolved "$testcase, $option"
234	    catch { remote_file build delete $executable }
235	    continue
236	}
237
238	# Prune warnings we know are unwanted.
239	set comp_output [prune_warnings $comp_output]
240
241	# Report if the testcase is not supported.
242	set unsupported_message [go_check_unsupported_p $comp_output]
243	if { $unsupported_message != "" } {
244	    unsupported "$testcase: $unsupported_message"
245	    continue
246	} elseif ![file exists $executable] {
247	    if ![is3way] {
248		fail "$testcase compilation, $option"
249		untested "$testcase execution, $option"
250		continue
251	    } else {
252		# FIXME: since we can't test for the existence of a remote
253		# file without short of doing an remote file list, we assume
254		# that since we got no output, it must have compiled.
255		pass "$testcase compilation, $option"
256	    }
257	} else {
258	    pass "$testcase compilation, $option"
259	}
260
261	if [info exists torture_execute_xfail] {
262	    setup_xfail $torture_execute_xfail
263	}
264
265	if [info exists torture_eval_before_execute] {
266            set ignore_me [eval $torture_eval_before_execute]
267	}
268
269	# Run the testcase, and analyse the output.
270	set result [go_load "$executable" "$go_execute_args" ""]
271	set status [lindex $result 0]
272	set output [lindex $result 1]
273
274	# In order to cooperate nicely with the master Go testsuite,
275	# if the output contains the string BUG, we treat the test as
276	# failing.
277	if [ string match "*BUG*" $output ] {
278	    set status "fail"
279	}
280
281        if { $status == "pass" } {
282	    catch { remote_file build delete $executable }
283        }
284	$status "$testcase execution, $option"
285    }
286}
287
288
289#
290# search_for_re -- looks for a string match in a file
291#
292proc search_for_re { file pattern } {
293    set fd [open $file r]
294    while { [gets $fd cur_line]>=0 } {
295	set lower [string tolower $cur_line]
296	if [regexp "$pattern" $lower] then {
297	    close $fd
298	    return 1
299	}
300    }
301    close $fd
302    return 0
303}
304
305
306#
307# go-torture -- the go-torture testcase source file processor
308#
309# This runs compilation only tests (no execute tests).
310#
311# SRC is the full pathname of the testcase, or just a file name in which
312# case we prepend $srcdir/$subdir.
313#
314# If the testcase has an associated .x file, we source that to run the
315# test instead.  We use .x so that we don't lengthen the existing filename
316# to more than 14 chars.
317#
318proc go-torture { args } {
319    global srcdir subdir
320    global compiler_conditional_xfail_data
321    global TORTURE_OPTIONS
322
323    set src [lindex $args 0]
324    if { [llength $args] > 1 } {
325	set options [lindex $args 1]
326    } else {
327	set options ""
328    }
329
330    # Prepend $srdir/$subdir if missing.
331    if ![string match "*/*" $src] {
332	set src "$srcdir/$subdir/$src"
333    }
334
335    # Check for alternate driver.
336    if [file exists [file rootname $src].x] {
337	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
338	set done_p 0
339	catch "set done_p \[source [file rootname $src].x\]"
340	if { $done_p } {
341	    return
342	}
343    }
344
345    # loop through all the options
346    set option_list $TORTURE_OPTIONS
347    foreach option $option_list {
348
349	# torture_compile_xfail is set by the .x script (if present)
350	if [info exists torture_compile_xfail] {
351	    setup_xfail $torture_compile_xfail
352	}
353
354	# torture_execute_before_compile is set by the .x script (if present)
355	if [info exists torture_eval_before_compile] {
356            set ignore_me [eval $torture_eval_before_compile]
357	}
358
359	go-torture-compile $src "$option $options"
360    }
361}
362
363#
364# add-ieee-options -- add options necessary for 100% ieee conformance.
365#
366proc add-ieee-options { } {
367    # Ensure that excess precision does not cause problems.
368    if { [istarget i?86-*-*]
369	 || [istarget m68k-*-*] } then {
370      uplevel 1 lappend additional_flags "-ffloat-store"
371    }
372
373    # Enable full IEEE compliance mode.
374    if { [istarget alpha*-*-*]
375         || [istarget sh*-*-*] } then {
376      uplevel 1 lappend additional_flags "-mieee"
377    }
378}
379