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