ld/testsuite/lib/ld-lib.exp

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