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