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             lappend sourcefiles "$srcdir/$subdir/$sf"
 682             # Must have asflags indexed on source name.
 683             set asflags($srcdir/$subdir/$sf) $asflags($sf)
 684         }
 685     }
 686
 687     # Time to setup xfailures.
 688     foreach targ $opts(xfail) {
 689         setup_xfail $targ
 690     }
 691
 692     # Assemble each file.
 693     set objfiles {}
 694     for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
 695         set sourcefile [lindex $sourcefiles $i]
 696
 697         set objfile "tmpdir/dump$i.o"
 698         lappend objfiles $objfile
 699         set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
 700
 701         send_log "$cmd\n"
 702         set cmdret [catch "exec $cmd" comp_output]
 703         set comp_output [prune_warnings $comp_output]
 704
 705         # We accept errors at assembly stage too, unless we're supposed to
 706         # link something.
 707         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 708             send_log "$comp_output\n"
 709             verbose "$comp_output" 3
 710             if { $opts(error) != "" && $run_ld == 0 } {
 711                 if [regexp $opts(error) $comp_output] {
 712                     pass $testname
 713                     return
 714                 }
 715             }
 716             fail $testname
 717             return
 718         }
 719     }
 720
 721     # Perhaps link the file(s).
 722     if { $run_ld } {
 723         set objfile "tmpdir/dump"
 724
 725         # Add -L$srcdir/$subdir so that the linker command can use
 726         # linker scripts in the source directory.
 727         set cmd "$LD $LDFLAGS -L$srcdir/$subdir \
 728                    $opts(ld) -o $objfile $objfiles"
 729
 730         send_log "$cmd\n"
 731         set cmdret [catch "exec $cmd" comp_output]
 732         set comp_output [prune_warnings $comp_output]
 733
 734         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 735             verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
 736             send_log "$comp_output\n"
 737             verbose "$comp_output" 3
 738             if { $opts(error) != "" && $run_objcopy == 0 } {
 739                 if [regexp $opts(error) $comp_output] {
 740                     pass $testname
 741                     return
 742                 }
 743             }
 744             fail $testname
 745             return
 746         }
 747
 748         if { $run_objcopy } {
 749             set infile $objfile
 750             set objfile "tmpdir/dump1"
 751
 752             # Note that we don't use OBJCOPYFLAGS here; any flags must be
 753             # explicitly specified.
 754             set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"
 755
 756             send_log "$cmd\n"
 757             set cmdret [catch "exec $cmd" comp_output]
 758             set comp_output [prune_warnings $comp_output]
 759
 760             if { $cmdret != 0 || ![string match "" $comp_output] } then {
 761                 verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
 762                 send_log "$comp_output\n"
 763                 verbose "$comp_output" 3
 764                 if { $opts(error) != "" } {
 765                     if [regexp $opts(error) $comp_output] {
 766                         pass $testname
 767                         return
 768                     }
 769                 }
 770                 fail $testname
 771                 return
 772             }
 773         }
 774     } else {
 775         set objfile "tmpdir/dump0.o"
 776     }
 777
 778     # We must not have expected failure if we get here.
 779     if { $opts(error) != "" } {
 780         fail $testname
 781         return
 782     }
 783
 784     if { [which $binary] == 0 } {
 785         untested $testname
 786         return
 787     }
 788
 789     if { $progopts1 == "" } { set $progopts1 "-r" }
 790     verbose "running $binary $progopts $progopts1" 3
 791
 792     # Objcopy, unlike the other two, won't send its output to stdout,
 793     # so we have to run it specially.
 794     set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
 795     if { $program == "objcopy" } {
 796         set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
 797     }
 798
 799     # Ensure consistent sorting of symbols
 800     if {[info exists env(LC_ALL)]} {
 801         set old_lc_all $env(LC_ALL)
 802     }
 803     set env(LC_ALL) "C"
 804     send_log "$cmd\n"
 805     catch "exec $cmd" comp_output
 806     if {[info exists old_lc_all]} {
 807         set env(LC_ALL) $old_lc_all
 808     } else {
 809         unset env(LC_ALL)
 810     }
 811     set comp_output [prune_warnings $comp_output]
 812     if ![string match "" $comp_output] then {
 813         send_log "$comp_output\n"
 814         fail $testname
 815         return
 816     }
 817
 818     verbose_eval {[file_contents $dumpfile]} 3
 819     if { [regexp_diff $dumpfile "${file}.d"] } then {
 820         fail $testname
 821         verbose "output is [file_contents $dumpfile]" 2
 822         return
 823     }
 824
 825     pass $testname
 826 }
 827
 828 proc slurp_options { file } {
 829     if [catch { set f [open $file r] } x] {
 830         #perror "couldn't open `$file': $x"
 831         perror "$x"
 832         return -1
 833     }
 834     set opt_array {}
 835     # whitespace expression
 836     set ws  {[  ]*}
 837     set nws {[^         ]*}
 838     # whitespace is ignored anywhere except within the options list;
 839     # option names are alphabetic plus underscore only.
 840     set pat "^#${ws}(\[a-zA-Z_\]*)$ws:${ws}(.*)$ws\$"
 841     while { [gets $f line] != -1 } {
 842         set line [string trim $line]
 843         # Whitespace here is space-tab.
 844         if [regexp $pat $line xxx opt_name opt_val] {
 845             # match!
 846             lappend opt_array [list $opt_name $opt_val]
 847         } else {
 848             break
 849         }
 850     }
 851     close $f
 852     return $opt_array
 853 }
 854
 855 # regexp_diff, copied from gas, based on simple_diff above.
 856 #       compares two files line-by-line
 857 #       file1 contains strings, file2 contains regexps and #-comments
 858 #       blank lines are ignored in either file
 859 #       returns non-zero if differences exist
 860 #
 861 proc regexp_diff { file_1 file_2 } {
 862
 863     set eof -1
 864     set end_1 0
 865     set end_2 0
 866     set differences 0
 867     set diff_pass 0
 868
 869     if [file exists $file_1] then {
 870         set file_a [open $file_1 r]
 871     } else {
 872         warning "$file_1 doesn't exist"
 873         return 1
 874     }
 875
 876     if [file exists $file_2] then {
 877         set file_b [open $file_2 r]
 878     } else {
 879         fail "$file_2 doesn't exist"
 880         close $file_a
 881         return 1
 882     }
 883
 884     verbose " Regexp-diff'ing: $file_1 $file_2" 2
 885
 886     while { 1 } {
 887         set line_a ""
 888         set line_b ""
 889         while { [string length $line_a] == 0 } {
 890             if { [gets $file_a line_a] == $eof } {
 891                 set end_1 1
 892                 break
 893             }
 894         }
 895         while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
 896             if [ string match "#pass" $line_b ] {
 897                 set end_2 1
 898                 set diff_pass 1
 899                 break
 900             } elseif [ string match "#..." $line_b ] {
 901                 if { [gets $file_b line_b] == $eof } {
 902                     set end_2 1
 903                     break
 904                 }
 905                 verbose "looking for \"^$line_b$\"" 3
 906                 while { ![regexp "^$line_b$" "$line_a"] } {
 907                     verbose "skipping    \"$line_a\"" 3
 908                     if { [gets $file_a line_a] == $eof } {
 909                         set end_1 1
 910                         break
 911                     }
 912                 }
 913                 break
 914             }
 915             if { [gets $file_b line_b] == $eof } {
 916                 set end_2 1
 917                 break
 918             }
 919         }
 920
 921         if { $diff_pass } {
 922             break
 923         } elseif { $end_1 && $end_2 } {
 924             break
 925         } elseif { $end_1 } {
 926             send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
 927             verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
 928             set differences 1
 929             break
 930         } elseif { $end_2 } {
 931             send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
 932             verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
 933             set differences 1
 934             break
 935         } else {
 936             verbose "regexp \"^$line_b$\"\nline   \"$line_a\"" 3
 937             if ![regexp "^$line_b$" "$line_a"] {
 938                 send_log "regexp_diff match failure\n"
 939                 send_log "regexp \"^$line_b$\"\nline   \"$line_a\"\n"
 940                 set differences 1
 941             }
 942         }
 943     }
 944
 945     if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
 946         send_log "$file_1 and $file_2 are different lengths\n"
 947         verbose "$file_1 and $file_2 are different lengths" 3
 948         set differences 1
 949     }
 950
 951     close $file_a
 952     close $file_b
 953
 954     return $differences
 955 }
 956
 957 proc file_contents { filename } {
 958     set file [open $filename r]
 959     set contents [read $file]
 960     close $file
 961     return $contents
 962 }
 963
 964 proc verbose_eval { expr { level 1 } } {
 965     global verbose
 966     if $verbose>$level then { eval verbose "$expr" $level }
 967 }
 968
 969 # This definition is taken from an unreleased version of DejaGnu.  Once
 970 # that version gets released, and has been out in the world for a few
 971 # months at least, it may be safe to delete this copy.
 972 if ![string length [info proc prune_warnings]] {
 973     #
 974     # prune_warnings -- delete various system verbosities from TEXT
 975     #
 976     # An example is:
 977     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
 978     #
 979     # Sites with particular verbose os's may wish to override this in site.exp.
 980     #
 981     proc prune_warnings { text } {
 982         # This is from sun4's.  Do it for all machines for now.
 983         # The "\\1" is to try to preserve a "\n" but only if necessary.
 984         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
 985
 986         # It might be tempting to get carried away and delete blank lines, etc.
 987         # Just delete *exactly* what we're ask to, and that's it.
 988         return $text
 989     }
 990 }