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