]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - ld/testsuite/lib/ld-lib.exp
bfd/
[thirdparty/binutils-gdb.git] / ld / testsuite / lib / ld-lib.exp
1 # Support routines for LD testsuite.
2 # Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
3 # 2004, 2005, 2006 Free Software Foundation, Inc.
4 #
5 # This file is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
18
19 # Extract and print the version number of ld.
20 #
21 proc default_ld_version { ld } {
22 global host_triplet
23
24 if { [which $ld] == 0 } then {
25 perror "$ld does not exist"
26 exit 1
27 }
28
29 catch "exec $ld --version" tmp
30 set tmp [prune_warnings $tmp]
31 regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number
32 if [info exists number] then {
33 clone_output "$ld $number\n"
34 }
35 }
36
37 # Link an object using relocation.
38 #
39 proc default_ld_relocate { ld target objects } {
40 global HOSTING_EMU
41 global host_triplet
42
43 if { [which $ld] == 0 } then {
44 perror "$ld does not exist"
45 return 0
46 }
47
48 verbose -log "$ld $HOSTING_EMU -o $target -r $objects"
49
50 catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
51 set exec_output [prune_warnings $exec_output]
52 if [string match "" $exec_output] then {
53 return 1
54 } else {
55 verbose -log "$exec_output"
56 return 0
57 }
58 }
59
60 # Check to see if ld is being invoked with a non-endian output format
61 #
62 proc is_endian_output_format { object_flags } {
63
64 if {[string match "*-oformat binary*" $object_flags] || \
65 [string match "*-oformat ieee*" $object_flags] || \
66 [string match "*-oformat ihex*" $object_flags] || \
67 [string match "*-oformat netbsd-core*" $object_flags] || \
68 [string match "*-oformat srec*" $object_flags] || \
69 [string match "*-oformat tekhex*" $object_flags] || \
70 [string match "*-oformat trad-core*" $object_flags] } then {
71 return 0
72 } else {
73 return 1
74 }
75 }
76
77 # Look for big-endian or little-endian switches in the multlib
78 # options and translate these into a -EB or -EL switch. Note
79 # we cannot rely upon proc process_multilib_options to do this
80 # for us because for some targets the compiler does not support
81 # -EB/-EL but it does support -mbig-endian/-mlittle-endian, and
82 # the site.exp file will include the switch "-mbig-endian"
83 # (rather than "big-endian") which is not detected by proc
84 # process_multilib_options.
85 #
86 proc big_or_little_endian {} {
87
88 if [board_info [target_info name] exists multilib_flags] {
89 set tmp_flags " [board_info [target_info name] multilib_flags]"
90
91 foreach x $tmp_flags {
92 case $x in {
93 {*big*endian eb EB -eb -EB -mb} {
94 set flags " -EB"
95 return $flags
96 }
97 {*little*endian el EL -el -EL -ml} {
98 set flags " -EL"
99 return $flags
100 }
101 }
102 }
103 }
104
105 set flags ""
106 return $flags
107 }
108
109 # Link a program using ld.
110 #
111 proc default_ld_link { ld target objects } {
112 global HOSTING_EMU
113 global HOSTING_CRT0
114 global HOSTING_LIBS
115 global LIBS
116 global host_triplet
117 global link_output
118
119 set objs "$HOSTING_CRT0 $objects"
120 set libs "$LIBS $HOSTING_LIBS"
121
122 if { [which $ld] == 0 } then {
123 perror "$ld does not exist"
124 return 0
125 }
126
127 if [is_endian_output_format $objects] then {
128 set flags [big_or_little_endian]
129 } else {
130 set flags ""
131 }
132 verbose -log "$ld $HOSTING_EMU $flags -o $target $objs $libs"
133
134 catch "exec $ld $HOSTING_EMU $flags -o $target $objs $libs" link_output
135 set exec_output [prune_warnings $link_output]
136 if [string match "" $link_output] then {
137 return 1
138 } else {
139 verbose -log "$link_output"
140 return 0
141 }
142 }
143
144 # Link a program using ld, without including any libraries.
145 #
146 proc default_ld_simple_link { ld target objects } {
147 global host_triplet
148 global link_output
149 global gcc_ld_flag
150
151 if { [which $ld] == 0 } then {
152 perror "$ld does not exist"
153 return 0
154 }
155
156 if [is_endian_output_format $objects] then {
157 set flags [big_or_little_endian]
158 } else {
159 set flags ""
160 }
161
162 # If we are compiling with gcc, we want to add gcc_ld_flag to
163 # flags. Rather than determine this in some complex way, we guess
164 # based on the name of the compiler.
165 set ldexe $ld
166 set ldparm [string first " " $ld]
167 if { $ldparm > 0 } then {
168 set ldexe [string range $ld 0 $ldparm]
169 }
170 set ldexe [string replace $ldexe 0 [string last "/" $ldexe] ""]
171 if {[string match "*gcc*" $ldexe] || [string match "*++*" $ldexe]} then {
172 set flags "$gcc_ld_flag $flags"
173 }
174
175 verbose -log "$ld $flags -o $target $objects"
176
177 catch "exec $ld $flags -o $target $objects" link_output
178 set exec_output [prune_warnings $link_output]
179
180 # We don't care if we get a warning about a non-existent start
181 # symbol, since the default linker script might use ENTRY.
182 regsub -all "(^|\n)(\[^\n\]*: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
183
184 if [string match "" $exec_output] then {
185 return 1
186 } else {
187 verbose -log "$exec_output"
188 return 0
189 }
190 }
191
192 # Compile an object using cc.
193 #
194 proc default_ld_compile { cc source object } {
195 global CFLAGS
196 global srcdir
197 global subdir
198 global host_triplet
199 global gcc_gas_flag
200
201 set cc_prog $cc
202 if {[llength $cc_prog] > 1} then {
203 set cc_prog [lindex $cc_prog 0]
204 }
205 if {[which $cc_prog] == 0} then {
206 perror "$cc_prog does not exist"
207 return 0
208 }
209
210 catch "exec rm -f $object" exec_output
211
212 set flags "-I$srcdir/$subdir $CFLAGS"
213
214 # If we are compiling with gcc, we want to add gcc_gas_flag to
215 # flags. Rather than determine this in some complex way, we guess
216 # based on the name of the compiler.
217 set ccexe $cc
218 set ccparm [string first " " $cc]
219 set ccflags ""
220 if { $ccparm > 0 } then {
221 set ccflags [string range $cc $ccparm end]
222 set ccexe [string range $cc 0 $ccparm]
223 set cc $ccexe
224 }
225 set ccexe [string replace $ccexe 0 [string last "/" $ccexe] ""]
226 if {[string match "*gcc*" $ccexe] || [string match "*++*" $ccexe]} then {
227 set flags "$gcc_gas_flag $flags"
228 }
229
230 if [board_info [target_info name] exists multilib_flags] {
231 append flags " [board_info [target_info name] multilib_flags]"
232 }
233
234 verbose -log "$cc $flags $ccflags -c $source -o $object"
235
236 catch "exec $cc $flags $ccflags -c $source -o $object" exec_output
237 set exec_output [prune_warnings $exec_output]
238 if [string match "" $exec_output] then {
239 if {![file exists $object]} then {
240 regexp ".*/(\[^/\]*)$" $source all dobj
241 regsub "\\.c" $dobj ".o" realobj
242 verbose "looking for $realobj"
243 if {[file exists $realobj]} then {
244 verbose -log "mv $realobj $object"
245 catch "exec mv $realobj $object" exec_output
246 set exec_output [prune_warnings $exec_output]
247 if {![string match "" $exec_output]} then {
248 verbose -log "$exec_output"
249 perror "could not move $realobj to $object"
250 return 0
251 }
252 } else {
253 perror "$object not found after compilation"
254 return 0
255 }
256 }
257 return 1
258 } else {
259 verbose -log "$exec_output"
260 perror "$source: compilation failed"
261 return 0
262 }
263 }
264
265 # Assemble a file.
266 #
267 proc default_ld_assemble { as source object } {
268 global ASFLAGS
269 global host_triplet
270
271 if {[which $as] == 0} then {
272 perror "$as does not exist"
273 return 0
274 }
275
276 if ![info exists ASFLAGS] { set ASFLAGS "" }
277
278 set flags [big_or_little_endian]
279
280 verbose -log "$as $flags $ASFLAGS -o $object $source"
281
282 catch "exec $as $flags $ASFLAGS -o $object $source" exec_output
283 set exec_output [prune_warnings $exec_output]
284 if [string match "" $exec_output] then {
285 return 1
286 } else {
287 verbose -log "$exec_output"
288 perror "$source: assembly failed"
289 return 0
290 }
291 }
292
293 # Run nm on a file, putting the result in the array nm_output.
294 #
295 proc default_ld_nm { nm nmflags object } {
296 global NMFLAGS
297 global nm_output
298 global host_triplet
299
300 if {[which $nm] == 0} then {
301 perror "$nm does not exist"
302 return 0
303 }
304
305 if {[info exists nm_output]} {
306 unset nm_output
307 }
308
309 if ![info exists NMFLAGS] { set NMFLAGS "" }
310
311 # Ensure consistent sorting of symbols
312 if {[info exists env(LC_ALL)]} {
313 set old_lc_all $env(LC_ALL)
314 }
315 set env(LC_ALL) "C"
316 verbose -log "$nm $NMFLAGS $nmflags $object >tmpdir/nm.out"
317
318 catch "exec $nm $NMFLAGS $nmflags $object >tmpdir/nm.out" exec_output
319 if {[info exists old_lc_all]} {
320 set env(LC_ALL) $old_lc_all
321 } else {
322 unset env(LC_ALL)
323 }
324 set exec_output [prune_warnings $exec_output]
325 if [string match "" $exec_output] then {
326 set file [open tmpdir/nm.out r]
327 while { [gets $file line] != -1 } {
328 verbose "$line" 2
329 if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] \\.*(.+)$" $line whole value name] {
330 set name [string trimleft $name "_"]
331 verbose "Setting nm_output($name) to 0x$value" 2
332 set nm_output($name) 0x$value
333 }
334 }
335 close $file
336 return 1
337 } else {
338 verbose -log "$exec_output"
339 perror "$object: nm failed"
340 return 0
341 }
342 }
343
344 # True if the object format is known to be ELF.
345 #
346 proc is_elf_format {} {
347 if { ![istarget *-*-sysv4*] \
348 && ![istarget *-*-unixware*] \
349 && ![istarget *-*-elf*] \
350 && ![istarget *-*-eabi*] \
351 && ![istarget hppa*64*-*-hpux*] \
352 && ![istarget *-*-linux*] \
353 && ![istarget frv-*-uclinux*] \
354 && ![istarget *-*-irix5*] \
355 && ![istarget *-*-irix6*] \
356 && ![istarget *-*-netbsd*] \
357 && ![istarget *-*-solaris2*] } {
358 return 0
359 }
360
361 if { [istarget *-*-linux*aout*] \
362 || [istarget *-*-linux*oldld*] } {
363 return 0
364 }
365
366 if { ![istarget *-*-netbsdelf*] \
367 && ([istarget *-*-netbsd*aout*] \
368 || [istarget *-*-netbsdpe*] \
369 || [istarget arm*-*-netbsd*] \
370 || [istarget sparc-*-netbsd*] \
371 || [istarget i*86-*-netbsd*] \
372 || [istarget m68*-*-netbsd*] \
373 || [istarget vax-*-netbsd*] \
374 || [istarget ns32k-*-netbsd*]) } {
375 return 0
376 }
377 return 1
378 }
379
380 # True if the object format is known to be 64-bit ELF.
381 #
382 proc is_elf64 { binary_file } {
383 global READELF
384 global READELFFLAGS
385
386 set readelf_size ""
387 catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got
388
389 if ![string match "" $got] then {
390 return 0
391 }
392
393 if { ![regexp "\n\[ \]*Class:\[ \]*ELF(\[0-9\]+)\n" \
394 [file_contents readelf.out] nil readelf_size] } {
395 return 0
396 }
397
398 if { $readelf_size == "64" } {
399 return 1
400 }
401
402 return 0
403 }
404
405 # True if the object format is known to be a.out.
406 #
407 proc is_aout_format {} {
408 if { [istarget *-*-*\[ab\]out*] \
409 || [istarget *-*-linux*oldld*] \
410 || [istarget *-*-msdos*] \
411 || [istarget arm-*-netbsd] \
412 || [istarget i?86-*-netbsd] \
413 || [istarget i?86-*-mach*] \
414 || [istarget i?86-*-vsta] \
415 || [istarget pdp11-*-*] \
416 || [istarget m68*-ericsson-ose] \
417 || [istarget m68k-hp-bsd*] \
418 || [istarget m68*-*-hpux*] \
419 || [istarget m68*-*-netbsd] \
420 || [istarget m68*-*-netbsd*4k*] \
421 || [istarget m68k-sony-*] \
422 || [istarget m68*-sun-sunos\[34\]*] \
423 || [istarget m68*-wrs-vxworks*] \
424 || [istarget ns32k-*-*] \
425 || [istarget sparc*-*-netbsd] \
426 || [istarget sparc-sun-sunos4*] \
427 || [istarget vax-dec-ultrix*] \
428 || [istarget vax-*-netbsd] } {
429 return 1
430 }
431 return 0
432 }
433
434 # True if the object format is known to be PE COFF.
435 #
436 proc is_pecoff_format {} {
437 if { ![istarget *-*-mingw32*] \
438 && ![istarget *-*-cygwin*] \
439 && ![istarget *-*-pe*] } {
440 return 0
441 }
442
443 return 1
444 }
445
446 # Compares two files line-by-line.
447 # Returns differences if exist.
448 # Returns null if file(s) cannot be opened.
449 #
450 proc simple_diff { file_1 file_2 } {
451 global target
452
453 set eof -1
454 set differences 0
455
456 if [file exists $file_1] then {
457 set file_a [open $file_1 r]
458 } else {
459 warning "$file_1 doesn't exist"
460 return
461 }
462
463 if [file exists $file_2] then {
464 set file_b [open $file_2 r]
465 } else {
466 fail "$file_2 doesn't exist"
467 return
468 }
469
470 verbose "# Diff'ing: $file_1 $file_2\n" 2
471
472 while { [gets $file_a line] != $eof } {
473 if [regexp "^#.*$" $line] then {
474 continue
475 } else {
476 lappend list_a $line
477 }
478 }
479 close $file_a
480
481 while { [gets $file_b line] != $eof } {
482 if [regexp "^#.*$" $line] then {
483 continue
484 } else {
485 lappend list_b $line
486 }
487 }
488 close $file_b
489
490 for { set i 0 } { $i < [llength $list_a] } { incr i } {
491 set line_a [lindex $list_a $i]
492 set line_b [lindex $list_b $i]
493
494 verbose "\t$file_1: $i: $line_a\n" 3
495 verbose "\t$file_2: $i: $line_b\n" 3
496 if [string compare $line_a $line_b] then {
497 verbose -log "\t$file_1: $i: $line_a\n"
498 verbose -log "\t$file_2: $i: $line_b\n"
499
500 fail "Test: $target"
501 return
502 }
503 }
504
505 if { [llength $list_a] != [llength $list_b] } {
506 fail "Test: $target"
507 return
508 }
509
510 if $differences<1 then {
511 pass "Test: $target"
512 }
513 }
514
515 # run_dump_test FILE
516 # Copied from gas testsuite, tweaked and further extended.
517 #
518 # Assemble a .s file, then run some utility on it and check the output.
519 #
520 # There should be an assembly language file named FILE.s in the test
521 # suite directory, and a pattern file called FILE.d. `run_dump_test'
522 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
523 # `nm' on the .o file to produce textual output, and then analyze that
524 # with regexps. The FILE.d file specifies what program to run, and
525 # what to expect in its output.
526 #
527 # The FILE.d file begins with zero or more option lines, which specify
528 # flags to pass to the assembler, the program to run to dump the
529 # assembler's output, and the options it wants. The option lines have
530 # the syntax:
531 #
532 # # OPTION: VALUE
533 #
534 # OPTION is the name of some option, like "name" or "objdump", and
535 # VALUE is OPTION's value. The valid options are described below.
536 # Whitespace is ignored everywhere, except within VALUE. The option
537 # list ends with the first line that doesn't match the above syntax
538 # (hmm, not great for error detection).
539 #
540 # The interesting options are:
541 #
542 # name: TEST-NAME
543 # The name of this test, passed to DejaGNU's `pass' and `fail'
544 # commands. If omitted, this defaults to FILE, the root of the
545 # .s and .d files' names.
546 #
547 # as: FLAGS
548 # When assembling, pass FLAGS to the assembler.
549 # If assembling several files, you can pass different assembler
550 # options in the "source" directives. See below.
551 #
552 # ld: FLAGS
553 # Link assembled files using FLAGS, in the order of the "source"
554 # directives, when using multiple files.
555 #
556 # objcopy_linked_file: FLAGS
557 # Run objcopy on the linked file with the specified flags.
558 # This lets you transform the linked file using objcopy, before the
559 # result is analyzed by an analyzer program specified below (which
560 # may in turn *also* be objcopy).
561 #
562 # PROG: PROGRAM-NAME
563 # The name of the program to run to analyze the .o file produced
564 # by the assembler or the linker output. This can be omitted;
565 # run_dump_test will guess which program to run by seeing which of
566 # the flags options below is present.
567 #
568 # objdump: FLAGS
569 # nm: FLAGS
570 # objcopy: FLAGS
571 # Use the specified program to analyze the assembler or linker
572 # output file, and pass it FLAGS, in addition to the output name.
573 # Note that they are run with LC_ALL=C in the environment to give
574 # consistent sorting of symbols.
575 #
576 # source: SOURCE [FLAGS]
577 # Assemble the file SOURCE.s using the flags in the "as" directive
578 # and the (optional) FLAGS. If omitted, the source defaults to
579 # FILE.s.
580 # This is useful if several .d files want to share a .s file.
581 # More than one "source" directive can be given, which is useful
582 # when testing linking.
583 #
584 # xfail: TARGET
585 # The test is expected to fail on TARGET. This may occur more than
586 # once.
587 #
588 # target: TARGET
589 # Only run the test for TARGET. This may occur more than once; the
590 # target being tested must match at least one.
591 #
592 # notarget: TARGET
593 # Do not run the test for TARGET. This may occur more than once;
594 # the target being tested must not match any of them.
595 #
596 # error: REGEX
597 # An error with message matching REGEX must be emitted for the test
598 # to pass. The PROG, objdump, nm and objcopy options have no
599 # meaning and need not supplied if this is present.
600 #
601 # warning: REGEX
602 # Expect a linker warning matching REGEX. It is an error to issue
603 # both "error" and "warning".
604 #
605 # Each option may occur at most once unless otherwise mentioned.
606 #
607 # After the option lines come regexp lines. `run_dump_test' calls
608 # `regexp_diff' to compare the output of the dumping tool against the
609 # regexps in FILE.d. `regexp_diff' is defined later in this file; see
610 # further comments there.
611 #
612 proc run_dump_test { name } {
613 global subdir srcdir
614 global OBJDUMP NM AS OBJCOPY READELF LD
615 global OBJDUMPFLAGS NMFLAGS ASFLAGS OBJCOPYFLAGS READELFFLAGS LDFLAGS
616 global host_triplet runtests
617 global env
618
619 if [string match "*/*" $name] {
620 set file $name
621 set name [file tail $name]
622 } else {
623 set file "$srcdir/$subdir/$name"
624 }
625
626 if ![runtest_file_p $runtests $name] then {
627 return
628 }
629
630 set opt_array [slurp_options "${file}.d"]
631 if { $opt_array == -1 } {
632 perror "error reading options from $file.d"
633 unresolved $subdir/$name
634 return
635 }
636 set dumpfile tmpdir/dump.out
637 set run_ld 0
638 set run_objcopy 0
639 set opts(as) {}
640 set opts(ld) {}
641 set opts(xfail) {}
642 set opts(target) {}
643 set opts(notarget) {}
644 set opts(objdump) {}
645 set opts(nm) {}
646 set opts(objcopy) {}
647 set opts(readelf) {}
648 set opts(name) {}
649 set opts(PROG) {}
650 set opts(source) {}
651 set opts(error) {}
652 set opts(warning) {}
653 set opts(objcopy_linked_file) {}
654 set asflags(${file}.s) {}
655
656 foreach i $opt_array {
657 set opt_name [lindex $i 0]
658 set opt_val [lindex $i 1]
659 if ![info exists opts($opt_name)] {
660 perror "unknown option $opt_name in file $file.d"
661 unresolved $subdir/$name
662 return
663 }
664
665 switch -- $opt_name {
666 xfail {}
667 target {}
668 notarget {}
669 source {
670 # Move any source-specific as-flags to a separate array to
671 # simplify processing.
672 if { [llength $opt_val] > 1 } {
673 set asflags([lindex $opt_val 0]) [lrange $opt_val 1 end]
674 set opt_val [lindex $opt_val 0]
675 } else {
676 set asflags($opt_val) {}
677 }
678 }
679 default {
680 if [string length $opts($opt_name)] {
681 perror "option $opt_name multiply set in $file.d"
682 unresolved $subdir/$name
683 return
684 }
685
686 # A single "# ld:" with no options should do the right thing.
687 if { $opt_name == "ld" } {
688 set run_ld 1
689 }
690 # Likewise objcopy_linked_file.
691 if { $opt_name == "objcopy_linked_file" } {
692 set run_objcopy 1
693 }
694 }
695 }
696 set opts($opt_name) [concat $opts($opt_name) $opt_val]
697 }
698
699 # Decide early whether we should run the test for this target.
700 if { [llength $opts(target)] > 0 } {
701 set targmatch 0
702 foreach targ $opts(target) {
703 if [istarget $targ] {
704 set targmatch 1
705 break
706 }
707 }
708 if { $targmatch == 0 } {
709 return
710 }
711 }
712 foreach targ $opts(notarget) {
713 if [istarget $targ] {
714 return
715 }
716 }
717
718 set program ""
719 # It's meaningless to require an output-testing method when we
720 # expect an error.
721 if { $opts(error) == "" } {
722 if {$opts(PROG) != ""} {
723 switch -- $opts(PROG) {
724 objdump { set program objdump }
725 nm { set program nm }
726 objcopy { set program objcopy }
727 readelf { set program readelf }
728 default
729 { perror "unrecognized program option $opts(PROG) in $file.d"
730 unresolved $subdir/$name
731 return }
732 }
733 } else {
734 # Guess which program to run, by seeing which option was specified.
735 foreach p {objdump objcopy nm readelf} {
736 if {$opts($p) != ""} {
737 if {$program != ""} {
738 perror "ambiguous dump program in $file.d"
739 unresolved $subdir/$name
740 return
741 } else {
742 set program $p
743 }
744 }
745 }
746 }
747 if { $program == "" && $opts(warning) == "" } {
748 perror "dump program unspecified in $file.d"
749 unresolved $subdir/$name
750 return
751 }
752 }
753
754 if { $opts(name) == "" } {
755 set testname "$subdir/$name"
756 } else {
757 set testname $opts(name)
758 }
759
760 if { $opts(source) == "" } {
761 set sourcefiles [list ${file}.s]
762 } else {
763 set sourcefiles {}
764 foreach sf $opts(source) {
765 if { [string match "/*" $sf] } {
766 lappend sourcefiles "$sf"
767 } else {
768 lappend sourcefiles "$srcdir/$subdir/$sf"
769 }
770 # Must have asflags indexed on source name.
771 set asflags($srcdir/$subdir/$sf) $asflags($sf)
772 }
773 }
774
775 # Time to setup xfailures.
776 foreach targ $opts(xfail) {
777 setup_xfail $targ
778 }
779
780 # Assemble each file.
781 set objfiles {}
782 for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
783 set sourcefile [lindex $sourcefiles $i]
784
785 set objfile "tmpdir/dump$i.o"
786 lappend objfiles $objfile
787 set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
788
789 send_log "$cmd\n"
790 set cmdret [catch "exec $cmd" comp_output]
791 set comp_output [prune_warnings $comp_output]
792
793 if { $cmdret != 0 || ![string match "" $comp_output] } then {
794 send_log "$comp_output\n"
795 verbose "$comp_output" 3
796
797 set exitstat "succeeded"
798 if { $cmdret != 0 } { set exitstat "failed" }
799 verbose -log "$exitstat with: <$comp_output>"
800 fail $testname
801 return
802 }
803 }
804
805 set expmsg $opts(error)
806 if { $opts(warning) != "" } {
807 if { $expmsg != "" } {
808 perror "$testname: mixing error and warning test-directives"
809 return
810 }
811 set expmsg $opts(warning)
812 }
813
814 # Perhaps link the file(s).
815 if { $run_ld } {
816 set objfile "tmpdir/dump"
817
818 # Add -L$srcdir/$subdir so that the linker command can use
819 # linker scripts in the source directory.
820 set cmd "$LD $LDFLAGS -L$srcdir/$subdir \
821 $opts(ld) -o $objfile $objfiles"
822
823 send_log "$cmd\n"
824 set cmdret [catch "exec $cmd" comp_output]
825 set comp_output [prune_warnings $comp_output]
826
827 if { $cmdret != 0 } then {
828 # If the executed program writes to stderr and stderr is not
829 # redirected, exec *always* returns failure, regardless of the
830 # program exit code. Thankfully, we can retrieve the true
831 # return status from a special variable. Redirection would
832 # cause a Tcl-specific message to be appended, and we'd rather
833 # not deal with that if we can help it.
834 global errorCode
835 if { [lindex $errorCode 0] == "NONE" } {
836 set cmdret 0
837 }
838 }
839
840 if { $cmdret == 0 && $run_objcopy } {
841 set infile $objfile
842 set objfile "tmpdir/dump1"
843
844 # Note that we don't use OBJCOPYFLAGS here; any flags must be
845 # explicitly specified.
846 set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"
847
848 send_log "$cmd\n"
849 set cmdret [catch "exec $cmd" comp_output]
850 append comp_output [prune_warnings $comp_output]
851
852 if { $cmdret != 0 } then {
853 global errorCode
854 if { [lindex $errorCode 0] == "NONE" } {
855 set cmdret 0
856 }
857 }
858 }
859
860 if { $cmdret != 0 || $comp_output != "" || $expmsg != "" } then {
861 set exitstat "succeeded"
862 if { $cmdret != 0 } { set exitstat "failed" }
863 verbose -log "$exitstat with: <$comp_output>, expected: <$expmsg>"
864 send_log "$comp_output\n"
865 verbose "$comp_output" 3
866
867 if { [regexp $expmsg $comp_output] \
868 && (($cmdret == 0) == ($opts(warning) != "")) } {
869 # We have the expected output from ld.
870 if { $opts(error) != "" || $program == "" } {
871 pass $testname
872 return
873 }
874 } else {
875 verbose -log "$exitstat with: <$comp_output>, expected: <$expmsg>"
876 fail $testname
877 return
878 }
879 }
880 } else {
881 set objfile "tmpdir/dump0.o"
882 }
883
884 # We must not have expected failure if we get here.
885 if { $opts(error) != "" } {
886 fail $testname
887 return
888 }
889
890 set progopts1 $opts($program)
891 eval set progopts \$[string toupper $program]FLAGS
892 eval set binary \$[string toupper $program]
893
894 if { [which $binary] == 0 } {
895 untested $testname
896 return
897 }
898
899 if { $progopts1 == "" } { set $progopts1 "-r" }
900 verbose "running $binary $progopts $progopts1" 3
901
902 # Objcopy, unlike the other two, won't send its output to stdout,
903 # so we have to run it specially.
904 set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
905 if { $program == "objcopy" } {
906 set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
907 }
908
909 # Ensure consistent sorting of symbols
910 if {[info exists env(LC_ALL)]} {
911 set old_lc_all $env(LC_ALL)
912 }
913 set env(LC_ALL) "C"
914 send_log "$cmd\n"
915 catch "exec $cmd" comp_output
916 if {[info exists old_lc_all]} {
917 set env(LC_ALL) $old_lc_all
918 } else {
919 unset env(LC_ALL)
920 }
921 set comp_output [prune_warnings $comp_output]
922 if ![string match "" $comp_output] then {
923 send_log "$comp_output\n"
924 fail $testname
925 return
926 }
927
928 verbose_eval {[file_contents $dumpfile]} 3
929 if { [regexp_diff $dumpfile "${file}.d"] } then {
930 fail $testname
931 verbose "output is [file_contents $dumpfile]" 2
932 return
933 }
934
935 pass $testname
936 }
937
938 proc slurp_options { file } {
939 if [catch { set f [open $file r] } x] {
940 #perror "couldn't open `$file': $x"
941 perror "$x"
942 return -1
943 }
944 set opt_array {}
945 # whitespace expression
946 set ws {[ ]*}
947 set nws {[^ ]*}
948 # whitespace is ignored anywhere except within the options list;
949 # option names are alphabetic plus underscore only.
950 set pat "^#${ws}(\[a-zA-Z_\]*)$ws:${ws}(.*)$ws\$"
951 while { [gets $f line] != -1 } {
952 set line [string trim $line]
953 # Whitespace here is space-tab.
954 if [regexp $pat $line xxx opt_name opt_val] {
955 # match!
956 lappend opt_array [list $opt_name $opt_val]
957 } else {
958 break
959 }
960 }
961 close $f
962 return $opt_array
963 }
964
965 # regexp_diff, copied from gas, based on simple_diff above.
966 # compares two files line-by-line
967 # file1 contains strings, file2 contains regexps and #-comments
968 # blank lines are ignored in either file
969 # returns non-zero if differences exist
970 #
971 proc regexp_diff { file_1 file_2 } {
972
973 set eof -1
974 set end_1 0
975 set end_2 0
976 set differences 0
977 set diff_pass 0
978
979 if [file exists $file_1] then {
980 set file_a [open $file_1 r]
981 } else {
982 warning "$file_1 doesn't exist"
983 return 1
984 }
985
986 if [file exists $file_2] then {
987 set file_b [open $file_2 r]
988 } else {
989 fail "$file_2 doesn't exist"
990 close $file_a
991 return 1
992 }
993
994 verbose " Regexp-diff'ing: $file_1 $file_2" 2
995
996 while { 1 } {
997 set line_a ""
998 set line_b ""
999 while { [string length $line_a] == 0 } {
1000 if { [gets $file_a line_a] == $eof } {
1001 set end_1 1
1002 break
1003 }
1004 }
1005 while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
1006 if [ string match "#pass" $line_b ] {
1007 set end_2 1
1008 set diff_pass 1
1009 break
1010 } elseif [ string match "#..." $line_b ] {
1011 if { [gets $file_b line_b] == $eof } {
1012 set end_2 1
1013 set diff_pass 1
1014 break
1015 }
1016 verbose "looking for \"^$line_b$\"" 3
1017 while { ![regexp "^$line_b$" "$line_a"] } {
1018 verbose "skipping \"$line_a\"" 3
1019 if { [gets $file_a line_a] == $eof } {
1020 set end_1 1
1021 break
1022 }
1023 }
1024 break
1025 }
1026 if { [gets $file_b line_b] == $eof } {
1027 set end_2 1
1028 break
1029 }
1030 }
1031
1032 if { $diff_pass } {
1033 break
1034 } elseif { $end_1 && $end_2 } {
1035 break
1036 } elseif { $end_1 } {
1037 send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
1038 verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
1039 set differences 1
1040 break
1041 } elseif { $end_2 } {
1042 send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
1043 verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
1044 set differences 1
1045 break
1046 } else {
1047 verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3
1048 if ![regexp "^$line_b$" "$line_a"] {
1049 send_log "regexp_diff match failure\n"
1050 send_log "regexp \"^$line_b$\"\nline \"$line_a\"\n"
1051 set differences 1
1052 }
1053 }
1054 }
1055
1056 if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
1057 send_log "$file_1 and $file_2 are different lengths\n"
1058 verbose "$file_1 and $file_2 are different lengths" 3
1059 set differences 1
1060 }
1061
1062 close $file_a
1063 close $file_b
1064
1065 return $differences
1066 }
1067
1068 proc file_contents { filename } {
1069 set file [open $filename r]
1070 set contents [read $file]
1071 close $file
1072 return $contents
1073 }
1074
1075 # List contains test-items with 3 items followed by 2 lists, one item and
1076 # one optional item:
1077 # 0:name 1:ld options 2:assembler options
1078 # 3:filenames of assembler files 4: action and options. 5: name of output file
1079 # 6:compiler flags (optional)
1080 #
1081 # Actions:
1082 # objdump: Apply objdump options on result. Compare with regex (last arg).
1083 # nm: Apply nm options on result. Compare with regex (last arg).
1084 # readelf: Apply readelf options on result. Compare with regex (last arg).
1085 #
1086 proc run_ld_link_tests { ldtests } {
1087 global ld
1088 global as
1089 global nm
1090 global objdump
1091 global READELF
1092 global srcdir
1093 global subdir
1094 global env
1095 global CC
1096 global CFLAGS
1097
1098 foreach testitem $ldtests {
1099 set testname [lindex $testitem 0]
1100 set ld_options [lindex $testitem 1]
1101 set as_options [lindex $testitem 2]
1102 set src_files [lindex $testitem 3]
1103 set actions [lindex $testitem 4]
1104 set binfile tmpdir/[lindex $testitem 5]
1105 set cflags [lindex $testitem 6]
1106 set objfiles {}
1107 set is_unresolved 0
1108 set failed 0
1109
1110 # verbose -log "Testname is $testname"
1111 # verbose -log "ld_options is $ld_options"
1112 # verbose -log "as_options is $as_options"
1113 # verbose -log "src_files is $src_files"
1114 # verbose -log "actions is $actions"
1115 # verbose -log "binfile is $binfile"
1116
1117 # Assemble each file in the test.
1118 foreach src_file $src_files {
1119 set objfile "tmpdir/[file rootname $src_file].o"
1120 lappend objfiles $objfile
1121
1122 if { [file extension $src_file] == ".c" } {
1123 set as_file "tmpdir/[file rootname $src_file].s"
1124 if ![ld_compile "$CC -S $CFLAGS $cflags" $srcdir/$subdir/$src_file $as_file] {
1125 set is_unresolved 1
1126 break
1127 }
1128 } else {
1129 set as_file "$srcdir/$subdir/$src_file"
1130 }
1131 if ![ld_assemble $as "$as_options $as_file" $objfile] {
1132 set is_unresolved 1
1133 break
1134 }
1135 }
1136
1137 # Catch assembler errors.
1138 if { $is_unresolved != 0 } {
1139 unresolved $testname
1140 continue
1141 }
1142
1143 if ![ld_simple_link $ld $binfile "-L$srcdir/$subdir $ld_options $objfiles"] {
1144 fail $testname
1145 } else {
1146 set failed 0
1147 foreach actionlist $actions {
1148 set action [lindex $actionlist 0]
1149 set progopts [lindex $actionlist 1]
1150
1151 # There are actions where we run regexp_diff on the
1152 # output, and there are other actions (presumably).
1153 # Handling of the former look the same.
1154 set dump_prog ""
1155 switch -- $action {
1156 objdump
1157 { set dump_prog $objdump }
1158 nm
1159 { set dump_prog $nm }
1160 readelf
1161 { set dump_prog $READELF }
1162 default
1163 {
1164 perror "Unrecognized action $action"
1165 set is_unresolved 1
1166 break
1167 }
1168 }
1169
1170 if { $dump_prog != "" } {
1171 set dumpfile [lindex $actionlist 2]
1172 set binary $dump_prog
1173
1174 # Ensure consistent sorting of symbols
1175 if {[info exists env(LC_ALL)]} {
1176 set old_lc_all $env(LC_ALL)
1177 }
1178 set env(LC_ALL) "C"
1179 set cmd "$binary $progopts $binfile > dump.out"
1180 send_log "$cmd\n"
1181 catch "exec $cmd" comp_output
1182 if {[info exists old_lc_all]} {
1183 set env(LC_ALL) $old_lc_all
1184 } else {
1185 unset env(LC_ALL)
1186 }
1187 set comp_output [prune_warnings $comp_output]
1188
1189 if ![string match "" $comp_output] then {
1190 send_log "$comp_output\n"
1191 set failed 1
1192 break
1193 }
1194
1195 if { [regexp_diff "dump.out" "$srcdir/$subdir/$dumpfile"] } then {
1196 verbose "output is [file_contents "dump.out"]" 2
1197 set failed 1
1198 break
1199 }
1200 }
1201 }
1202
1203 if { $failed != 0 } {
1204 fail $testname
1205 } else { if { $is_unresolved == 0 } {
1206 pass $testname
1207 } }
1208 }
1209
1210 # Catch action errors.
1211 if { $is_unresolved != 0 } {
1212 unresolved $testname
1213 continue
1214 }
1215 }
1216 }
1217
1218
1219 proc verbose_eval { expr { level 1 } } {
1220 global verbose
1221 if $verbose>$level then { eval verbose "$expr" $level }
1222 }
1223
1224 # This definition is taken from an unreleased version of DejaGnu. Once
1225 # that version gets released, and has been out in the world for a few
1226 # months at least, it may be safe to delete this copy.
1227 if ![string length [info proc prune_warnings]] {
1228 #
1229 # prune_warnings -- delete various system verbosities from TEXT
1230 #
1231 # An example is:
1232 # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
1233 #
1234 # Sites with particular verbose os's may wish to override this in site.exp.
1235 #
1236 proc prune_warnings { text } {
1237 # This is from sun4's. Do it for all machines for now.
1238 # The "\\1" is to try to preserve a "\n" but only if necessary.
1239 regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
1240
1241 # It might be tempting to get carried away and delete blank lines, etc.
1242 # Just delete *exactly* what we're ask to, and that's it.
1243 return $text
1244 }
1245 }
1246
1247 # targets_to_xfail is a list of target triplets to be xfailed.
1248 # ldtests contains test-items with 3 items followed by 1 lists, 2 items
1249 # and 2 optional items:
1250 # 0:name
1251 # 1:ld options
1252 # 2:assembler options
1253 # 3:filenames of source files
1254 # 4:name of output file
1255 # 5:expected output
1256 # 6:compiler flags (optional)
1257 # 7:language (optional)
1258
1259 proc run_ld_link_exec_tests { targets_to_xfail ldtests } {
1260 global ld
1261 global as
1262 global srcdir
1263 global subdir
1264 global env
1265 global CC
1266 global CXX
1267 global CFLAGS
1268 global errcnt
1269
1270 foreach testitem $ldtests {
1271 foreach target $targets_to_xfail {
1272 setup_xfail $target
1273 }
1274 set testname [lindex $testitem 0]
1275 set ld_options [lindex $testitem 1]
1276 set as_options [lindex $testitem 2]
1277 set src_files [lindex $testitem 3]
1278 set binfile tmpdir/[lindex $testitem 4]
1279 set expfile [lindex $testitem 5]
1280 set cflags [lindex $testitem 6]
1281 set lang [lindex $testitem 7]
1282 set objfiles {}
1283 set failed 0
1284
1285 # verbose -log "Testname is $testname"
1286 # verbose -log "ld_options is $ld_options"
1287 # verbose -log "as_options is $as_options"
1288 # verbose -log "src_files is $src_files"
1289 # verbose -log "actions is $actions"
1290 # verbose -log "binfile is $binfile"
1291
1292 # Assemble each file in the test.
1293 foreach src_file $src_files {
1294 set objfile "tmpdir/[file rootname $src_file].o"
1295 lappend objfiles $objfile
1296
1297 # We ignore warnings since some compilers may generate
1298 # incorrect section attributes and the assembler will warn
1299 # them.
1300 ld_compile "$CC -c $CFLAGS $cflags" $srcdir/$subdir/$src_file $objfile
1301
1302 # We have to use $CC to build PIE and shared library.
1303 if { [ string match "c" $lang ] } {
1304 set link_proc ld_simple_link
1305 set link_cmd $CC
1306 } elseif { [ string match "c++" $lang ] } {
1307 set link_proc ld_simple_link
1308 set link_cmd $CXX
1309 } elseif { [ string match "-shared" $ld_options ] \
1310 || [ string match "-pie" $ld_options ] } {
1311 set link_proc ld_simple_link
1312 set link_cmd $CC
1313 } else {
1314 set link_proc ld_link
1315 set link_cmd $ld
1316 }
1317
1318 if ![$link_proc $link_cmd $binfile "-L$srcdir/$subdir $ld_options $objfiles"] {
1319 set failed 1
1320 } else {
1321 set failed 0
1322 send_log "Running: $binfile > $binfile.out\n"
1323 verbose "Running: $binfile > $binfile.out"
1324 catch "exec $binfile > $binfile.out" exec_output
1325
1326 if ![string match "" $exec_output] then {
1327 send_log "$exec_output\n"
1328 verbose "$exec_output" 1
1329 set failed 1
1330 } else {
1331 send_log "diff $binfile.out $srcdir/$subdir/$expfile\n"
1332 verbose "diff $binfile.out $srcdir/$subdir/$expfile"
1333 catch "exec diff $binfile.out $srcdir/$subdir/$expfile" exec_output
1334 set exec_output [prune_warnings $exec_output]
1335
1336 if ![string match "" $exec_output] then {
1337 send_log "$exec_output\n"
1338 verbose "$exec_output" 1
1339 set failed 1
1340 }
1341 }
1342 }
1343
1344 if { $failed != 0 } {
1345 fail $testname
1346 } else {
1347 set errcnt 0
1348 pass $testname
1349 }
1350 }
1351 }
1352 }
1353
1354 # List contains test-items with 3 items followed by 2 lists, one item and
1355 # one optional item:
1356 # 0:name
1357 # 1:link options
1358 # 2:compile options
1359 # 3:filenames of source files
1360 # 4:action and options.
1361 # 5:name of output file
1362 # 6:language (optional)
1363 #
1364 # Actions:
1365 # objdump: Apply objdump options on result. Compare with regex (last arg).
1366 # nm: Apply nm options on result. Compare with regex (last arg).
1367 # readelf: Apply readelf options on result. Compare with regex (last arg).
1368 #
1369 proc run_cc_link_tests { ldtests } {
1370 global nm
1371 global objdump
1372 global READELF
1373 global srcdir
1374 global subdir
1375 global env
1376 global CC
1377 global CXX
1378 global CFLAGS
1379
1380 foreach testitem $ldtests {
1381 set testname [lindex $testitem 0]
1382 set ldflags [lindex $testitem 1]
1383 set cflags [lindex $testitem 2]
1384 set src_files [lindex $testitem 3]
1385 set actions [lindex $testitem 4]
1386 set binfile tmpdir/[lindex $testitem 5]
1387 set lang [lindex $testitem 6]
1388 set objfiles {}
1389 set is_unresolved 0
1390 set failed 0
1391
1392 # Compile each file in the test.
1393 foreach src_file $src_files {
1394 set objfile "tmpdir/[file rootname $src_file].o"
1395 lappend objfiles $objfile
1396
1397 # We ignore warnings since some compilers may generate
1398 # incorrect section attributes and the assembler will warn
1399 # them.
1400 ld_compile "$CC -c $CFLAGS $cflags" $srcdir/$subdir/$src_file $objfile
1401 }
1402
1403 # Clear error and warning counts.
1404 reset_vars
1405
1406 if { [ string match "c++" $lang ] } {
1407 set cc_cmd $CXX
1408 } else {
1409 set cc_cmd $CC
1410 }
1411
1412 if ![ld_simple_link $cc_cmd $binfile "-L$srcdir/$subdir $ldflags $objfiles"] {
1413 fail $testname
1414 } else {
1415 set failed 0
1416 foreach actionlist $actions {
1417 set action [lindex $actionlist 0]
1418 set progopts [lindex $actionlist 1]
1419
1420 # There are actions where we run regexp_diff on the
1421 # output, and there are other actions (presumably).
1422 # Handling of the former look the same.
1423 set dump_prog ""
1424 switch -- $action {
1425 objdump
1426 { set dump_prog $objdump }
1427 nm
1428 { set dump_prog $nm }
1429 readelf
1430 { set dump_prog $READELF }
1431 default
1432 {
1433 perror "Unrecognized action $action"
1434 set is_unresolved 1
1435 break
1436 }
1437 }
1438
1439 if { $dump_prog != "" } {
1440 set dumpfile [lindex $actionlist 2]
1441 set binary $dump_prog
1442
1443 # Ensure consistent sorting of symbols
1444 if {[info exists env(LC_ALL)]} {
1445 set old_lc_all $env(LC_ALL)
1446 }
1447 set env(LC_ALL) "C"
1448 set cmd "$binary $progopts $binfile > dump.out"
1449 send_log "$cmd\n"
1450 catch "exec $cmd" comp_output
1451 if {[info exists old_lc_all]} {
1452 set env(LC_ALL) $old_lc_all
1453 } else {
1454 unset env(LC_ALL)
1455 }
1456 set comp_output [prune_warnings $comp_output]
1457
1458 if ![string match "" $comp_output] then {
1459 send_log "$comp_output\n"
1460 set failed 1
1461 break
1462 }
1463
1464 if { [regexp_diff "dump.out" "$srcdir/$subdir/$dumpfile"] } then {
1465 verbose "output is [file_contents "dump.out"]" 2
1466 set failed 1
1467 break
1468 }
1469 }
1470 }
1471
1472 if { $failed != 0 } {
1473 fail $testname
1474 } else { if { $is_unresolved == 0 } {
1475 pass $testname
1476 } }
1477 }
1478
1479 # Catch action errors.
1480 if { $is_unresolved != 0 } {
1481 unresolved $testname
1482 continue
1483 }
1484 }
1485 }