aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/lib/c-torture.exp
blob: e2031d87bcdab29701eee0e06b702afb84745850 (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
# Copyright (C) 1992-1998, 1999 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 2 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 this program; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@gnu.org.

# This file was written by Rob Savoye. (rob@cygnus.com)

# The default option list can be overridden by
# TORTURE_OPTIONS="{ { list1 } ... { listN } }"

if ![info exists TORTURE_OPTIONS] {
    # It is theoretically beneficial to group all of the O2/O3 options together,
    # as in many cases the compiler will generate identical executables for
    # all of them--and the c-torture testsuite will skip testing identical
    # executables multiple times.
    # Also note that -finline-functions is explicitly included in one of the
    # items below, even though -O3 is also specified, because some ports may
    # choose to disable inlining functions by default, even when optimizing.
    set TORTURE_OPTIONS [list \
	{ -O0 } \
	{ -O1 } \
	{ -O2 } \
	{ -O3 -fomit-frame-pointer } \
	{ -O3 -fomit-frame-pointer -funroll-loops } \
	{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \
	{ -O3 -g } \
	{ -Os } ]
}


# Split TORTURE_OPTIONS into two choices: one for testcases with loops and
# one for testcases without loops.

set torture_with_loops $TORTURE_OPTIONS
set torture_without_loops ""
foreach option $TORTURE_OPTIONS {
    if ![string match "*loop*" $option] {
	lappend torture_without_loops $option
    }
}

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

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

    regsub "^$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 analyze the results.
    set options ""
    lappend options "additional_flags=-w $option"

    set comp_output [gcc_target_compile "$src" "$output" object $options];
    gcc_check_compile $testcase $option $output $comp_output
    remote_file build delete $output
}

#
# c-torture-execute -- utility to 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 c-torture-execute { src args } {
    global tmpdir tool srcdir output 

    if { [llength $args] > 0 } {
	set additional_flags [lindex $args 0];
    } else {
	set additional_flags "";
    }
    # 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
	}
    }
   
    # Look for a loop within the source code - if we don't find one,
    # don't pass -funroll[-all]-loops.
    global torture_with_loops torture_without_loops
    if [expr [search_for $src "for*("]+[search_for $src "while*("]] then {
	set option_list $torture_with_loops
    } else {
	set option_list $torture_without_loops
    }

    set executable $tmpdir/[file tail [file rootname $src].x]

    regsub "^$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]"
    }

    set count 0;
    set oldstatus "foo";
    foreach option $option_list {
	if { $count > 0 } {
	    set oldexec $execname;
	}
	set execname "${executable}${count}";
	incr count;

	# torture_{compile,execute}_xfail are set by the .x script
	# (if present)
	if [info exists torture_compile_xfail] {
	    setup_xfail $torture_compile_xfail
	}
	
	# torture_execute_before_{compile,execute} can be set by the .x script
	# (if present)
	if [info exists torture_eval_before_compile] {
            set ignore_me [eval $torture_eval_before_compile]
	}
	
	remote_file build delete $execname;
	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 [gcc_target_compile "$src" "${execname}" executable $options];

	if ![gcc_check_compile "$testcase compilation" $option $execname $comp_output] {
	    unresolved "$testcase execution, $option"
	    remote_file build delete $execname
	    continue
	}

	# See if this source file uses "long long" types, if it does, and
	# no_long_long is set, skip execution of the test.
	if [target_info exists no_long_long] then {
	    if [expr [search_for $src "long long"]] then {
		unsupported "$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]
	}
	
	set skip 0;
	if [info exists oldexec] {
	    if { [remote_file build cmp $oldexec $execname] == 0 } {
		set skip 1;
	    }
	}
	if { $skip == 0 } {
	    set result [gcc_load "$execname" "" ""]
	    set status [lindex $result 0];
	    set output [lindex $result 1];
	}
        if { $oldstatus == "pass" } {
	    remote_file build delete $oldexec;
        }
	$status "$testcase execution, $option"
	set oldstatus $status;
    }
    if [info exists status] {
	if { $status == "pass" } {
	    remote_file build delete $execname;
	}
    }
}

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

#
# c-torture -- the c-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 c-torture { args } {
    global srcdir subdir

    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
	}
    }
   
    # Look for a loop within the source code - if we don't find one,
    # don't pass -funroll[-all]-loops.
    global torture_with_loops torture_without_loops
    if [expr [search_for $src "for*("]+[search_for $src "while*("]] then {
	set option_list $torture_with_loops
    } else {
	set option_list $torture_without_loops
    }

    # loop through all the options
    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]
	}
	
	c-torture-compile $src "$option $options"
    }
}