19990502 sourceware import
[platform/upstream/binutils.git] / ld / testsuite / ld-srec / srec.exp
1 # Test linking directly to S-records.
2 # By Ian Lance Taylor, Cygnus Support.
3 # Public domain.
4
5 # Get the offset from an S-record line to the start of the data.
6
7 proc srec_off { l } {
8     if [string match "S1*" $l] {
9         return 8
10     } else { if [string match "S2*" $l] {
11         return 10
12     } else { if [string match "S3*" $l] {
13         return 12
14     } else {
15         return -1
16     } } }
17 }
18
19 # See if an S-record line contains only zero data.
20
21 proc srec_zero { l } {
22     if [string match "S\[0789\]*" $l] {
23         return 1
24     }
25
26     # Strip the address and checksum.
27     if [string match "S\[123\]*" $l] {
28         set l [string range $l [srec_off $l] [expr [string length $l] - 3]]
29     } else {
30         return 0
31     }
32
33     # The rest must be zero.
34     return [string match "" [string trim $l "0"]]
35 }
36
37 # Get the address of an S-record line.
38
39 proc srec_addr { l } {
40     if [string match "S\[123\]*" $l] {
41         set addr [string range $l 4 [expr [srec_off $l] - 1]]
42     } else {
43         return -1
44     }
45
46     return "0x$addr"
47 }
48
49 # Get the number of data bytes in an S-record line.
50
51 proc srec_len { l } {
52     if ![string match "S\[123\]*" $l] {
53         return 0
54     }
55
56     return [expr "0x[string range $l 2 3]" - ([srec_off $l] - 4) / 2 - 1]
57 }
58
59 # Extract bytes from an S-record line.
60
61 proc srec_extract { l start len } {
62     set off [srec_off $l]
63     set rlen [srec_len $l]
64     set stop [expr $start + $len]
65     if { $stop > $rlen } {
66         set stop [expr $rlen]
67     }
68     set start [expr $start * 2 + $off]
69     set stop [expr $stop * 2 + $off - 1]
70     return [string range $l $start $stop]
71 }
72
73 # See if a range of bytes in an S-record line is all zeroes.
74
75 proc srec_zero_range { l start len } {
76     return [string match "" [string trim [srec_extract $l $start $len] "0"]]
77 }
78
79 # Trim an S-record line such that the specified number of bytes remain
80 # at the end.
81
82 proc srec_trim { l leave } {
83     set off [srec_off $l]
84     set addr [srec_addr $l]
85     set len [srec_len $l]
86
87     if { $leave >= $len } {
88         return $l
89     }
90
91     set s1 [string range $l 0 1]
92     set s2 [format "%02x" [expr ($off - 4) / 2 + $leave + 1]]
93     set s3 [format "%0[expr $off - 4]x" [expr $addr + $len - $leave]]
94     set s4 [string range $l [expr [string length $l] - ($leave * 2) - 2] end]
95     set s "${s1}${s2}${s3}${s4}"
96
97     verbose "srec_trim { '$l' $leave } returning '$s'" 2
98
99     return $s
100 }
101
102 # Report failure when comparing S-record lines
103
104 proc srec_compare_fail { which l1 l2 } {
105     send_log "comparison failure $which:\n$l1\n$l2\n"
106     verbose "comparison failure $which:\n$l1\n$l2"
107 }
108
109 # Compare S-record files.  We don't want to fuss about things like
110 # extra zeroes.  Note that BFD always sorts S-records by address.
111
112 proc srec_compare { f1 f2 } {
113     set e1 [gets $f1 l1]
114     set e2 [gets $f2 l2]
115
116     while { $e1 != -1 } {
117         set l1 [string trimright $l1 "\r\n"]
118         set l2 [string trimright $l2 "\r\n"]
119         if { $e2 == -1 } {
120             # If l1 contains data, it must be zero.
121             if ![srec_zero $l1] {
122                 send_log "data after EOF: $l1\n"
123                 verbose "data after EOF: $l1"
124                 return 0
125             }
126         } else { if { [string compare $l1 $l2] == 0 } {
127             set e1 [gets $f1 l1]
128             set e2 [gets $f2 l2]
129         } else { if { [srec_zero $l1] } {
130             set e1 [gets $f1 l1]
131         } else { if { [srec_zero $l2] } {
132             set e2 [gets $f2 l2]
133         } else {
134             # The strings are not the same, and neither is all zeroes.
135             set a1 [srec_addr $l1]
136             set n1 [srec_len $l1]
137             set a2 [srec_addr $l2]
138             set n2 [srec_len $l2]
139
140             if { $a1 < $a2 && ![srec_zero_range $l1 0 [expr $a2 - $a1]] } {
141                 verbose "$a1 $a2 [srec_extract $l1 0 [expr $a2 - $a1]]" 2
142                 srec_compare_fail 1 $l1 $l2
143                 return 0
144             }
145             if { $a2 < $a1 && ![srec_zero_range $l2 0 [expr $a1 - $a2]] } {
146                 srec_compare_fail 2 $l1 $l2
147                 return 0
148             }
149
150             # Here we know that any initial data in both lines is
151             # zero.  Now make sure that any overlapping data matches.
152             if { $a1 < $a2 } {
153                 set os1 [expr $a2 - $a1]
154                 set os2 0
155             } else {
156                 set os1 0
157                 set os2 [expr $a1 - $a2]
158             }
159             if { $a1 + $n1 < $a2 + $n2 } {
160                 set ol [expr $n1 - $os1]
161             } else {
162                 set ol [expr $n2 - $os2]
163             }
164
165             set x1 [srec_extract $l1 $os1 $ol]
166             set x2 [srec_extract $l2 $os2 $ol]
167             if { [string compare $x1 $x2] != 0 } {
168                 verbose "$os1 $ol $x1" 2
169                 verbose "$os2 $ol $x2" 2
170                 srec_compare_fail 3 $l1 $l2
171                 return 0
172             }
173
174             # These strings match.  Trim the data from the larger
175             # string, read a new copy of the smaller string, and
176             # continue.
177             if { $a1 + $n1 < $a2 + $n2 } {
178                 set l2 [srec_trim $l2 [expr ($a2 + $n2) - ($a1 + $n1)]]
179                 set e1 [gets $f1 l1]
180             } else { if { $a1 + $n1 > $a2 + $n2 } {
181                 set l1 [srec_trim $l1 [expr ($a1 + $n1) - ($a2 + $n2)]]
182                 set e2 [gets $f2 l2]
183             } else {
184                 set e1 [gets $f1 l1]
185                 set e2 [gets $f2 l2]
186             } }
187         } } } }
188     }
189
190     # We've reached the end of the first file.  The remainder of the
191     # second file must contain only zeroes.
192     while { $e2 != -1 } {
193         set l2 [string trimright $l2 "\r\n"]
194         if ![srec_zero $l2] {
195             send_log "data after EOF: $l2\n"
196             verbose "data after EOF: $l2"
197             return 0
198         }
199         set e2 [gets $f2 l2]
200     }
201
202     return 1
203 }
204
205 # Link twice, objcopy, and compare
206
207 proc run_srec_test { test objs } {
208     global ld
209     global objcopy
210     global sizeof_headers
211     global host_triplet
212
213     set flags ""
214
215     # If the linker script uses SIZEOF_HEADERS, use a -Ttext argument
216     # to force both the normal link and the S-record link to be put in
217     # the same place.  We don't always use -Ttext because it interacts
218     # poorly with a.out.
219
220     if { $sizeof_headers } {
221         set flags "$flags -Ttext 0x1000"
222     }
223
224     # The a29k compiled code calls V_SPILL and V_FILL.  Since we don't
225     # need to run this code, but we don't have definitions for those
226     # functions, we just define them out.
227     if [istarget a29k*-*-*] {
228         set flags "$flags --defsym V_SPILL=0 --defsym V_FILL=0"
229     }
230
231     # ARM targets call __gccmain
232     if [istarget arm-*-*] {
233         set flags "$flags --defsym ___gccmain=0"
234     }
235     
236     if [istarget strongarm-*-*] {
237         set flags "$flags --defsym __gccmain=0"
238     }
239     
240     # Thumb targets call __gccmain
241     if [istarget thumb-*-*] {
242         set flags "$flags --defsym ___gccmain=0"
243     }
244
245     # PowerPC EABI code calls __eabi.
246     if [istarget powerpc*-*-eabi*] {
247         set flags "$flags --defsym __eabi=0"
248     }
249
250     # mn10200 code calls __truncsipsi2_d0_d2.
251     if {[istarget mn10200*-*-*]} then {
252         set flags "$flags --defsym __truncsipsi2_d0_d2=0"
253     }
254
255     # V850 targets need libgcc.a
256     if [istarget v850*-*-elf] {
257         set objs "$objs -L ../gcc -lgcc"
258     }
259     
260     if { ![ld_simple_link $ld tmpdir/sr1 "$flags $objs"] \
261          || ![ld_simple_link $ld tmpdir/sr2.sr "$flags -oformat srec $objs"] } {
262         setup_xfail "hppa*-*-*elf*"
263         fail $test
264         return
265     }
266
267     send_log "$objcopy -O srec tmpdir/sr1 tmpdir/sr1.sr\n"
268     verbose "$objcopy -O srec tmpdir/sr1 tmpdir/sr1.sr"
269     catch "exec $objcopy -O srec tmpdir/sr1 tmpdir/sr1.sr" exec_output
270     set exec_output [prune_warnings $exec_output]
271     if ![string match "" $exec_output] {
272         send_log "$exec_output\n"
273         verbose "$exec_output"
274         unresolved $test
275         return
276     }
277
278     set f1 [open tmpdir/sr1.sr r]
279     set f2 [open tmpdir/sr2.sr r]
280     if [srec_compare $f1 $f2] {
281         pass $test
282     } else {
283         fail $test
284     }
285     close $f1
286     close $f2
287 }
288
289 set test1 "S-records"
290 set test2 "S-records with constructors"
291
292 # See whether the default linker script uses SIZEOF_HEADERS.
293 catch "exec $ld --verbose" exec_output
294 set sizeof_headers [string match "*SIZEOF_HEADERS*" $exec_output]
295
296 # First test linking a C program.  We don't require any libraries.  We
297 # link it normally, and objcopy to the S-record format, and then link
298 # directly to the S-record format, and require that the two files
299 # contain the same data.
300
301 if { [which $CC] == 0 } {
302     untested $test1
303     untested $test2
304     return
305 }
306
307 if { ![ld_compile $CC $srcdir/$subdir/sr1.c tmpdir/sr1.o] \
308      || ![ld_compile $CC $srcdir/$subdir/sr2.c tmpdir/sr2.o] } {
309     unresolved $test1
310     unresolved $test2
311     return
312 }
313
314 # The i386-aout target is confused: the linker does not put the
315 # sections where objdump finds them.  I don't know which is wrong.
316 setup_xfail "i*86-*-aout*"
317
318 # These tests fail on the native MIPS ELF targets because the GP value
319 # in the .reginfo section is not updated when the S-record version is
320 # written out.  The mips-elf target itself does not use a .reginfo section.
321 setup_xfail "mips*-*-irix5*" "mips*-*-irix6*"
322
323 # The S-record linker doesn't do the magic TOC handling that XCOFF
324 # linkers do.
325 setup_xfail "*-*-aix*" "*-*-xcoff*"
326
327 # The S-record linker doesn't build ARM/Thumb stubs.
328 setup_xfail "arm-*-coff"
329 setup_xfail "strongarm-*-*"
330 setup_xfail "arm-*-pe*"
331 # setup_xfail "arm-*elf*"
332 setup_xfail "thumb-*-coff*"
333 setup_xfail "thumb-*-pe*"
334 setup_xfail "thumb-*-elf*"
335
336 # The S-record linker doesn't build special EABI sections.
337 setup_xfail "powerpc*-*-eabi*"
338
339 # The S-record linker doesn't include the .{zda} sections.
340 setup_xfail "v850*-*-elf"
341
342 # The S-record linker doesn't handle Alpha Elf relaxation.
343 setup_xfail "alpha*-*-elf*" "alpha*-*-linux-gnu*" "alpha*-*-gnu*"
344 setup_xfail "alpha*-*-netbsd*"
345
346 run_srec_test $test1 "tmpdir/sr1.o tmpdir/sr2.o"
347
348 # Now try linking a C++ program with global constructors and
349 # destructors.  Note that since we are not linking against any
350 # libraries, this program won't actually work or anything.
351
352 if { [which $CXX] == 0 } {
353     untested $test2
354     return
355 }
356
357 if ![ld_compile "$CXX $CXXFLAGS -fgnu-linker" $srcdir/$subdir/sr3.cc tmpdir/sr3.o] {
358     unresolved $test2
359     return
360 }
361
362 # See above.
363 setup_xfail "i*86-*-aout*"
364 setup_xfail "mips*-*-irix5*" "mips*-*-irix6*"
365 setup_xfail "*-*-aix*" "*-*-xcoff*"
366 setup_xfail "arm-*-*"
367 setup_xfail "strongarm-*-*"
368 setup_xfail "thumb-*-*"
369 setup_xfail "powerpc*-*-eabi*"
370 setup_xfail "v850*-*-elf"
371 setup_xfail "alpha*-*-elf*" "alpha*-*-linux-gnu*" "alpha*-*-gnu*"
372 setup_xfail "alpha*-*-netbsd*"
373
374 run_srec_test $test2 "tmpdir/sr3.o"