19990502 sourceware import
[platform/upstream/binutils.git] / ld / testsuite / lib / ld-lib.exp
1 #
2 # default_ld_version 
3 #       extract and print the version number of ld
4 #
5 proc default_ld_version { ld } {
6     global host_triplet
7
8     if { [which $ld] == 0 } then {
9         perror "$ld does not exist"
10         exit 1
11     }
12     
13     catch "exec $ld --version" tmp
14     set tmp [prune_warnings $tmp]
15     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number
16     if [info exists number] then {
17         clone_output "$ld $number\n"
18     }
19 }
20
21 #
22 # default_ld_relocate 
23 #       link an object using relocation
24 #
25 proc default_ld_relocate { ld target objects } {
26     global HOSTING_EMU
27     global host_triplet
28     
29     if { [which $ld] == 0 } then {
30         perror "$ld does not exist"
31         return 0
32     }
33     
34     verbose -log "$ld $HOSTING_EMU -o $target -r $objects"
35     
36     catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
37     set exec_output [prune_warnings $exec_output]
38     if [string match "" $exec_output] then {
39         return 1
40     } else {
41         verbose -log "$exec_output"
42         return 0
43     }
44 }
45
46
47 #
48 # default_ld_link 
49 #       link a program using ld
50 #
51 proc default_ld_link { ld target objects } {
52     global HOSTING_EMU
53     global HOSTING_CRT0
54     global HOSTING_LIBS
55     global host_triplet
56     
57     set objs "$HOSTING_CRT0 $objects"
58     set libs "$HOSTING_LIBS"
59     
60     if { [which $ld] == 0 } then {
61         perror "$ld does not exist"
62         return 0
63     }
64     
65     verbose -log "$ld $HOSTING_EMU -o $target $objs $libs"
66     
67     catch "exec $ld $HOSTING_EMU -o $target $objs $libs" exec_output
68     set exec_output [prune_warnings $exec_output]
69     if [string match "" $exec_output] then {
70         return 1
71     } else {
72         verbose -log "$exec_output"
73         return 0
74     }
75 }
76
77 #
78 # default_ld_simple_link 
79 #       link a program using ld, without including any libraries
80 #
81 proc default_ld_simple_link { ld target objects } {
82     global host_triplet
83     
84     if { [which $ld] == 0 } then {
85         perror "$ld does not exist"
86         return 0
87     }
88     
89     verbose -log "$ld -o $target $objects"
90     
91     catch "exec $ld -o $target $objects" exec_output
92     set exec_output [prune_warnings $exec_output]
93
94     # We don't care if we get a warning about a non-existent start
95     # symbol, since the default linker script might use ENTRY.
96     regsub -all "(^|\n)(\[^\n\]*: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
97
98     if [string match "" $exec_output] then {
99         return 1
100     } else {
101         verbose -log "$exec_output"
102         return 0
103     }
104 }
105
106 #
107 # default_ld_compile 
108 #       compile an object using cc
109 #
110 proc default_ld_compile { cc source object } {
111     global CFLAGS
112     global srcdir
113     global subdir
114     global host_triplet
115     global gcc_gas_flag
116
117     set cc_prog $cc
118     if {[llength $cc_prog] > 1} then {
119         set cc_prog [lindex $cc_prog 0]
120     }
121     if {[which $cc_prog] == 0} then {
122         perror "$cc_prog does not exist"
123         return 0
124     }
125
126     catch "exec rm -f $object" exec_output
127
128     set flags "-I$srcdir/$subdir $CFLAGS"
129
130     # If we are compiling with gcc, we want to add gcc_gas_flag to
131     # flags.  Rather than determine this in some complex way, we guess
132     # based on the name of the compiler.
133     if {[string match "*gcc*" $cc] || [string match "*++*" $cc]} then {
134         set flags "$gcc_gas_flag $flags"
135     }
136
137     verbose -log "$cc $flags -c $source -o $object"
138
139     catch "exec $cc $flags -c $source -o $object" exec_output
140     set exec_output [prune_warnings $exec_output]
141     if [string match "" $exec_output] then {
142         if {![file exists $object]} then {
143             regexp ".*/(\[^/\]*)$" $source all dobj
144             regsub "\\.c" $dobj ".o" realobj
145             verbose "looking for $realobj"
146             if {[file exists $realobj]} then {
147                 verbose -log "mv $realobj $object"
148                 catch "exec mv $realobj $object" exec_output
149                 set exec_output [prune_warnings $exec_output]
150                 if {![string match "" $exec_output]} then {
151                     verbose -log "$exec_output"
152                     perror "could not move $realobj to $object"
153                     return 0
154                 }
155             } else {
156                 perror "$object not found after compilation"
157                 return 0
158             }
159         }
160         return 1
161     } else {
162         verbose -log "$exec_output"
163         perror "$source: compilation failed"
164         return 0
165     }
166 }
167
168 #
169 # default_ld_assemble
170 #       assemble a file
171 #
172 proc default_ld_assemble { as source object } {
173     global ASFLAGS
174     global host_triplet
175     
176     if {[which $as] == 0} then {
177         perror "$as does not exist"
178         return 0
179     }
180
181     if ![info exists ASFLAGS] { set ASFLAGS "" }
182
183     verbose -log "$as $ASFLAGS -o $object $source"
184
185     catch "exec $as $ASFLAGS -o $object $source" exec_output
186     set exec_output [prune_warnings $exec_output]
187     if [string match "" $exec_output] then {
188         return 1
189     } else {
190         verbose -log "$exec_output"
191         perror "$source: assembly failed"
192         return 0
193     }
194 }
195
196 #
197 # default_ld_nm
198 #       run nm on a file, putting the result in the array nm_output
199 #
200 proc default_ld_nm { nm object } {
201     global NMFLAGS
202     global nm_output
203     global host_triplet
204
205     if {[which $nm] == 0} then {
206         perror "$nm does not exist"
207         return 0
208     }
209
210     if ![info exists NMFLAGS] { set NMFLAGS "" }
211
212     verbose -log "$nm $NMFLAGS $object >tmpdir/nm.out"
213
214     catch "exec $nm $NMFLAGS $object >tmpdir/nm.out" exec_output
215     set exec_output [prune_warnings $exec_output]
216     if [string match "" $exec_output] then {
217         set file [open tmpdir/nm.out r]
218         while { [gets $file line] != -1 } {
219             verbose "$line" 2
220             if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] (.+)$" $line whole value name] {
221                 set name [string trimleft $name "_"]
222                 verbose "Setting nm_output($name) to 0x$value" 2
223                 set nm_output($name) 0x$value
224             }
225         }
226         close $file
227         return 1
228     } else {
229         verbose -log "$exec_output"
230         perror "$object: nm failed"
231         return 0
232     }
233 }
234
235 #
236 # simple_diff
237 #       compares two files line-by-line
238 #       returns differences if exist
239 #       returns null if file(s) cannot be opened
240 #
241 proc simple_diff { file_1 file_2 } {
242     global target
243         
244     set eof -1
245     set differences 0
246     
247     if [file exists $file_1] then {
248         set file_a [open $file_1 r]
249     } else {
250         warning "$file_1 doesn't exist"
251         return
252     }
253     
254     if [file exists $file_2] then {
255         set file_b [open $file_2 r]
256     } else {
257         fail "$file_2 doesn't exist"
258         return
259     }
260     
261     verbose "# Diff'ing: $file_1 $file_2\n" 2
262     
263     while { [gets $file_a line] != $eof } {
264         if [regexp "^#.*$" $line] then {
265             continue
266         } else {
267             lappend list_a $line
268         }
269     }
270     close $file_a
271     
272     while { [gets $file_b line] != $eof } {
273         if [regexp "^#.*$" $line] then {
274             continue
275         } else {
276             lappend list_b $line
277         }
278     }
279     close $file_b
280
281     for { set i 0 } { $i < [llength $list_a] } { incr i } {
282         set line_a [lindex $list_a $i]
283         set line_b [lindex $list_b $i]
284
285         verbose "\t$file_1: $i: $line_a\n" 3
286         verbose "\t$file_2: $i: $line_b\n" 3
287         if [string compare $line_a $line_b] then {
288             verbose -log "\t$file_1: $i: $line_a\n"
289             verbose -log "\t$file_2: $i: $line_b\n"
290
291             fail "Test: $target"
292             return
293         }
294     }
295     
296     if { [llength $list_a] != [llength $list_b] } {
297         fail "Test: $target"
298         return
299     }
300
301     if $differences<1 then {
302         pass "Test: $target"
303     }
304 }
305
306 # This definition is taken from an unreleased version of DejaGnu.  Once
307 # that version gets released, and has been out in the world for a few
308 # months at least, it may be safe to delete this copy.
309 if ![string length [info proc prune_warnings]] {
310     #
311     # prune_warnings -- delete various system verbosities from TEXT
312     #
313     # An example is:
314     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
315     #
316     # Sites with particular verbose os's may wish to override this in site.exp.
317     #
318     proc prune_warnings { text } {
319         # This is from sun4's.  Do it for all machines for now.
320         # The "\\1" is to try to preserve a "\n" but only if necessary.
321         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
322
323         # It might be tempting to get carried away and delete blank lines, etc.
324         # Just delete *exactly* what we're ask to, and that's it.
325         return $text
326     }
327 }