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 *-*-irix5*] \
 367          && ![istarget *-*-irix6*] \
 368          && ![istarget *-*-netbsd*] \
 369          && ![istarget *-*-solaris2*] } {
 370         return 0
 371     }
 372
 373     if { [istarget *-*-linux*aout*] \
 374          || [istarget *-*-linux*oldld*] } {
 375         return 0
 376     }
 377
 378     if { ![istarget *-*-netbsdelf*] \
 379          && ([istarget *-*-netbsd*aout*] \
 380              || [istarget *-*-netbsdpe*] \
 381              || [istarget arm*-*-netbsd*] \
 382              || [istarget sparc-*-netbsd*] \
 383              || [istarget i*86-*-netbsd*] \
 384              || [istarget m68*-*-netbsd*] \
 385              || [istarget vax-*-netbsd*] \
 386              || [istarget ns32k-*-netbsd*]) } {
 387         return 0
 388     }
 389     return 1
 390 }
 391
 392 #
 393 # simple_diff
 394 #       compares two files line-by-line
 395 #       returns differences if exist
 396 #       returns null if file(s) cannot be opened
 397 #
 398 proc simple_diff { file_1 file_2 } {
 399     global target
 400
 401     set eof -1
 402     set differences 0
 403
 404     if [file exists $file_1] then {
 405         set file_a [open $file_1 r]
 406     } else {
 407         warning "$file_1 doesn't exist"
 408         return
 409     }
 410
 411     if [file exists $file_2] then {
 412         set file_b [open $file_2 r]
 413     } else {
 414         fail "$file_2 doesn't exist"
 415         return
 416     }
 417
 418     verbose "# Diff'ing: $file_1 $file_2\n" 2
 419
 420     while { [gets $file_a line] != $eof } {
 421         if [regexp "^#.*$" $line] then {
 422             continue
 423         } else {
 424             lappend list_a $line
 425         }
 426     }
 427     close $file_a
 428
 429     while { [gets $file_b line] != $eof } {
 430         if [regexp "^#.*$" $line] then {
 431             continue
 432         } else {
 433             lappend list_b $line
 434         }
 435     }
 436     close $file_b
 437
 438     for { set i 0 } { $i < [llength $list_a] } { incr i } {
 439         set line_a [lindex $list_a $i]
 440         set line_b [lindex $list_b $i]
 441
 442         verbose "\t$file_1: $i: $line_a\n" 3
 443         verbose "\t$file_2: $i: $line_b\n" 3
 444         if [string compare $line_a $line_b] then {
 445             verbose -log "\t$file_1: $i: $line_a\n"
 446             verbose -log "\t$file_2: $i: $line_b\n"
 447
 448             fail "Test: $target"
 449             return
 450         }
 451     }
 452
 453     if { [llength $list_a] != [llength $list_b] } {
 454         fail "Test: $target"
 455         return
 456     }
 457
 458     if $differences<1 then {
 459         pass "Test: $target"
 460     }
 461 }
 462
 463 # run_dump_test FILE
 464 # Copied from gas testsuite, tweaked and further extended.
 465 #
 466 # Assemble a .s file, then run some utility on it and check the output.
 467 #
 468 # There should be an assembly language file named FILE.s in the test
 469 # suite directory, and a pattern file called FILE.d.  `run_dump_test'
 470 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
 471 # `nm' on the .o file to produce textual output, and then analyze that
 472 # with regexps.  The FILE.d file specifies what program to run, and
 473 # what to expect in its output.
 474 #
 475 # The FILE.d file begins with zero or more option lines, which specify
 476 # flags to pass to the assembler, the program to run to dump the
 477 # assembler's output, and the options it wants.  The option lines have
 478 # the syntax:
 479 #
 480 #         # OPTION: VALUE
 481 #
 482 # OPTION is the name of some option, like "name" or "objdump", and
 483 # VALUE is OPTION's value.  The valid options are described below.
 484 # Whitespace is ignored everywhere, except within VALUE.  The option
 485 # list ends with the first line that doesn't match the above syntax
 486 # (hmm, not great for error detection).
 487 #
 488 # The interesting options are:
 489 #
 490 #   name: TEST-NAME
 491 #       The name of this test, passed to DejaGNU's `pass' and `fail'
 492 #       commands.  If omitted, this defaults to FILE, the root of the
 493 #       .s and .d files' names.
 494 #
 495 #   as: FLAGS
 496 #       When assembling, pass FLAGS to the assembler.
 497 #       If assembling several files, you can pass different assembler
 498 #       options in the "source" directives.  See below.
 499 #
 500 #   ld: FLAGS
 501 #       Link assembled files using FLAGS, in the order of the "source"
 502 #       directives, when using multiple files.
 503 #
 504 #   objcopy_linked_file: FLAGS
 505 #       Run objcopy on the linked file with the specified flags.
 506 #       This lets you transform the linked file using objcopy, before the
 507 #       result is analyzed by an analyzer program specified below (which
 508 #       may in turn *also* be objcopy).
 509 #
 510 #   PROG: PROGRAM-NAME
 511 #       The name of the program to run to analyze the .o file produced
 512 #       by the assembler or the linker output.  This can be omitted;
 513 #       run_dump_test will guess which program to run by seeing which of
 514 #       the flags options below is present.
 515 #
 516 #   objdump: FLAGS
 517 #   nm: FLAGS
 518 #   objcopy: FLAGS
 519 #       Use the specified program to analyze the assembler or linker
 520 #       output file, and pass it FLAGS, in addition to the output name.
 521 #       Note that they are run with LC_ALL=C in the environment to give
 522 #       consistent sorting of symbols.
 523 #
 524 #   source: SOURCE [FLAGS]
 525 #       Assemble the file SOURCE.s using the flags in the "as" directive
 526 #       and the (optional) FLAGS.  If omitted, the source defaults to
 527 #       FILE.s.
 528 #       This is useful if several .d files want to share a .s file.
 529 #       More than one "source" directive can be given, which is useful
 530 #       when testing linking.
 531 #
 532 #   xfail: TARGET
 533 #       The test is expected to fail on TARGET.  This may occur more than
 534 #       once.
 535 #
 536 #   target: TARGET
 537 #       Only run the test for TARGET.  This may occur more than once; the
 538 #       target being tested must match at least one.
 539 #
 540 #   notarget: TARGET
 541 #       Do not run the test for TARGET.  This may occur more than once;
 542 #       the target being tested must not match any of them.
 543 #
 544 #   error: REGEX
 545 #       An error with message matching REGEX must be emitted for the test
 546 #       to pass.  The PROG, objdump, nm and objcopy options have no
 547 #       meaning and need not supplied if this is present.
 548 #
 549 # Each option may occur at most once unless otherwise mentioned.
 550 #
 551 # After the option lines come regexp lines.  `run_dump_test' calls
 552 # `regexp_diff' to compare the output of the dumping tool against the
 553 # regexps in FILE.d.  `regexp_diff' is defined later in this file; see
 554 # further comments there.
 555
 556 proc run_dump_test { name } {
 557     global subdir srcdir
 558     global OBJDUMP NM AS OBJCOPY READELF LD
 559     global OBJDUMPFLAGS NMFLAGS ASFLAGS OBJCOPYFLAGS READELFFLAGS LDFLAGS
 560     global host_triplet runtests
 561     global env
 562
 563     if [string match "*/*" $name] {
 564         set file $name
 565         set name [file tail $name]
 566     } else {
 567         set file "$srcdir/$subdir/$name"
 568     }
 569
 570     if ![runtest_file_p $runtests $name] then {
 571         return
 572     }
 573
 574     set opt_array [slurp_options "${file}.d"]
 575     if { $opt_array == -1 } {
 576         perror "error reading options from $file.d"
 577         unresolved $subdir/$name
 578         return
 579     }
 580     set dumpfile tmpdir/dump.out
 581     set run_ld 0
 582     set run_objcopy 0
 583     set opts(as) {}
 584     set opts(ld) {}
 585     set opts(xfail) {}
 586     set opts(target) {}
 587     set opts(notarget) {}
 588     set opts(objdump) {}
 589     set opts(nm) {}
 590     set opts(objcopy) {}
 591     set opts(readelf) {}
 592     set opts(name) {}
 593     set opts(PROG) {}
 594     set opts(source) {}
 595     set opts(error) {}
 596     set opts(objcopy_linked_file) {}
 597     set asflags(${file}.s) {}
 598
 599     foreach i $opt_array {
 600         set opt_name [lindex $i 0]
 601         set opt_val [lindex $i 1]
 602         if ![info exists opts($opt_name)] {
 603             perror "unknown option $opt_name in file $file.d"
 604             unresolved $subdir/$name
 605             return
 606         }
 607
 608         switch -- $opt_name {
 609             xfail {}
 610             target {}
 611             notarget {}
 612             source {
 613                 # Move any source-specific as-flags to a separate array to
 614                 # simplify processing.
 615                 if { [llength $opt_val] > 1 } {
 616                     set asflags([lindex $opt_val 0]) [lrange $opt_val 1 end]
 617                     set opt_val [lindex $opt_val 0]
 618                 } else {
 619                     set asflags($opt_val) {}
 620                 }
 621             }
 622             default {
 623                 if [string length $opts($opt_name)] {
 624                     perror "option $opt_name multiply set in $file.d"
 625                     unresolved $subdir/$name
 626                     return
 627                 }
 628
 629                 # A single "# ld:" with no options should do the right thing.
 630                 if { $opt_name == "ld" } {
 631                     set run_ld 1
 632                 }
 633                 # Likewise objcopy_linked_file.
 634                 if { $opt_name == "objcopy_linked_file" } {
 635                     set run_objcopy 1
 636                 }
 637             }
 638         }
 639         set opts($opt_name) [concat $opts($opt_name) $opt_val]
 640     }
 641
 642     # Decide early whether we should run the test for this target.
 643     if { [llength $opts(target)] > 0 } {
 644         set targmatch 0
 645         foreach targ $opts(target) {
 646             if [istarget $targ] {
 647                 set targmatch 1
 648                 break
 649             }
 650         }
 651         if { $targmatch == 0 } {
 652             return
 653         }
 654     }
 655     foreach targ $opts(notarget) {
 656         if [istarget $targ] {
 657             return
 658         }
 659     }
 660
 661     if {$opts(PROG) != ""} {
 662         switch -- $opts(PROG) {
 663             objdump
 664                 { set program objdump }
 665             nm
 666                 { set program nm }
 667             objcopy
 668                 { set program objcopy }
 669             readelf
 670                 { set program readelf }
 671             default
 672                 { perror "unrecognized program option $opts(PROG) in $file.d"
 673                   unresolved $subdir/$name
 674                   return }
 675         }
 676     } elseif { $opts(error) != "" } {
 677         # It's meaningless to require an output-testing method when we
 678         # expect an error.  For simplicity, we fake an arbitrary method.
 679         set program "nm"
 680     } else {
 681         # Guess which program to run, by seeing which option was specified.
 682         set program ""
 683         foreach p {objdump objcopy nm readelf} {
 684             if {$opts($p) != ""} {
 685                 if {$program != ""} {
 686                     perror "ambiguous dump program in $file.d"
 687                     unresolved $subdir/$name
 688                     return
 689                 } else {
 690                     set program $p
 691                 }
 692             }
 693         }
 694         if {$program == ""} {
 695             perror "dump program unspecified in $file.d"
 696             unresolved $subdir/$name
 697             return
 698         }
 699     }
 700
 701     set progopts1 $opts($program)
 702     eval set progopts \$[string toupper $program]FLAGS
 703     eval set binary \$[string toupper $program]
 704     if { $opts(name) == "" } {
 705         set testname "$subdir/$name"
 706     } else {
 707         set testname $opts(name)
 708     }
 709
 710     if { $opts(source) == "" } {
 711         set sourcefiles [list ${file}.s]
 712     } else {
 713         set sourcefiles {}
 714         foreach sf $opts(source) {
 715             if { [string match "/*" $sf] } {
 716                 lappend sourcefiles "$sf"
 717             } {
 718                 lappend sourcefiles "$srcdir/$subdir/$sf"
 719             }
 720             # Must have asflags indexed on source name.
 721             set asflags($srcdir/$subdir/$sf) $asflags($sf)
 722         }
 723     }
 724
 725     # Time to setup xfailures.
 726     foreach targ $opts(xfail) {
 727         setup_xfail $targ
 728     }
 729
 730     # Assemble each file.
 731     set objfiles {}
 732     for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
 733         set sourcefile [lindex $sourcefiles $i]
 734
 735         set objfile "tmpdir/dump$i.o"
 736         lappend objfiles $objfile
 737         set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
 738
 739         send_log "$cmd\n"
 740         set cmdret [catch "exec $cmd" comp_output]
 741         set comp_output [prune_warnings $comp_output]
 742
 743         # We accept errors at assembly stage too, unless we're supposed to
 744         # link something.
 745         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 746             send_log "$comp_output\n"
 747             verbose "$comp_output" 3
 748             if { $opts(error) != "" && $run_ld == 0 } {
 749                 if [regexp $opts(error) $comp_output] {
 750                     pass $testname
 751                     return
 752                 }
 753             }
 754             fail $testname
 755             return
 756         }
 757     }
 758
 759     # Perhaps link the file(s).
 760     if { $run_ld } {
 761         set objfile "tmpdir/dump"
 762
 763         # Add -L$srcdir/$subdir so that the linker command can use
 764         # linker scripts in the source directory.
 765         set cmd "$LD $LDFLAGS -L$srcdir/$subdir \
 766                    $opts(ld) -o $objfile $objfiles"
 767
 768         send_log "$cmd\n"
 769         set cmdret [catch "exec $cmd" comp_output]
 770         set comp_output [prune_warnings $comp_output]
 771
 772         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 773             verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
 774             send_log "$comp_output\n"
 775             verbose "$comp_output" 3
 776             if { $opts(error) != "" && $run_objcopy == 0 } {
 777                 if [regexp $opts(error) $comp_output] {
 778                     pass $testname
 779                     return
 780                 }
 781             }
 782             fail $testname
 783             return
 784         }
 785
 786         if { $run_objcopy } {
 787             set infile $objfile
 788             set objfile "tmpdir/dump1"
 789
 790             # Note that we don't use OBJCOPYFLAGS here; any flags must be
 791             # explicitly specified.
 792             set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"
 793
 794             send_log "$cmd\n"
 795             set cmdret [catch "exec $cmd" comp_output]
 796             set comp_output [prune_warnings $comp_output]
 797
 798             if { $cmdret != 0 || ![string match "" $comp_output] } then {
 799                 verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
 800                 send_log "$comp_output\n"
 801                 verbose "$comp_output" 3
 802                 if { $opts(error) != "" } {
 803                     if [regexp $opts(error) $comp_output] {
 804                         pass $testname
 805                         return
 806                     }
 807                 }
 808                 fail $testname
 809                 return
 810             }
 811         }
 812     } else {
 813         set objfile "tmpdir/dump0.o"
 814     }
 815
 816     # We must not have expected failure if we get here.
 817     if { $opts(error) != "" } {
 818         fail $testname
 819         return
 820     }
 821
 822     if { [which $binary] == 0 } {
 823         untested $testname
 824         return
 825     }
 826
 827     if { $progopts1 == "" } { set $progopts1 "-r" }
 828     verbose "running $binary $progopts $progopts1" 3
 829
 830     # Objcopy, unlike the other two, won't send its output to stdout,
 831     # so we have to run it specially.
 832     set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
 833     if { $program == "objcopy" } {
 834         set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
 835     }
 836
 837     # Ensure consistent sorting of symbols
 838     if {[info exists env(LC_ALL)]} {
 839         set old_lc_all $env(LC_ALL)
 840     }
 841     set env(LC_ALL) "C"
 842     send_log "$cmd\n"
 843     catch "exec $cmd" comp_output
 844     if {[info exists old_lc_all]} {
 845         set env(LC_ALL) $old_lc_all
 846     } else {
 847         unset env(LC_ALL)
 848     }
 849     set comp_output [prune_warnings $comp_output]
 850     if ![string match "" $comp_output] then {
 851         send_log "$comp_output\n"
 852         fail $testname
 853         return
 854     }
 855
 856     verbose_eval {[file_contents $dumpfile]} 3
 857     if { [regexp_diff $dumpfile "${file}.d"] } then {
 858         fail $testname
 859         verbose "output is [file_contents $dumpfile]" 2
 860         return
 861     }
 862
 863     pass $testname
 864 }
 865
 866 proc slurp_options { file } {
 867     if [catch { set f [open $file r] } x] {
 868         #perror "couldn't open `$file': $x"
 869         perror "$x"
 870         return -1
 871     }
 872     set opt_array {}
 873     # whitespace expression
 874     set ws  {[  ]*}
 875     set nws {[^         ]*}
 876     # whitespace is ignored anywhere except within the options list;
 877     # option names are alphabetic plus underscore only.
 878     set pat "^#${ws}(\[a-zA-Z_\]*)$ws:${ws}(.*)$ws\$"
 879     while { [gets $f line] != -1 } {
 880         set line [string trim $line]
 881         # Whitespace here is space-tab.
 882         if [regexp $pat $line xxx opt_name opt_val] {
 883             # match!
 884             lappend opt_array [list $opt_name $opt_val]
 885         } else {
 886             break
 887         }
 888     }
 889     close $f
 890     return $opt_array
 891 }
 892
 893 # regexp_diff, copied from gas, based on simple_diff above.
 894 #       compares two files line-by-line
 895 #       file1 contains strings, file2 contains regexps and #-comments
 896 #       blank lines are ignored in either file
 897 #       returns non-zero if differences exist
 898 #
 899 proc regexp_diff { file_1 file_2 } {
 900
 901     set eof -1
 902     set end_1 0
 903     set end_2 0
 904     set differences 0
 905     set diff_pass 0
 906
 907     if [file exists $file_1] then {
 908         set file_a [open $file_1 r]
 909     } else {
 910         warning "$file_1 doesn't exist"
 911         return 1
 912     }
 913
 914     if [file exists $file_2] then {
 915         set file_b [open $file_2 r]
 916     } else {
 917         fail "$file_2 doesn't exist"
 918         close $file_a
 919         return 1
 920     }
 921
 922     verbose " Regexp-diff'ing: $file_1 $file_2" 2
 923
 924     while { 1 } {
 925         set line_a ""
 926         set line_b ""
 927         while { [string length $line_a] == 0 } {
 928             if { [gets $file_a line_a] == $eof } {
 929                 set end_1 1
 930                 break
 931             }
 932         }
 933         while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
 934             if [ string match "#pass" $line_b ] {
 935                 set end_2 1
 936                 set diff_pass 1
 937                 break
 938             } elseif [ string match "#..." $line_b ] {
 939                 if { [gets $file_b line_b] == $eof } {
 940                     set end_2 1
 941                     break
 942                 }
 943                 verbose "looking for \"^$line_b$\"" 3
 944                 while { ![regexp "^$line_b$" "$line_a"] } {
 945                     verbose "skipping    \"$line_a\"" 3
 946                     if { [gets $file_a line_a] == $eof } {
 947                         set end_1 1
 948                         break
 949                     }
 950                 }
 951                 break
 952             }
 953             if { [gets $file_b line_b] == $eof } {
 954                 set end_2 1
 955                 break
 956             }
 957         }
 958
 959         if { $diff_pass } {
 960             break
 961         } elseif { $end_1 && $end_2 } {
 962             break
 963         } elseif { $end_1 } {
 964             send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
 965             verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
 966             set differences 1
 967             break
 968         } elseif { $end_2 } {
 969             send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
 970             verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
 971             set differences 1
 972             break
 973         } else {
 974             verbose "regexp \"^$line_b$\"\nline   \"$line_a\"" 3
 975             if ![regexp "^$line_b$" "$line_a"] {
 976                 send_log "regexp_diff match failure\n"
 977                 send_log "regexp \"^$line_b$\"\nline   \"$line_a\"\n"
 978                 set differences 1
 979             }
 980         }
 981     }
 982
 983     if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
 984         send_log "$file_1 and $file_2 are different lengths\n"
 985         verbose "$file_1 and $file_2 are different lengths" 3
 986         set differences 1
 987     }
 988
 989     close $file_a
 990     close $file_b
 991
 992     return $differences
 993 }
 994
 995 proc file_contents { filename } {
 996     set file [open $filename r]
 997     set contents [read $file]
 998     close $file
 999     return $contents
1000 }
1001
1002 # List contains test-items with 3 items followed by 2 lists, one item and
1003 # one optional item:
1004 # 0:name 1:ld options 2:assembler options
1005 # 3:filenames of assembler files 4: action and options. 5: name of output file
1006 # 6:compiler flags (optional)
1007
1008 # Actions:
1009 # objdump: Apply objdump options on result.  Compare with regex (last arg).
1010 # nm: Apply nm options on result.  Compare with regex (last arg).
1011 # readelf: Apply readelf options on result.  Compare with regex (last arg).
1012
1013 proc run_ld_link_tests { ldtests } {
1014     global ld
1015     global as
1016     global nm
1017     global objdump
1018     global READELF
1019     global srcdir
1020     global subdir
1021     global env
1022     global CC
1023     global CFLAGS
1024
1025     foreach testitem $ldtests {
1026         set testname [lindex $testitem 0]
1027         set ld_options [lindex $testitem 1]
1028         set as_options [lindex $testitem 2]
1029         set src_files  [lindex $testitem 3]
1030         set actions [lindex $testitem 4]
1031         set binfile tmpdir/[lindex $testitem 5]
1032         set cflags [lindex $testitem 6]
1033         set objfiles {}
1034         set is_unresolved 0
1035         set failed 0
1036
1037 #       verbose -log "Testname is $testname"
1038 #       verbose -log "ld_options is $ld_options"
1039 #       verbose -log "as_options is $as_options"
1040 #       verbose -log "src_files is $src_files"
1041 #       verbose -log "actions is $actions"
1042 #       verbose -log "binfile is $binfile"
1043
1044         # Assemble each file in the test.
1045         foreach src_file $src_files {
1046             set objfile "tmpdir/[file rootname $src_file].o"
1047             lappend objfiles $objfile
1048
1049             if { [file extension $src_file] == ".c" } {
1050                 set as_file "tmpdir/[file rootname $src_file].s"
1051                 if ![ld_compile "$CC -S $CFLAGS $cflags" $srcdir/$subdir/$src_file $as_file] {
1052                     set is_unresolved 1
1053                     break
1054                 }
1055             } else {
1056                 set as_file "$srcdir/$subdir/$src_file"
1057             }
1058             if ![ld_assemble $as "$as_options $as_file" $objfile] {
1059                 set is_unresolved 1
1060                 break
1061             }
1062         }
1063
1064         # Catch assembler errors.
1065         if { $is_unresolved != 0 } {
1066             unresolved $testname
1067             continue
1068         }
1069
1070         if ![ld_simple_link $ld $binfile "-L$srcdir/$subdir $ld_options $objfiles"] {
1071             fail $testname
1072         } else {
1073             set failed 0
1074             foreach actionlist $actions {
1075                 set action [lindex $actionlist 0]
1076                 set progopts [lindex $actionlist 1]
1077
1078                 # There are actions where we run regexp_diff on the
1079                 # output, and there are other actions (presumably).
1080                 # Handling of the former look the same.
1081                 set dump_prog ""
1082                 switch -- $action {
1083                     objdump
1084                         { set dump_prog $objdump }
1085                     nm
1086                         { set dump_prog $nm }
1087                     readelf
1088                         { set dump_prog $READELF }
1089                     default
1090                         {
1091                             perror "Unrecognized action $action"
1092                             set is_unresolved 1
1093                             break
1094                         }
1095                     }
1096
1097                 if { $dump_prog != "" } {
1098                     set dumpfile [lindex $actionlist 2]
1099                     set binary $dump_prog
1100
1101                     # Ensure consistent sorting of symbols
1102                     if {[info exists env(LC_ALL)]} {
1103                         set old_lc_all $env(LC_ALL)
1104                     }
1105                     set env(LC_ALL) "C"
1106                     set cmd "$binary $progopts $binfile > dump.out"
1107                     send_log "$cmd\n"
1108                     catch "exec $cmd" comp_output
1109                     if {[info exists old_lc_all]} {
1110                         set env(LC_ALL) $old_lc_all
1111                     } else {
1112                         unset env(LC_ALL)
1113                     }
1114                     set comp_output [prune_warnings $comp_output]
1115
1116                     if ![string match "" $comp_output] then {
1117                         send_log "$comp_output\n"
1118                         set failed 1
1119                         break
1120                     }
1121
1122                     if { [regexp_diff "dump.out" "$srcdir/$subdir/$dumpfile"] } then {
1123                         verbose "output is [file_contents "dump.out"]" 2
1124                         set failed 1
1125                         break
1126                     }
1127                 }
1128             }
1129
1130             if { $failed != 0 } {
1131                 fail $testname
1132             } else { if { $is_unresolved == 0 } {
1133                 pass $testname
1134             } }
1135         }
1136
1137         # Catch action errors.
1138         if { $is_unresolved != 0 } {
1139             unresolved $testname
1140             continue
1141         }
1142     }
1143 }
1144
1145
1146 proc verbose_eval { expr { level 1 } } {
1147     global verbose
1148     if $verbose>$level then { eval verbose "$expr" $level }
1149 }
1150
1151 # This definition is taken from an unreleased version of DejaGnu.  Once
1152 # that version gets released, and has been out in the world for a few
1153 # months at least, it may be safe to delete this copy.
1154 if ![string length [info proc prune_warnings]] {
1155     #
1156     # prune_warnings -- delete various system verbosities from TEXT
1157     #
1158     # An example is:
1159     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
1160     #
1161     # Sites with particular verbose os's may wish to override this in site.exp.
1162     #
1163     proc prune_warnings { text } {
1164         # This is from sun4's.  Do it for all machines for now.
1165         # The "\\1" is to try to preserve a "\n" but only if necessary.
1166         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
1167
1168         # It might be tempting to get carried away and delete blank lines, etc.
1169         # Just delete *exactly* what we're ask to, and that's it.
1170         return $text
1171     }
1172 }