1 |
15 |
khays |
# Copyright 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2007,
|
2 |
|
|
# 2009, 2010 Free Software Foundation, Inc.
|
3 |
|
|
|
4 |
|
|
# This program is free software; you can redistribute it and/or modify
|
5 |
|
|
# it under the terms of the GNU General Public License as published by
|
6 |
|
|
# the Free Software Foundation; either version 3 of the License, or
|
7 |
|
|
# (at your option) any later version.
|
8 |
|
|
#
|
9 |
|
|
# This program is distributed in the hope that it will be useful,
|
10 |
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
11 |
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
12 |
|
|
# GNU General Public License for more details.
|
13 |
|
|
#
|
14 |
|
|
# You should have received a copy of the GNU General Public License
|
15 |
|
|
# along with this program; if not, write to the Free Software
|
16 |
|
|
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
|
17 |
|
|
|
18 |
|
|
# Please email any bugs, comments, and/or additions to this file to:
|
19 |
|
|
# bug-dejagnu@prep.ai.mit.edu
|
20 |
|
|
|
21 |
|
|
# This file was written by Rob Savoye
|
22 |
|
|
# and extended by Ian Lance Taylor
|
23 |
|
|
|
24 |
|
|
proc load_common_lib { name } {
|
25 |
|
|
load_lib $name
|
26 |
|
|
}
|
27 |
|
|
|
28 |
|
|
load_common_lib binutils-common.exp
|
29 |
|
|
|
30 |
|
|
proc binutil_version { prog } {
|
31 |
|
|
if ![is_remote host] {
|
32 |
|
|
set path [which $prog]
|
33 |
|
|
if {$path == 0} then {
|
34 |
|
|
perror "$prog can't be run, file not found."
|
35 |
|
|
return ""
|
36 |
|
|
}
|
37 |
|
|
} else {
|
38 |
|
|
set path $prog
|
39 |
|
|
}
|
40 |
|
|
set state [remote_exec host $prog --version]
|
41 |
|
|
set tmp "[lindex $state 1]\n"
|
42 |
|
|
# Should find a way to discard constant parts, keep whatever's
|
43 |
|
|
# left, so the version string could be almost anything at all...
|
44 |
|
|
regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" "$tmp" version cyg number
|
45 |
|
|
if ![info exists number] then {
|
46 |
|
|
return "$path (no version number)\n"
|
47 |
|
|
}
|
48 |
|
|
return "$path $number\n"
|
49 |
|
|
}
|
50 |
|
|
|
51 |
|
|
#
|
52 |
|
|
# default_binutils_run
|
53 |
|
|
# run a program, returning the output
|
54 |
|
|
# sets binutils_run_failed if the program does not exist
|
55 |
|
|
#
|
56 |
|
|
proc default_binutils_run { prog progargs } {
|
57 |
|
|
global binutils_run_failed
|
58 |
|
|
global host_triplet
|
59 |
|
|
|
60 |
|
|
set binutils_run_failed 0
|
61 |
|
|
|
62 |
|
|
if ![is_remote host] {
|
63 |
|
|
if {[which $prog] == 0} then {
|
64 |
|
|
perror "$prog does not exist"
|
65 |
|
|
set binutils_run_failed 1
|
66 |
|
|
return ""
|
67 |
|
|
}
|
68 |
|
|
}
|
69 |
|
|
|
70 |
|
|
send_log "$prog $progargs\n"
|
71 |
|
|
verbose "$prog $progargs"
|
72 |
|
|
|
73 |
|
|
# Gotta quote dollar-signs because they get mangled by the
|
74 |
|
|
# shell otherwise.
|
75 |
|
|
regsub -all "\\$" "$progargs" "\\$" progargs
|
76 |
|
|
|
77 |
|
|
set state [remote_exec host $prog $progargs]
|
78 |
|
|
set exec_output [prune_warnings [lindex $state 1]]
|
79 |
|
|
if {![string match "" $exec_output]} then {
|
80 |
|
|
send_log "$exec_output\n"
|
81 |
|
|
verbose "$exec_output"
|
82 |
|
|
} else {
|
83 |
|
|
if { [lindex $state 0] != 0 } {
|
84 |
|
|
set exec_output "$prog exited with status [lindex $state 0]"
|
85 |
|
|
send_log "$exec_output\n"
|
86 |
|
|
verbose "$exec_output"
|
87 |
|
|
}
|
88 |
|
|
}
|
89 |
|
|
return $exec_output
|
90 |
|
|
}
|
91 |
|
|
|
92 |
|
|
#
|
93 |
|
|
# default_binutils_assemble_flags
|
94 |
|
|
# assemble a file
|
95 |
|
|
#
|
96 |
|
|
proc default_binutils_assemble_flags { source object asflags } {
|
97 |
|
|
global srcdir
|
98 |
|
|
global host_triplet
|
99 |
|
|
|
100 |
|
|
# The HPPA assembler syntax is a little different than most, to make
|
101 |
|
|
# the test source file assemble we need to run it through sed.
|
102 |
|
|
#
|
103 |
|
|
# This is a hack in that it won't scale well if other targets need
|
104 |
|
|
# similar transformations to assemble. We'll generalize the hack
|
105 |
|
|
# if/when other targets need similar handling.
|
106 |
|
|
if { [istarget "hppa*-*-*"] && ![istarget "*-*-linux*" ] } then {
|
107 |
|
|
set sed_file $srcdir/config/hppa.sed
|
108 |
|
|
send_log "sed -f $sed_file < $source > asm.s\n"
|
109 |
|
|
verbose "sed -f $sed_file < $source > asm.s"
|
110 |
|
|
catch "exec sed -f $sed_file < $source > asm.s"
|
111 |
|
|
set source asm.s
|
112 |
|
|
}
|
113 |
|
|
|
114 |
|
|
set exec_output [target_assemble $source $object $asflags]
|
115 |
|
|
set exec_output [prune_warnings $exec_output]
|
116 |
|
|
|
117 |
|
|
if [string match "" $exec_output] {
|
118 |
|
|
return 1
|
119 |
|
|
} else {
|
120 |
|
|
send_log "$exec_output\n"
|
121 |
|
|
verbose "$exec_output"
|
122 |
|
|
perror "$source: assembly failed"
|
123 |
|
|
return 0
|
124 |
|
|
}
|
125 |
|
|
}
|
126 |
|
|
|
127 |
|
|
#
|
128 |
|
|
# exe_ext
|
129 |
|
|
# Returns target executable extension, if any.
|
130 |
|
|
#
|
131 |
|
|
proc exe_ext {} {
|
132 |
|
|
if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
|
133 |
|
|
return ".exe"
|
134 |
|
|
} else {
|
135 |
|
|
return ""
|
136 |
|
|
}
|
137 |
|
|
}
|
138 |
|
|
|
139 |
|
|
# Copied and modified from gas.
|
140 |
|
|
|
141 |
|
|
# run_dump_test FILE (optional:) EXTRA_OPTIONS
|
142 |
|
|
#
|
143 |
|
|
# Assemble a .s file, then run some utility on it and check the output.
|
144 |
|
|
#
|
145 |
|
|
# There should be an assembly language file named FILE.s in the test
|
146 |
|
|
# suite directory, and a pattern file called FILE.d. `run_dump_test'
|
147 |
|
|
# will assemble FILE.s, run some tool like `objdump', `objcopy', or
|
148 |
|
|
# `nm' on the .o file to produce textual output, and then analyze that
|
149 |
|
|
# with regexps. The FILE.d file specifies what program to run, and
|
150 |
|
|
# what to expect in its output.
|
151 |
|
|
#
|
152 |
|
|
# The FILE.d file begins with zero or more option lines, which specify
|
153 |
|
|
# flags to pass to the assembler, the program to run to dump the
|
154 |
|
|
# assembler's output, and the options it wants. The option lines have
|
155 |
|
|
# the syntax:
|
156 |
|
|
#
|
157 |
|
|
# # OPTION: VALUE
|
158 |
|
|
#
|
159 |
|
|
# OPTION is the name of some option, like "name" or "objdump", and
|
160 |
|
|
# VALUE is OPTION's value. The valid options are described below.
|
161 |
|
|
# Whitespace is ignored everywhere, except within VALUE. The option
|
162 |
|
|
# list ends with the first line that doesn't match the above syntax.
|
163 |
|
|
# However, a line within the options that begins with a #, but doesn't
|
164 |
|
|
# have a recognizable option name followed by a colon, is considered a
|
165 |
|
|
# comment and entirely ignored.
|
166 |
|
|
#
|
167 |
|
|
# The optional EXTRA_OPTIONS argument to `run_dump_test' is a list of
|
168 |
|
|
# two-element lists. The first element of each is an option name, and
|
169 |
|
|
# the second additional arguments to be added on to the end of the
|
170 |
|
|
# option list as given in FILE.d. (If omitted, no additional options
|
171 |
|
|
# are added.)
|
172 |
|
|
#
|
173 |
|
|
# The interesting options are:
|
174 |
|
|
#
|
175 |
|
|
# name: TEST-NAME
|
176 |
|
|
# The name of this test, passed to DejaGNU's `pass' and `fail'
|
177 |
|
|
# commands. If omitted, this defaults to FILE, the root of the
|
178 |
|
|
# .s and .d files' names.
|
179 |
|
|
#
|
180 |
|
|
# as: FLAGS
|
181 |
|
|
# When assembling FILE.s, pass FLAGS to the assembler.
|
182 |
|
|
#
|
183 |
|
|
# PROG: PROGRAM-NAME
|
184 |
|
|
# The name of the program to run to analyze the .o file produced
|
185 |
|
|
# by the assembler. This can be omitted; run_dump_test will guess
|
186 |
|
|
# which program to run by seeing which of the flags options below
|
187 |
|
|
# is present.
|
188 |
|
|
#
|
189 |
|
|
# objdump: FLAGS
|
190 |
|
|
# nm: FLAGS
|
191 |
|
|
# objcopy: FLAGS
|
192 |
|
|
# Use the specified program to analyze the .o file, and pass it
|
193 |
|
|
# FLAGS, in addition to the .o file name. Note that they are run
|
194 |
|
|
# with LC_ALL=C in the environment to give consistent sorting
|
195 |
|
|
# of symbols.
|
196 |
|
|
#
|
197 |
|
|
# source: SOURCE
|
198 |
|
|
# Assemble the file SOURCE.s. If omitted, this defaults to FILE.s.
|
199 |
|
|
# This is useful if several .d files want to share a .s file.
|
200 |
|
|
#
|
201 |
|
|
# target: GLOBS...
|
202 |
|
|
# Run this test only on a specified list of targets. More precisely,
|
203 |
|
|
# each glob in the space-separated list is passed to "istarget"; if
|
204 |
|
|
# it evaluates true for any of them, the test will be run, otherwise
|
205 |
|
|
# it will be marked unsupported.
|
206 |
|
|
#
|
207 |
|
|
# not-target: GLOBS...
|
208 |
|
|
# Do not run this test on a specified list of targets. Again,
|
209 |
|
|
# the each glob in the space-separated list is passed to
|
210 |
|
|
# "istarget", and the test is run if it evaluates *false* for
|
211 |
|
|
# *all* of them. Otherwise it will be marked unsupported.
|
212 |
|
|
#
|
213 |
|
|
# skip: GLOBS...
|
214 |
|
|
# not-skip: GLOBS...
|
215 |
|
|
# These are exactly the same as "not-target" and "target",
|
216 |
|
|
# respectively, except that they do nothing at all if the check
|
217 |
|
|
# fails. They should only be used in groups, to construct a single
|
218 |
|
|
# test which is run on all targets but with variant options or
|
219 |
|
|
# expected output on some targets. (For example, see
|
220 |
|
|
# gas/arm/inst.d and gas/arm/wince_inst.d.)
|
221 |
|
|
#
|
222 |
|
|
# error: REGEX
|
223 |
|
|
# An error with message matching REGEX must be emitted for the test
|
224 |
|
|
# to pass. The PROG, objdump, nm and objcopy options have no
|
225 |
|
|
# meaning and need not supplied if this is present.
|
226 |
|
|
#
|
227 |
|
|
# warning: REGEX
|
228 |
|
|
# Expect a gas warning matching REGEX. It is an error to issue
|
229 |
|
|
# both "error" and "warning".
|
230 |
|
|
#
|
231 |
|
|
# stderr: FILE
|
232 |
|
|
# FILE contains regexp lines to be matched against the diagnostic
|
233 |
|
|
# output of the assembler. This does not preclude the use of
|
234 |
|
|
# PROG, nm, objdump, or objcopy.
|
235 |
|
|
#
|
236 |
|
|
# error-output: FILE
|
237 |
|
|
# Means the same as 'stderr', but also indicates that the assembler
|
238 |
|
|
# is expected to exit unsuccessfully (therefore PROG, objdump, nm,
|
239 |
|
|
# and objcopy have no meaning and should not be supplied).
|
240 |
|
|
#
|
241 |
|
|
# Each option may occur at most once.
|
242 |
|
|
#
|
243 |
|
|
# After the option lines come regexp lines. `run_dump_test' calls
|
244 |
|
|
# `regexp_diff' to compare the output of the dumping tool against the
|
245 |
|
|
# regexps in FILE.d. `regexp_diff' is defined in binutils-common.exp;
|
246 |
|
|
# see further comments there.
|
247 |
|
|
|
248 |
|
|
proc run_dump_test { name {extra_options {}} } {
|
249 |
|
|
global subdir srcdir
|
250 |
|
|
global OBJDUMP NM OBJCOPY READELF STRIP
|
251 |
|
|
global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
|
252 |
|
|
global ELFEDIT ELFEDITFLAGS
|
253 |
|
|
global host_triplet
|
254 |
|
|
global env
|
255 |
|
|
global copyfile
|
256 |
|
|
global tempfile
|
257 |
|
|
|
258 |
|
|
if [string match "*/*" $name] {
|
259 |
|
|
set file $name
|
260 |
|
|
set name [file tail $name]
|
261 |
|
|
} else {
|
262 |
|
|
set file "$srcdir/$subdir/$name"
|
263 |
|
|
}
|
264 |
|
|
set opt_array [slurp_options "${file}.d"]
|
265 |
|
|
if { $opt_array == -1 } {
|
266 |
|
|
perror "error reading options from $file.d"
|
267 |
|
|
unresolved $subdir/$name
|
268 |
|
|
return
|
269 |
|
|
}
|
270 |
|
|
set opts(addr2line) {}
|
271 |
|
|
set opts(ar) {}
|
272 |
|
|
set opts(as) {}
|
273 |
|
|
set opts(nm) {}
|
274 |
|
|
set opts(objcopy) {}
|
275 |
|
|
set opts(objdump) {}
|
276 |
|
|
set opts(strip) {}
|
277 |
|
|
set opts(ranlib) {}
|
278 |
|
|
set opts(readelf) {}
|
279 |
|
|
set opts(size) {}
|
280 |
|
|
set opts(strings) {}
|
281 |
|
|
set opts(name) {}
|
282 |
|
|
set opts(elfedit) {}
|
283 |
|
|
set opts(PROG) {}
|
284 |
|
|
set opts(DUMPPROG) {}
|
285 |
|
|
set opts(source) {}
|
286 |
|
|
set opts(target) {}
|
287 |
|
|
set opts(not-target) {}
|
288 |
|
|
set opts(skip) {}
|
289 |
|
|
set opts(not-skip) {}
|
290 |
|
|
|
291 |
|
|
foreach i $opt_array {
|
292 |
|
|
set opt_name [lindex $i 0]
|
293 |
|
|
set opt_val [lindex $i 1]
|
294 |
|
|
if ![info exists opts($opt_name)] {
|
295 |
|
|
perror "unknown option $opt_name in file $file.d"
|
296 |
|
|
unresolved $subdir/$name
|
297 |
|
|
return
|
298 |
|
|
}
|
299 |
|
|
|
300 |
|
|
# Permit the option to use $srcdir to refer to the source
|
301 |
|
|
# directory.
|
302 |
|
|
regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
|
303 |
|
|
|
304 |
|
|
if [string length $opts($opt_name)] {
|
305 |
|
|
perror "option $opt_name multiply set in $file.d"
|
306 |
|
|
unresolved $subdir/$name
|
307 |
|
|
return
|
308 |
|
|
}
|
309 |
|
|
set opts($opt_name) $opt_val
|
310 |
|
|
}
|
311 |
|
|
|
312 |
|
|
foreach i $extra_options {
|
313 |
|
|
set opt_name [lindex $i 0]
|
314 |
|
|
set opt_val [lindex $i 1]
|
315 |
|
|
if ![info exists opts($opt_name)] {
|
316 |
|
|
perror "unknown option $opt_name given in extra_opts"
|
317 |
|
|
unresolved $subdir/$name
|
318 |
|
|
return
|
319 |
|
|
}
|
320 |
|
|
|
321 |
|
|
# Permit the option to use $srcdir to refer to the source
|
322 |
|
|
# directory.
|
323 |
|
|
regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
|
324 |
|
|
|
325 |
|
|
# add extra option to end of existing option, adding space
|
326 |
|
|
# if necessary.
|
327 |
|
|
if [string length $opts($opt_name)] {
|
328 |
|
|
append opts($opt_name) " "
|
329 |
|
|
}
|
330 |
|
|
append opts($opt_name) $opt_val
|
331 |
|
|
}
|
332 |
|
|
|
333 |
|
|
if { $opts(name) == "" } {
|
334 |
|
|
set testname "$subdir/$name"
|
335 |
|
|
} else {
|
336 |
|
|
set testname $opts(name)
|
337 |
|
|
}
|
338 |
|
|
verbose "Testing $testname"
|
339 |
|
|
|
340 |
|
|
if {$opts(PROG) == ""} {
|
341 |
|
|
perror "program isn't set in $file.d"
|
342 |
|
|
unresolved $testname
|
343 |
|
|
return
|
344 |
|
|
}
|
345 |
|
|
|
346 |
|
|
set destopt ""
|
347 |
|
|
switch -- $opts(PROG) {
|
348 |
|
|
ar { set program ar }
|
349 |
|
|
objcopy { set program objcopy }
|
350 |
|
|
ranlib { set program ranlib }
|
351 |
|
|
strip {
|
352 |
|
|
set program strip
|
353 |
|
|
set destopt "-o"
|
354 |
|
|
}
|
355 |
|
|
strings { set program strings }
|
356 |
|
|
elfedit { set program elfedit }
|
357 |
|
|
nm { set program nm }
|
358 |
|
|
default {
|
359 |
|
|
perror "unrecognized program option $opts(PROG) in $file.d"
|
360 |
|
|
unresolved $testname
|
361 |
|
|
return }
|
362 |
|
|
}
|
363 |
|
|
|
364 |
|
|
set dumpprogram ""
|
365 |
|
|
if { $opts(DUMPPROG) != "" } {
|
366 |
|
|
switch -- $opts(DUMPPROG) {
|
367 |
|
|
addr2line { set dumpprogram addr2line }
|
368 |
|
|
nm { set dumpprogram nm }
|
369 |
|
|
objdump { set dumpprogram objdump }
|
370 |
|
|
readelf { set dumpprogram readelf }
|
371 |
|
|
size { set dumpprogram size }
|
372 |
|
|
default {
|
373 |
|
|
perror "unrecognized dump program option $opts(DUMPPROG) in $file.d"
|
374 |
|
|
unresolved $testname
|
375 |
|
|
return }
|
376 |
|
|
}
|
377 |
|
|
} else {
|
378 |
|
|
# Guess which program to run, by seeing which option was specified.
|
379 |
|
|
foreach p {objdump nm readelf} {
|
380 |
|
|
if {$opts($p) != ""} {
|
381 |
|
|
if {$dumpprogram != ""} {
|
382 |
|
|
perror "ambiguous dump program in $file.d"
|
383 |
|
|
unresolved $testname
|
384 |
|
|
return
|
385 |
|
|
} else {
|
386 |
|
|
set dumpprogram $p
|
387 |
|
|
}
|
388 |
|
|
}
|
389 |
|
|
}
|
390 |
|
|
}
|
391 |
|
|
|
392 |
|
|
# Handle skipping the test on specified targets.
|
393 |
|
|
# You can have both skip/not-skip and target/not-target, but you can't
|
394 |
|
|
# have both skip and not-skip, or target and not-target, in the same file.
|
395 |
|
|
if { $opts(skip) != "" } then {
|
396 |
|
|
if { $opts(not-skip) != "" } then {
|
397 |
|
|
perror "$testname: mixing skip and not-skip directives is invalid"
|
398 |
|
|
unresolved $testname
|
399 |
|
|
return
|
400 |
|
|
}
|
401 |
|
|
foreach glob $opts(skip) {
|
402 |
|
|
if {[istarget $glob]} { return }
|
403 |
|
|
}
|
404 |
|
|
}
|
405 |
|
|
if { $opts(not-skip) != "" } then {
|
406 |
|
|
set skip 1
|
407 |
|
|
foreach glob $opts(not-skip) {
|
408 |
|
|
if {[istarget $glob]} {
|
409 |
|
|
set skip 0
|
410 |
|
|
break
|
411 |
|
|
}
|
412 |
|
|
}
|
413 |
|
|
if {$skip} { return }
|
414 |
|
|
}
|
415 |
|
|
if { $opts(target) != "" } then {
|
416 |
|
|
if { $opts(not-target) != "" } then {
|
417 |
|
|
perror "$testname: mixing target and not-target directives is invalid"
|
418 |
|
|
unresolved $testname
|
419 |
|
|
return
|
420 |
|
|
}
|
421 |
|
|
set skip 1
|
422 |
|
|
foreach glob $opts(target) {
|
423 |
|
|
if {[istarget $glob]} {
|
424 |
|
|
set skip 0
|
425 |
|
|
break
|
426 |
|
|
}
|
427 |
|
|
}
|
428 |
|
|
if {$skip} {
|
429 |
|
|
unsupported $testname
|
430 |
|
|
return
|
431 |
|
|
}
|
432 |
|
|
}
|
433 |
|
|
if { $opts(not-target) != "" } then {
|
434 |
|
|
foreach glob $opts(not-target) {
|
435 |
|
|
if {[istarget $glob]} {
|
436 |
|
|
unsupported $testname
|
437 |
|
|
return
|
438 |
|
|
}
|
439 |
|
|
}
|
440 |
|
|
}
|
441 |
|
|
|
442 |
|
|
if { $opts(source) == "" } {
|
443 |
|
|
set srcfile ${file}.s
|
444 |
|
|
} else {
|
445 |
|
|
set srcfile $srcdir/$subdir/$opts(source)
|
446 |
|
|
}
|
447 |
|
|
|
448 |
|
|
set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
|
449 |
|
|
if [string match "" $exec_output] then {
|
450 |
|
|
send_log "$exec_output\n"
|
451 |
|
|
verbose "$exec_output"
|
452 |
|
|
fail $testname
|
453 |
|
|
return
|
454 |
|
|
}
|
455 |
|
|
|
456 |
|
|
set progopts1 $opts($program)
|
457 |
|
|
eval set progopts \$[string toupper $program]FLAGS
|
458 |
|
|
eval set binary \$[string toupper $program]
|
459 |
|
|
|
460 |
|
|
set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
|
461 |
|
|
if ![string match "" $exec_output] {
|
462 |
|
|
send_log "$exec_output\n"
|
463 |
|
|
verbose "$exec_output"
|
464 |
|
|
fail $testname
|
465 |
|
|
return
|
466 |
|
|
}
|
467 |
|
|
|
468 |
|
|
set progopts1 $opts($dumpprogram)
|
469 |
|
|
eval set progopts \$[string toupper $dumpprogram]FLAGS
|
470 |
|
|
eval set binary \$[string toupper $dumpprogram]
|
471 |
|
|
|
472 |
|
|
if { ![is_remote host] && [which $binary] == 0 } {
|
473 |
|
|
untested $testname
|
474 |
|
|
return
|
475 |
|
|
}
|
476 |
|
|
|
477 |
|
|
verbose "running $binary $progopts $progopts1" 3
|
478 |
|
|
|
479 |
|
|
set cmd "$binary $progopts $progopts1 ${copyfile}.o"
|
480 |
|
|
|
481 |
|
|
# Ensure consistent sorting of symbols
|
482 |
|
|
if {[info exists env(LC_ALL)]} {
|
483 |
|
|
set old_lc_all $env(LC_ALL)
|
484 |
|
|
}
|
485 |
|
|
set env(LC_ALL) "C"
|
486 |
|
|
send_log "$cmd\n"
|
487 |
|
|
set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
|
488 |
|
|
if {[info exists old_lc_all]} {
|
489 |
|
|
set env(LC_ALL) $old_lc_all
|
490 |
|
|
} else {
|
491 |
|
|
unset env(LC_ALL)
|
492 |
|
|
}
|
493 |
|
|
if { [lindex $comp_output 0] != 0 } then {
|
494 |
|
|
send_log "$comp_output\n"
|
495 |
|
|
fail $testname
|
496 |
|
|
return
|
497 |
|
|
}
|
498 |
|
|
set comp_output [prune_warnings [lindex $comp_output 1]]
|
499 |
|
|
if ![string match "" $comp_output] then {
|
500 |
|
|
send_log "$comp_output\n"
|
501 |
|
|
fail $testname
|
502 |
|
|
return
|
503 |
|
|
}
|
504 |
|
|
|
505 |
|
|
verbose_eval {[file_contents "tmpdir/dump.out"]} 3
|
506 |
|
|
if { [regexp_diff "tmpdir/dump.out" "${file}.d"] } then {
|
507 |
|
|
fail $testname
|
508 |
|
|
verbose "output is [file_contents "tmpdir/dump.out"]" 2
|
509 |
|
|
return
|
510 |
|
|
}
|
511 |
|
|
|
512 |
|
|
pass $testname
|
513 |
|
|
}
|
514 |
|
|
|
515 |
|
|
proc slurp_options { file } {
|
516 |
|
|
if [catch { set f [open $file r] } x] {
|
517 |
|
|
#perror "couldn't open `$file': $x"
|
518 |
|
|
perror "$x"
|
519 |
|
|
return -1
|
520 |
|
|
}
|
521 |
|
|
set opt_array {}
|
522 |
|
|
# whitespace expression
|
523 |
|
|
set ws {[ ]*}
|
524 |
|
|
set nws {[^ ]*}
|
525 |
|
|
# whitespace is ignored anywhere except within the options list;
|
526 |
|
|
# option names are alphabetic plus dash
|
527 |
|
|
set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
|
528 |
|
|
while { [gets $f line] != -1 } {
|
529 |
|
|
set line [string trim $line]
|
530 |
|
|
# Whitespace here is space-tab.
|
531 |
|
|
if [regexp $pat $line xxx opt_name opt_val] {
|
532 |
|
|
# match!
|
533 |
|
|
lappend opt_array [list $opt_name $opt_val]
|
534 |
|
|
} elseif {![regexp "^#" $line ]} {
|
535 |
|
|
break
|
536 |
|
|
}
|
537 |
|
|
}
|
538 |
|
|
close $f
|
539 |
|
|
return $opt_array
|
540 |
|
|
}
|
541 |
|
|
|
542 |
|
|
proc file_contents { filename } {
|
543 |
|
|
set file [open $filename r]
|
544 |
|
|
set contents [read $file]
|
545 |
|
|
close $file
|
546 |
|
|
return $contents
|
547 |
|
|
}
|
548 |
|
|
|
549 |
|
|
proc verbose_eval { expr { level 1 } } {
|
550 |
|
|
global verbose
|
551 |
|
|
if $verbose>$level then { eval verbose "$expr" $level }
|
552 |
|
|
}
|