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 #    2004, 2005, 2006 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # Extract and print the version number of ld.
  20 #
  21 proc default_ld_version { ld } {
  22     global host_triplet
  23
  24     if { [which $ld] == 0 } then {
  25         perror "$ld does not exist"
  26         exit 1
  27     }
  28
  29     catch "exec $ld --version" tmp
  30     set tmp [prune_warnings $tmp]
  31     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number
  32     if [info exists number] then {
  33         clone_output "$ld $number\n"
  34     }
  35 }
  36
  37 # Link an object using relocation.
  38 #
  39 proc default_ld_relocate { ld target objects } {
  40     global HOSTING_EMU
  41     global host_triplet
  42
  43     if { [which $ld] == 0 } then {
  44         perror "$ld does not exist"
  45         return 0
  46     }
  47
  48     verbose -log "$ld $HOSTING_EMU -o $target -r $objects"
  49
  50     catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
  51     set exec_output [prune_warnings $exec_output]
  52     if [string match "" $exec_output] then {
  53         return 1
  54     } else {
  55         verbose -log "$exec_output"
  56         return 0
  57     }
  58 }
  59
  60 # Check to see if ld is being invoked with a non-endian output format
  61 #
  62 proc is_endian_output_format { object_flags } {
  63
  64     if {[string match "*-oformat binary*" $object_flags] ||      \
  65         [string match "*-oformat ieee*" $object_flags] ||        \
  66         [string match "*-oformat ihex*" $object_flags] ||        \
  67         [string match "*-oformat netbsd-core*" $object_flags] || \
  68         [string match "*-oformat srec*" $object_flags] ||        \
  69         [string match "*-oformat tekhex*" $object_flags] ||      \
  70         [string match "*-oformat trad-core*" $object_flags] } then {
  71         return 0
  72     } else {
  73         return 1
  74     }
  75 }
  76
  77 # Look for big-endian or little-endian switches in the multlib
  78 # options and translate these into a -EB or -EL switch.  Note
  79 # we cannot rely upon proc process_multilib_options to do this
  80 # for us because for some targets the compiler does not support
  81 # -EB/-EL but it does support -mbig-endian/-mlittle-endian, and
  82 # the site.exp file will include the switch "-mbig-endian"
  83 # (rather than "big-endian") which is not detected by proc
  84 # process_multilib_options.
  85 #
  86 proc big_or_little_endian {} {
  87
  88     if [board_info [target_info name] exists multilib_flags] {
  89         set tmp_flags " [board_info [target_info name] multilib_flags]"
  90
  91         foreach x $tmp_flags {
  92             case $x in {
  93                 {*big*endian eb EB -eb -EB -mb} {
  94                     set flags " -EB"
  95                     return $flags
  96                 }
  97                 {*little*endian el EL -el -EL -ml} {
  98                     set flags " -EL"
  99                     return $flags
 100                 }
 101             }
 102         }
 103     }
 104
 105     set flags ""
 106     return $flags
 107 }
 108
 109 # Link a program using ld.
 110 #
 111 proc default_ld_link { ld target objects } {
 112     global HOSTING_EMU
 113     global HOSTING_CRT0
 114     global HOSTING_LIBS
 115     global LIBS
 116     global host_triplet
 117     global link_output
 118
 119     set objs "$HOSTING_CRT0 $objects"
 120     set libs "$LIBS $HOSTING_LIBS"
 121
 122     if { [which $ld] == 0 } then {
 123         perror "$ld does not exist"
 124         return 0
 125     }
 126
 127     if [is_endian_output_format $objects] then {
 128         set flags [big_or_little_endian]
 129     } else {
 130         set flags ""
 131     }
 132     verbose -log "$ld $HOSTING_EMU $flags -o $target $objs $libs"
 133
 134     catch "exec $ld $HOSTING_EMU $flags -o $target $objs $libs" link_output
 135     set exec_output [prune_warnings $link_output]
 136     if [string match "" $link_output] then {
 137         return 1
 138     } else {
 139         verbose -log "$link_output"
 140         return 0
 141     }
 142 }
 143
 144 # Link a program using ld, without including any libraries.
 145 #
 146 proc default_ld_simple_link { ld target objects } {
 147     global host_triplet
 148     global link_output
 149     global gcc_ld_flag
 150
 151     if { [which $ld] == 0 } then {
 152         perror "$ld does not exist"
 153         return 0
 154     }
 155
 156     if [is_endian_output_format $objects] then {
 157         set flags [big_or_little_endian]
 158     } else {
 159         set flags ""
 160     }
 161
 162     # If we are compiling with gcc, we want to add gcc_ld_flag to
 163     # flags.  Rather than determine this in some complex way, we guess
 164     # based on the name of the compiler.
 165     set ldexe $ld
 166     set ldparm [string first " " $ld]
 167     if { $ldparm > 0 } then {
 168         set ldexe [string range $ld 0 $ldparm]
 169     }
 170     set ldexe [string replace $ldexe 0 [string last "/" $ldexe] ""]
 171     if {[string match "*gcc*" $ldexe] || [string match "*++*" $ldexe]} then {
 172         set flags "$gcc_ld_flag $flags"
 173     }
 174
 175     verbose -log "$ld $flags -o $target $objects"
 176
 177     catch "exec $ld $flags -o $target $objects" link_output
 178     set exec_output [prune_warnings $link_output]
 179
 180     # We don't care if we get a warning about a non-existent start
 181     # symbol, since the default linker script might use ENTRY.
 182     regsub -all "(^|\n)(\[^\n\]*: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
 183
 184     if [string match "" $exec_output] then {
 185         return 1
 186     } else {
 187         verbose -log "$exec_output"
 188         return 0
 189     }
 190 }
 191
 192 # Compile an object using cc.
 193 #
 194 proc default_ld_compile { cc source object } {
 195     global CFLAGS
 196     global srcdir
 197     global subdir
 198     global host_triplet
 199     global gcc_gas_flag
 200
 201     set cc_prog $cc
 202     if {[llength $cc_prog] > 1} then {
 203         set cc_prog [lindex $cc_prog 0]
 204     }
 205     if {[which $cc_prog] == 0} then {
 206         perror "$cc_prog does not exist"
 207         return 0
 208     }
 209
 210     catch "exec rm -f $object" exec_output
 211
 212     set flags "-I$srcdir/$subdir $CFLAGS"
 213
 214     # If we are compiling with gcc, we want to add gcc_gas_flag to
 215     # flags.  Rather than determine this in some complex way, we guess
 216     # based on the name of the compiler.
 217     set ccexe $cc
 218     set ccparm [string first " " $cc]
 219     set ccflags ""
 220     if { $ccparm > 0 } then {
 221         set ccflags [string range $cc $ccparm end]
 222         set ccexe [string range $cc 0 $ccparm]
 223         set cc $ccexe
 224     }
 225     set ccexe [string replace $ccexe 0 [string last "/" $ccexe] ""]
 226     if {[string match "*gcc*" $ccexe] || [string match "*++*" $ccexe]} then {
 227         set flags "$gcc_gas_flag $flags"
 228     }
 229
 230     if [board_info [target_info name] exists multilib_flags] {
 231         append flags " [board_info [target_info name] multilib_flags]"
 232     }
 233
 234     verbose -log "$cc $flags $ccflags -c $source -o $object"
 235
 236     catch "exec $cc $flags $ccflags -c $source -o $object" exec_output
 237     set exec_output [prune_warnings $exec_output]
 238     if [string match "" $exec_output] then {
 239         if {![file exists $object]} then {
 240             regexp ".*/(\[^/\]*)$" $source all dobj
 241             regsub "\\.c" $dobj ".o" realobj
 242             verbose "looking for $realobj"
 243             if {[file exists $realobj]} then {
 244                 verbose -log "mv $realobj $object"
 245                 catch "exec mv $realobj $object" exec_output
 246                 set exec_output [prune_warnings $exec_output]
 247                 if {![string match "" $exec_output]} then {
 248                     verbose -log "$exec_output"
 249                     perror "could not move $realobj to $object"
 250                     return 0
 251                 }
 252             } else {
 253                 perror "$object not found after compilation"
 254                 return 0
 255             }
 256         }
 257         return 1
 258     } else {
 259         verbose -log "$exec_output"
 260         perror "$source: compilation failed"
 261         return 0
 262     }
 263 }
 264
 265 # Assemble a file.
 266 #
 267 proc default_ld_assemble { as source object } {
 268     global ASFLAGS
 269     global host_triplet
 270
 271     if {[which $as] == 0} then {
 272         perror "$as does not exist"
 273         return 0
 274     }
 275
 276     if ![info exists ASFLAGS] { set ASFLAGS "" }
 277
 278     set flags [big_or_little_endian]
 279
 280     verbose -log "$as $flags $ASFLAGS -o $object $source"
 281
 282     catch "exec $as $flags $ASFLAGS -o $object $source" exec_output
 283     set exec_output [prune_warnings $exec_output]
 284     if [string match "" $exec_output] then {
 285         return 1
 286     } else {
 287         verbose -log "$exec_output"
 288         perror "$source: assembly failed"
 289         return 0
 290     }
 291 }
 292
 293 # Run nm on a file, putting the result in the array nm_output.
 294 #
 295 proc default_ld_nm { nm nmflags object } {
 296     global NMFLAGS
 297     global nm_output
 298     global host_triplet
 299
 300     if {[which $nm] == 0} then {
 301         perror "$nm does not exist"
 302         return 0
 303     }
 304
 305     if {[info exists nm_output]} {
 306       unset nm_output
 307     }
 308
 309     if ![info exists NMFLAGS] { set NMFLAGS "" }
 310
 311     # Ensure consistent sorting of symbols
 312     if {[info exists env(LC_ALL)]} {
 313         set old_lc_all $env(LC_ALL)
 314     }
 315     set env(LC_ALL) "C"
 316     verbose -log "$nm $NMFLAGS $nmflags $object >tmpdir/nm.out"
 317
 318     catch "exec $nm $NMFLAGS $nmflags $object >tmpdir/nm.out" exec_output
 319     if {[info exists old_lc_all]} {
 320         set env(LC_ALL) $old_lc_all
 321     } else {
 322         unset env(LC_ALL)
 323     }
 324     set exec_output [prune_warnings $exec_output]
 325     if [string match "" $exec_output] then {
 326         set file [open tmpdir/nm.out r]
 327         while { [gets $file line] != -1 } {
 328             verbose "$line" 2
 329             if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] \\.*(.+)$" $line whole value name] {
 330                 set name [string trimleft $name "_"]
 331                 verbose "Setting nm_output($name) to 0x$value" 2
 332                 set nm_output($name) 0x$value
 333             }
 334         }
 335         close $file
 336         return 1
 337     } else {
 338         verbose -log "$exec_output"
 339         perror "$object: nm failed"
 340         return 0
 341     }
 342 }
 343
 344 # True if the object format is known to be ELF.
 345 #
 346 proc is_elf_format {} {
 347     if { ![istarget *-*-sysv4*] \
 348          && ![istarget *-*-unixware*] \
 349          && ![istarget *-*-elf*] \
 350          && ![istarget *-*-eabi*] \
 351          && ![istarget hppa*64*-*-hpux*] \
 352          && ![istarget *-*-linux*] \
 353          && ![istarget frv-*-uclinux*] \
 354          && ![istarget *-*-irix5*] \
 355          && ![istarget *-*-irix6*] \
 356          && ![istarget *-*-netbsd*] \
 357          && ![istarget *-*-solaris2*] } {
 358         return 0
 359     }
 360
 361     if { [istarget *-*-linux*aout*] \
 362          || [istarget *-*-linux*oldld*] } {
 363         return 0
 364     }
 365
 366     if { ![istarget *-*-netbsdelf*] \
 367          && ([istarget *-*-netbsd*aout*] \
 368              || [istarget *-*-netbsdpe*] \
 369              || [istarget arm*-*-netbsd*] \
 370              || [istarget sparc-*-netbsd*] \
 371              || [istarget i*86-*-netbsd*] \
 372              || [istarget m68*-*-netbsd*] \
 373              || [istarget vax-*-netbsd*] \
 374              || [istarget ns32k-*-netbsd*]) } {
 375         return 0
 376     }
 377     return 1
 378 }
 379
 380 # True if the object format is known to be 64-bit ELF.
 381 #
 382 proc is_elf64 { binary_file } {
 383     global READELF
 384     global READELFFLAGS
 385
 386     set readelf_size ""
 387     catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got
 388
 389     if ![string match "" $got] then {
 390         return 0
 391     }
 392
 393     if { ![regexp "\n\[ \]*Class:\[ \]*ELF(\[0-9\]+)\n" \
 394            [file_contents readelf.out] nil readelf_size] } {
 395         return 0
 396     }
 397
 398     if { $readelf_size == "64" } {
 399         return 1
 400     }
 401
 402     return 0
 403 }
 404
 405 # True if the object format is known to be a.out.
 406 #
 407 proc is_aout_format {} {
 408     if { [istarget *-*-*\[ab\]out*] \
 409              || [istarget *-*-linux*oldld*] \
 410              || [istarget *-*-msdos*] \
 411              || [istarget arm-*-netbsd] \
 412              || [istarget i?86-*-netbsd] \
 413              || [istarget i?86-*-mach*] \
 414              || [istarget i?86-*-vsta] \
 415              || [istarget pdp11-*-*] \
 416              || [istarget m68*-ericsson-ose] \
 417              || [istarget m68k-hp-bsd*] \
 418              || [istarget m68*-*-hpux*] \
 419              || [istarget m68*-*-netbsd] \
 420              || [istarget m68*-*-netbsd*4k*] \
 421              || [istarget m68k-sony-*] \
 422              || [istarget m68*-sun-sunos\[34\]*] \
 423              || [istarget m68*-wrs-vxworks*] \
 424              || [istarget ns32k-*-*] \
 425              || [istarget sparc*-*-netbsd] \
 426              || [istarget sparc-sun-sunos4*] \
 427              || [istarget vax-dec-ultrix*] \
 428              || [istarget vax-*-netbsd] } {
 429         return 1
 430     }
 431     return 0
 432 }
 433
 434 # True if the object format is known to be PE COFF.
 435 #
 436 proc is_pecoff_format {} {
 437     if { ![istarget *-*-mingw32*] \
 438          && ![istarget *-*-cygwin*] \
 439          && ![istarget *-*-pe*] } {
 440         return 0
 441     }
 442
 443     return 1
 444 }
 445
 446 # Compares two files line-by-line.
 447 #   Returns differences if exist.
 448 #   Returns null if file(s) cannot be opened.
 449 #
 450 proc simple_diff { file_1 file_2 } {
 451     global target
 452
 453     set eof -1
 454     set differences 0
 455
 456     if [file exists $file_1] then {
 457         set file_a [open $file_1 r]
 458     } else {
 459         warning "$file_1 doesn't exist"
 460         return
 461     }
 462
 463     if [file exists $file_2] then {
 464         set file_b [open $file_2 r]
 465     } else {
 466         fail "$file_2 doesn't exist"
 467         return
 468     }
 469
 470     verbose "# Diff'ing: $file_1 $file_2\n" 2
 471
 472     while { [gets $file_a line] != $eof } {
 473         if [regexp "^#.*$" $line] then {
 474             continue
 475         } else {
 476             lappend list_a $line
 477         }
 478     }
 479     close $file_a
 480
 481     while { [gets $file_b line] != $eof } {
 482         if [regexp "^#.*$" $line] then {
 483             continue
 484         } else {
 485             lappend list_b $line
 486         }
 487     }
 488     close $file_b
 489
 490     for { set i 0 } { $i < [llength $list_a] } { incr i } {
 491         set line_a [lindex $list_a $i]
 492         set line_b [lindex $list_b $i]
 493
 494         verbose "\t$file_1: $i: $line_a\n" 3
 495         verbose "\t$file_2: $i: $line_b\n" 3
 496         if [string compare $line_a $line_b] then {
 497             verbose -log "\t$file_1: $i: $line_a\n"
 498             verbose -log "\t$file_2: $i: $line_b\n"
 499
 500             fail "Test: $target"
 501             return
 502         }
 503     }
 504
 505     if { [llength $list_a] != [llength $list_b] } {
 506         fail "Test: $target"
 507         return
 508     }
 509
 510     if $differences<1 then {
 511         pass "Test: $target"
 512     }
 513 }
 514
 515 # run_dump_test FILE
 516 # Copied from gas testsuite, tweaked and further extended.
 517 #
 518 # Assemble a .s file, then run some utility on it and check the output.
 519 #
 520 # There should be an assembly language file named FILE.s in the test
 521 # suite directory, and a pattern file called FILE.d.  `run_dump_test'
 522 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
 523 # `nm' on the .o file to produce textual output, and then analyze that
 524 # with regexps.  The FILE.d file specifies what program to run, and
 525 # what to expect in its output.
 526 #
 527 # The FILE.d file begins with zero or more option lines, which specify
 528 # flags to pass to the assembler, the program to run to dump the
 529 # assembler's output, and the options it wants.  The option lines have
 530 # the syntax:
 531 #
 532 #         # OPTION: VALUE
 533 #
 534 # OPTION is the name of some option, like "name" or "objdump", and
 535 # VALUE is OPTION's value.  The valid options are described below.
 536 # Whitespace is ignored everywhere, except within VALUE.  The option
 537 # list ends with the first line that doesn't match the above syntax
 538 # (hmm, not great for error detection).
 539 #
 540 # The interesting options are:
 541 #
 542 #   name: TEST-NAME
 543 #       The name of this test, passed to DejaGNU's `pass' and `fail'
 544 #       commands.  If omitted, this defaults to FILE, the root of the
 545 #       .s and .d files' names.
 546 #
 547 #   as: FLAGS
 548 #       When assembling, pass FLAGS to the assembler.
 549 #       If assembling several files, you can pass different assembler
 550 #       options in the "source" directives.  See below.
 551 #
 552 #   ld: FLAGS
 553 #       Link assembled files using FLAGS, in the order of the "source"
 554 #       directives, when using multiple files.
 555 #
 556 #   objcopy_linked_file: FLAGS
 557 #       Run objcopy on the linked file with the specified flags.
 558 #       This lets you transform the linked file using objcopy, before the
 559 #       result is analyzed by an analyzer program specified below (which
 560 #       may in turn *also* be objcopy).
 561 #
 562 #   PROG: PROGRAM-NAME
 563 #       The name of the program to run to analyze the .o file produced
 564 #       by the assembler or the linker output.  This can be omitted;
 565 #       run_dump_test will guess which program to run by seeing which of
 566 #       the flags options below is present.
 567 #
 568 #   objdump: FLAGS
 569 #   nm: FLAGS
 570 #   objcopy: FLAGS
 571 #       Use the specified program to analyze the assembler or linker
 572 #       output file, and pass it FLAGS, in addition to the output name.
 573 #       Note that they are run with LC_ALL=C in the environment to give
 574 #       consistent sorting of symbols.
 575 #
 576 #   source: SOURCE [FLAGS]
 577 #       Assemble the file SOURCE.s using the flags in the "as" directive
 578 #       and the (optional) FLAGS.  If omitted, the source defaults to
 579 #       FILE.s.
 580 #       This is useful if several .d files want to share a .s file.
 581 #       More than one "source" directive can be given, which is useful
 582 #       when testing linking.
 583 #
 584 #   xfail: TARGET
 585 #       The test is expected to fail on TARGET.  This may occur more than
 586 #       once.
 587 #
 588 #   target: TARGET
 589 #       Only run the test for TARGET.  This may occur more than once; the
 590 #       target being tested must match at least one.
 591 #
 592 #   notarget: TARGET
 593 #       Do not run the test for TARGET.  This may occur more than once;
 594 #       the target being tested must not match any of them.
 595 #
 596 #   error: REGEX
 597 #       An error with message matching REGEX must be emitted for the test
 598 #       to pass.  The PROG, objdump, nm and objcopy options have no
 599 #       meaning and need not supplied if this is present.
 600 #
 601 #   warning: REGEX
 602 #       Expect a linker warning matching REGEX.  It is an error to issue
 603 #       both "error" and "warning".
 604 #
 605 # Each option may occur at most once unless otherwise mentioned.
 606 #
 607 # After the option lines come regexp lines.  `run_dump_test' calls
 608 # `regexp_diff' to compare the output of the dumping tool against the
 609 # regexps in FILE.d.  `regexp_diff' is defined later in this file; see
 610 # further comments there.
 611 #
 612 proc run_dump_test { name } {
 613     global subdir srcdir
 614     global OBJDUMP NM AS OBJCOPY READELF LD
 615     global OBJDUMPFLAGS NMFLAGS ASFLAGS OBJCOPYFLAGS READELFFLAGS LDFLAGS
 616     global host_triplet runtests
 617     global env
 618
 619     if [string match "*/*" $name] {
 620         set file $name
 621         set name [file tail $name]
 622     } else {
 623         set file "$srcdir/$subdir/$name"
 624     }
 625
 626     if ![runtest_file_p $runtests $name] then {
 627         return
 628     }
 629
 630     set opt_array [slurp_options "${file}.d"]
 631     if { $opt_array == -1 } {
 632         perror "error reading options from $file.d"
 633         unresolved $subdir/$name
 634         return
 635     }
 636     set dumpfile tmpdir/dump.out
 637     set run_ld 0
 638     set run_objcopy 0
 639     set opts(as) {}
 640     set opts(ld) {}
 641     set opts(xfail) {}
 642     set opts(target) {}
 643     set opts(notarget) {}
 644     set opts(objdump) {}
 645     set opts(nm) {}
 646     set opts(objcopy) {}
 647     set opts(readelf) {}
 648     set opts(name) {}
 649     set opts(PROG) {}
 650     set opts(source) {}
 651     set opts(error) {}
 652     set opts(warning) {}
 653     set opts(objcopy_linked_file) {}
 654     set asflags(${file}.s) {}
 655
 656     foreach i $opt_array {
 657         set opt_name [lindex $i 0]
 658         set opt_val [lindex $i 1]
 659         if ![info exists opts($opt_name)] {
 660             perror "unknown option $opt_name in file $file.d"
 661             unresolved $subdir/$name
 662             return
 663         }
 664
 665         switch -- $opt_name {
 666             xfail {}
 667             target {}
 668             notarget {}
 669             source {
 670                 # Move any source-specific as-flags to a separate array to
 671                 # simplify processing.
 672                 if { [llength $opt_val] > 1 } {
 673                     set asflags([lindex $opt_val 0]) [lrange $opt_val 1 end]
 674                     set opt_val [lindex $opt_val 0]
 675                 } else {
 676                     set asflags($opt_val) {}
 677                 }
 678             }
 679             default {
 680                 if [string length $opts($opt_name)] {
 681                     perror "option $opt_name multiply set in $file.d"
 682                     unresolved $subdir/$name
 683                     return
 684                 }
 685
 686                 # A single "# ld:" with no options should do the right thing.
 687                 if { $opt_name == "ld" } {
 688                     set run_ld 1
 689                 }
 690                 # Likewise objcopy_linked_file.
 691                 if { $opt_name == "objcopy_linked_file" } {
 692                     set run_objcopy 1
 693                 }
 694             }
 695         }
 696         set opts($opt_name) [concat $opts($opt_name) $opt_val]
 697     }
 698
 699     # Decide early whether we should run the test for this target.
 700     if { [llength $opts(target)] > 0 } {
 701         set targmatch 0
 702         foreach targ $opts(target) {
 703             if [istarget $targ] {
 704                 set targmatch 1
 705                 break
 706             }
 707         }
 708         if { $targmatch == 0 } {
 709             return
 710         }
 711     }
 712     foreach targ $opts(notarget) {
 713         if [istarget $targ] {
 714             return
 715         }
 716     }
 717
 718     set program ""
 719     # It's meaningless to require an output-testing method when we
 720     # expect an error.
 721     if { $opts(error) == "" } {
 722         if {$opts(PROG) != ""} {
 723             switch -- $opts(PROG) {
 724                 objdump { set program objdump }
 725                 nm      { set program nm }
 726                 objcopy { set program objcopy }
 727                 readelf { set program readelf }
 728                 default
 729                 { perror "unrecognized program option $opts(PROG) in $file.d"
 730                   unresolved $subdir/$name
 731                   return }
 732             }
 733         } else {
 734         # Guess which program to run, by seeing which option was specified.
 735             foreach p {objdump objcopy nm readelf} {
 736                 if {$opts($p) != ""} {
 737                     if {$program != ""} {
 738                         perror "ambiguous dump program in $file.d"
 739                         unresolved $subdir/$name
 740                         return
 741                     } else {
 742                         set program $p
 743                     }
 744                 }
 745             }
 746         }
 747         if { $program == "" && $opts(warning) == "" } {
 748             perror "dump program unspecified in $file.d"
 749             unresolved $subdir/$name
 750             return
 751         }
 752     }
 753
 754     if { $opts(name) == "" } {
 755         set testname "$subdir/$name"
 756     } else {
 757         set testname $opts(name)
 758     }
 759
 760     if { $opts(source) == "" } {
 761         set sourcefiles [list ${file}.s]
 762     } else {
 763         set sourcefiles {}
 764         foreach sf $opts(source) {
 765             if { [string match "/*" $sf] } {
 766                 lappend sourcefiles "$sf"
 767             } else {
 768                 lappend sourcefiles "$srcdir/$subdir/$sf"
 769             }
 770             # Must have asflags indexed on source name.
 771             set asflags($srcdir/$subdir/$sf) $asflags($sf)
 772         }
 773     }
 774
 775     # Time to setup xfailures.
 776     foreach targ $opts(xfail) {
 777         setup_xfail $targ
 778     }
 779
 780     # Assemble each file.
 781     set objfiles {}
 782     for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
 783         set sourcefile [lindex $sourcefiles $i]
 784
 785         set objfile "tmpdir/dump$i.o"
 786         lappend objfiles $objfile
 787         set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
 788
 789         send_log "$cmd\n"
 790         set cmdret [catch "exec $cmd" comp_output]
 791         set comp_output [prune_warnings $comp_output]
 792
 793         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 794             send_log "$comp_output\n"
 795             verbose "$comp_output" 3
 796
 797             set exitstat "succeeded"
 798             if { $cmdret != 0 } { set exitstat "failed" }
 799             verbose -log "$exitstat with: <$comp_output>"
 800             fail $testname
 801             return
 802         }
 803     }
 804
 805     set expmsg $opts(error)
 806     if { $opts(warning) != "" } {
 807         if { $expmsg != "" } {
 808             perror "$testname: mixing error and warning test-directives"
 809             return
 810         }
 811         set expmsg $opts(warning)
 812     }
 813
 814     # Perhaps link the file(s).
 815     if { $run_ld } {
 816         set objfile "tmpdir/dump"
 817
 818         # Add -L$srcdir/$subdir so that the linker command can use
 819         # linker scripts in the source directory.
 820         set cmd "$LD $LDFLAGS -L$srcdir/$subdir \
 821                    $opts(ld) -o $objfile $objfiles"
 822
 823         send_log "$cmd\n"
 824         set cmdret [catch "exec $cmd" comp_output]
 825         set comp_output [prune_warnings $comp_output]
 826
 827         if { $cmdret != 0 } then {
 828             # If the executed program writes to stderr and stderr is not
 829             # redirected, exec *always* returns failure, regardless of the
 830             # program exit code.  Thankfully, we can retrieve the true
 831             # return status from a special variable.  Redirection would
 832             # cause a Tcl-specific message to be appended, and we'd rather
 833             # not deal with that if we can help it.
 834             global errorCode
 835             if { [lindex $errorCode 0] == "NONE" } {
 836                 set cmdret 0
 837             }
 838         }
 839
 840         if { $cmdret == 0 && $run_objcopy } {
 841             set infile $objfile
 842             set objfile "tmpdir/dump1"
 843
 844             # Note that we don't use OBJCOPYFLAGS here; any flags must be
 845             # explicitly specified.
 846             set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"
 847
 848             send_log "$cmd\n"
 849             set cmdret [catch "exec $cmd" comp_output]
 850             append comp_output [prune_warnings $comp_output]
 851
 852             if { $cmdret != 0 } then {
 853                 global errorCode
 854                 if { [lindex $errorCode 0] == "NONE" } {
 855                     set cmdret 0
 856                 }
 857             }
 858         }
 859
 860         if { $cmdret != 0 || $comp_output != "" || $expmsg != "" } then {
 861             set exitstat "succeeded"
 862             if { $cmdret != 0 } { set exitstat "failed" }
 863             verbose -log "$exitstat with: <$comp_output>, expected: <$expmsg>"
 864             send_log "$comp_output\n"
 865             verbose "$comp_output" 3
 866
 867             if { [regexp $expmsg $comp_output] \
 868                     && (($cmdret == 0) == ($opts(warning) != "")) } {
 869                 # We have the expected output from ld.
 870                 if { $opts(error) != "" || $program == "" } {
 871                     pass $testname
 872                     return
 873                 }
 874             } else {
 875                 verbose -log "$exitstat with: <$comp_output>, expected: <$expmsg>"
 876                 fail $testname
 877                 return
 878             }
 879         }
 880     } else {
 881         set objfile "tmpdir/dump0.o"
 882     }
 883
 884     # We must not have expected failure if we get here.
 885     if { $opts(error) != "" } {
 886         fail $testname
 887         return
 888     }
 889
 890     set progopts1 $opts($program)
 891     eval set progopts \$[string toupper $program]FLAGS
 892     eval set binary \$[string toupper $program]
 893
 894     if { [which $binary] == 0 } {
 895         untested $testname
 896         return
 897     }
 898
 899     if { $progopts1 == "" } { set $progopts1 "-r" }
 900     verbose "running $binary $progopts $progopts1" 3
 901
 902     # Objcopy, unlike the other two, won't send its output to stdout,
 903     # so we have to run it specially.
 904     set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
 905     if { $program == "objcopy" } {
 906         set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
 907     }
 908
 909     # Ensure consistent sorting of symbols
 910     if {[info exists env(LC_ALL)]} {
 911         set old_lc_all $env(LC_ALL)
 912     }
 913     set env(LC_ALL) "C"
 914     send_log "$cmd\n"
 915     catch "exec $cmd" comp_output
 916     if {[info exists old_lc_all]} {
 917         set env(LC_ALL) $old_lc_all
 918     } else {
 919         unset env(LC_ALL)
 920     }
 921     set comp_output [prune_warnings $comp_output]
 922     if ![string match "" $comp_output] then {
 923         send_log "$comp_output\n"
 924         fail $testname
 925         return
 926     }
 927
 928     verbose_eval {[file_contents $dumpfile]} 3
 929     if { [regexp_diff $dumpfile "${file}.d"] } then {
 930         fail $testname
 931         verbose "output is [file_contents $dumpfile]" 2
 932         return
 933     }
 934
 935     pass $testname
 936 }
 937
 938 proc slurp_options { file } {
 939     if [catch { set f [open $file r] } x] {
 940         #perror "couldn't open `$file': $x"
 941         perror "$x"
 942         return -1
 943     }
 944     set opt_array {}
 945     # whitespace expression
 946     set ws  {[  ]*}
 947     set nws {[^         ]*}
 948     # whitespace is ignored anywhere except within the options list;
 949     # option names are alphabetic plus underscore only.
 950     set pat "^#${ws}(\[a-zA-Z_\]*)$ws:${ws}(.*)$ws\$"
 951     while { [gets $f line] != -1 } {
 952         set line [string trim $line]
 953         # Whitespace here is space-tab.
 954         if [regexp $pat $line xxx opt_name opt_val] {
 955             # match!
 956             lappend opt_array [list $opt_name $opt_val]
 957         } else {
 958             break
 959         }
 960     }
 961     close $f
 962     return $opt_array
 963 }
 964
 965 # regexp_diff, copied from gas, based on simple_diff above.
 966 #       compares two files line-by-line
 967 #       file1 contains strings, file2 contains regexps and #-comments
 968 #       blank lines are ignored in either file
 969 #       returns non-zero if differences exist
 970 #
 971 proc regexp_diff { file_1 file_2 } {
 972
 973     set eof -1
 974     set end_1 0
 975     set end_2 0
 976     set differences 0
 977     set diff_pass 0
 978
 979     if [file exists $file_1] then {
 980         set file_a [open $file_1 r]
 981     } else {
 982         warning "$file_1 doesn't exist"
 983         return 1
 984     }
 985
 986     if [file exists $file_2] then {
 987         set file_b [open $file_2 r]
 988     } else {
 989         fail "$file_2 doesn't exist"
 990         close $file_a
 991         return 1
 992     }
 993
 994     verbose " Regexp-diff'ing: $file_1 $file_2" 2
 995
 996     while { 1 } {
 997         set line_a ""
 998         set line_b ""
 999         while { [string length $line_a] == 0 } {
1000             if { [gets $file_a line_a] == $eof } {
1001                 set end_1 1
1002                 break
1003             }
1004         }
1005         while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
1006             if [ string match "#pass" $line_b ] {
1007                 set end_2 1
1008                 set diff_pass 1
1009                 break
1010             } elseif [ string match "#..." $line_b ] {
1011                 if { [gets $file_b line_b] == $eof } {
1012                     set end_2 1
1013                     set diff_pass 1
1014                     break
1015                 }
1016                 verbose "looking for \"^$line_b$\"" 3
1017                 while { ![regexp "^$line_b$" "$line_a"] } {
1018                     verbose "skipping    \"$line_a\"" 3
1019                     if { [gets $file_a line_a] == $eof } {
1020                         set end_1 1
1021                         break
1022                     }
1023                 }
1024                 break
1025             }
1026             if { [gets $file_b line_b] == $eof } {
1027                 set end_2 1
1028                 break
1029             }
1030         }
1031
1032         if { $diff_pass } {
1033             break
1034         } elseif { $end_1 && $end_2 } {
1035             break
1036         } elseif { $end_1 } {
1037             send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
1038             verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
1039             set differences 1
1040             break
1041         } elseif { $end_2 } {
1042             send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
1043             verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
1044             set differences 1
1045             break
1046         } else {
1047             verbose "regexp \"^$line_b$\"\nline   \"$line_a\"" 3
1048             if ![regexp "^$line_b$" "$line_a"] {
1049                 send_log "regexp_diff match failure\n"
1050                 send_log "regexp \"^$line_b$\"\nline   \"$line_a\"\n"
1051                 set differences 1
1052             }
1053         }
1054     }
1055
1056     if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
1057         send_log "$file_1 and $file_2 are different lengths\n"
1058         verbose "$file_1 and $file_2 are different lengths" 3
1059         set differences 1
1060     }
1061
1062     close $file_a
1063     close $file_b
1064
1065     return $differences
1066 }
1067
1068 proc file_contents { filename } {
1069     set file [open $filename r]
1070     set contents [read $file]
1071     close $file
1072     return $contents
1073 }
1074
1075 # List contains test-items with 3 items followed by 2 lists, one item and
1076 # one optional item:
1077 # 0:name 1:ld options 2:assembler options
1078 # 3:filenames of assembler files 4: action and options. 5: name of output file
1079 # 6:compiler flags (optional)
1080 #
1081 # Actions:
1082 # objdump: Apply objdump options on result.  Compare with regex (last arg).
1083 # nm: Apply nm options on result.  Compare with regex (last arg).
1084 # readelf: Apply readelf options on result.  Compare with regex (last arg).
1085 #
1086 proc run_ld_link_tests { ldtests } {
1087     global ld
1088     global as
1089     global nm
1090     global objdump
1091     global READELF
1092     global srcdir
1093     global subdir
1094     global env
1095     global CC
1096     global CFLAGS
1097
1098     foreach testitem $ldtests {
1099         set testname [lindex $testitem 0]
1100         set ld_options [lindex $testitem 1]
1101         set as_options [lindex $testitem 2]
1102         set src_files  [lindex $testitem 3]
1103         set actions [lindex $testitem 4]
1104         set binfile tmpdir/[lindex $testitem 5]
1105         set cflags [lindex $testitem 6]
1106         set objfiles {}
1107         set is_unresolved 0
1108         set failed 0
1109
1110 #       verbose -log "Testname is $testname"
1111 #       verbose -log "ld_options is $ld_options"
1112 #       verbose -log "as_options is $as_options"
1113 #       verbose -log "src_files is $src_files"
1114 #       verbose -log "actions is $actions"
1115 #       verbose -log "binfile is $binfile"
1116
1117         # Assemble each file in the test.
1118         foreach src_file $src_files {
1119             set objfile "tmpdir/[file rootname $src_file].o"
1120             lappend objfiles $objfile
1121
1122             if { [file extension $src_file] == ".c" } {
1123                 set as_file "tmpdir/[file rootname $src_file].s"
1124                 if ![ld_compile "$CC -S $CFLAGS $cflags" $srcdir/$subdir/$src_file $as_file] {
1125                     set is_unresolved 1
1126                     break
1127                 }
1128             } else {
1129                 set as_file "$srcdir/$subdir/$src_file"
1130             }
1131             if ![ld_assemble $as "$as_options $as_file" $objfile] {
1132                 set is_unresolved 1
1133                 break
1134             }
1135         }
1136
1137         # Catch assembler errors.
1138         if { $is_unresolved != 0 } {
1139             unresolved $testname
1140             continue
1141         }
1142
1143         if ![ld_simple_link $ld $binfile "-L$srcdir/$subdir $ld_options $objfiles"] {
1144             fail $testname
1145         } else {
1146             set failed 0
1147             foreach actionlist $actions {
1148                 set action [lindex $actionlist 0]
1149                 set progopts [lindex $actionlist 1]
1150
1151                 # There are actions where we run regexp_diff on the
1152                 # output, and there are other actions (presumably).
1153                 # Handling of the former look the same.
1154                 set dump_prog ""
1155                 switch -- $action {
1156                     objdump
1157                         { set dump_prog $objdump }
1158                     nm
1159                         { set dump_prog $nm }
1160                     readelf
1161                         { set dump_prog $READELF }
1162                     default
1163                         {
1164                             perror "Unrecognized action $action"
1165                             set is_unresolved 1
1166                             break
1167                         }
1168                     }
1169
1170                 if { $dump_prog != "" } {
1171                     set dumpfile [lindex $actionlist 2]
1172                     set binary $dump_prog
1173
1174                     # Ensure consistent sorting of symbols
1175                     if {[info exists env(LC_ALL)]} {
1176                         set old_lc_all $env(LC_ALL)
1177                     }
1178                     set env(LC_ALL) "C"
1179                     set cmd "$binary $progopts $binfile > dump.out"
1180                     send_log "$cmd\n"
1181                     catch "exec $cmd" comp_output
1182                     if {[info exists old_lc_all]} {
1183                         set env(LC_ALL) $old_lc_all
1184                     } else {
1185                         unset env(LC_ALL)
1186                     }
1187                     set comp_output [prune_warnings $comp_output]
1188
1189                     if ![string match "" $comp_output] then {
1190                         send_log "$comp_output\n"
1191                         set failed 1
1192                         break
1193                     }
1194
1195                     if { [regexp_diff "dump.out" "$srcdir/$subdir/$dumpfile"] } then {
1196                         verbose "output is [file_contents "dump.out"]" 2
1197                         set failed 1
1198                         break
1199                     }
1200                 }
1201             }
1202
1203             if { $failed != 0 } {
1204                 fail $testname
1205             } else { if { $is_unresolved == 0 } {
1206                 pass $testname
1207             } }
1208         }
1209
1210         # Catch action errors.
1211         if { $is_unresolved != 0 } {
1212             unresolved $testname
1213             continue
1214         }
1215     }
1216 }
1217
1218
1219 proc verbose_eval { expr { level 1 } } {
1220     global verbose
1221     if $verbose>$level then { eval verbose "$expr" $level }
1222 }
1223
1224 # This definition is taken from an unreleased version of DejaGnu.  Once
1225 # that version gets released, and has been out in the world for a few
1226 # months at least, it may be safe to delete this copy.
1227 if ![string length [info proc prune_warnings]] {
1228     #
1229     # prune_warnings -- delete various system verbosities from TEXT
1230     #
1231     # An example is:
1232     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
1233     #
1234     # Sites with particular verbose os's may wish to override this in site.exp.
1235     #
1236     proc prune_warnings { text } {
1237         # This is from sun4's.  Do it for all machines for now.
1238         # The "\\1" is to try to preserve a "\n" but only if necessary.
1239         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
1240
1241         # It might be tempting to get carried away and delete blank lines, etc.
1242         # Just delete *exactly* what we're ask to, and that's it.
1243         return $text
1244     }
1245 }
1246
1247 # targets_to_xfail is a list of target triplets to be xfailed.
1248 # ldtests contains test-items with 3 items followed by 1 lists, 2 items
1249 # and 2 optional items:
1250 #   0:name
1251 #   1:ld options
1252 #   2:assembler options
1253 #   3:filenames of source files
1254 #   4:name of output file
1255 #   5:expected output
1256 #   6:compiler flags (optional)
1257 #   7:language (optional)
1258
1259 proc run_ld_link_exec_tests { targets_to_xfail ldtests } {
1260     global ld
1261     global as
1262     global srcdir
1263     global subdir
1264     global env
1265     global CC
1266     global CXX
1267     global CFLAGS
1268     global errcnt
1269
1270     foreach testitem $ldtests {
1271         foreach target $targets_to_xfail {
1272             setup_xfail $target
1273         }
1274         set testname [lindex $testitem 0]
1275         set ld_options [lindex $testitem 1]
1276         set as_options [lindex $testitem 2]
1277         set src_files  [lindex $testitem 3]
1278         set binfile tmpdir/[lindex $testitem 4]
1279         set expfile [lindex $testitem 5]
1280         set cflags [lindex $testitem 6]
1281         set lang [lindex $testitem 7]
1282         set objfiles {}
1283         set failed 0
1284
1285 #       verbose -log "Testname is $testname"
1286 #       verbose -log "ld_options is $ld_options"
1287 #       verbose -log "as_options is $as_options"
1288 #       verbose -log "src_files is $src_files"
1289 #       verbose -log "actions is $actions"
1290 #       verbose -log "binfile is $binfile"
1291
1292         # Assemble each file in the test.
1293         foreach src_file $src_files {
1294             set objfile "tmpdir/[file rootname $src_file].o"
1295             lappend objfiles $objfile
1296
1297             # We ignore warnings since some compilers may generate
1298             # incorrect section attributes and the assembler will warn
1299             # them.
1300             ld_compile "$CC -c $CFLAGS $cflags" $srcdir/$subdir/$src_file $objfile
1301
1302             # We have to use $CC to build PIE and shared library.
1303             if { [ string match "c" $lang ] } {
1304                 set link_proc ld_simple_link
1305                 set link_cmd $CC
1306             } elseif { [ string match "c++" $lang ] } {
1307                 set link_proc ld_simple_link
1308                 set link_cmd $CXX
1309             } elseif { [ string match "-shared" $ld_options ] \
1310                  || [ string match "-pie" $ld_options ] } {
1311                 set link_proc ld_simple_link
1312                 set link_cmd $CC
1313             } else {
1314                 set link_proc ld_link
1315                 set link_cmd $ld
1316             }
1317
1318             if ![$link_proc $link_cmd $binfile "-L$srcdir/$subdir $ld_options $objfiles"] {
1319                 set failed 1
1320             } else {
1321                 set failed 0
1322                 send_log "Running: $binfile > $binfile.out\n"
1323                 verbose "Running: $binfile > $binfile.out"
1324                 catch "exec $binfile > $binfile.out" exec_output
1325
1326                 if ![string match "" $exec_output] then {
1327                     send_log "$exec_output\n"
1328                     verbose "$exec_output" 1
1329                     set failed 1
1330                 } else {
1331                     send_log "diff $binfile.out $srcdir/$subdir/$expfile\n"
1332                     verbose "diff $binfile.out $srcdir/$subdir/$expfile"
1333                     catch "exec diff $binfile.out $srcdir/$subdir/$expfile" exec_output
1334                     set exec_output [prune_warnings $exec_output]
1335
1336                     if ![string match "" $exec_output] then {
1337                         send_log "$exec_output\n"
1338                         verbose "$exec_output" 1
1339                         set failed 1
1340                     }
1341                 }
1342             }
1343
1344             if { $failed != 0 } {
1345                 fail $testname
1346             } else {
1347                 set errcnt 0
1348                 pass $testname
1349             }
1350         }
1351     }
1352 }
1353
1354 # List contains test-items with 3 items followed by 2 lists, one item and
1355 # one optional item:
1356 #  0:name
1357 #  1:link options
1358 #  2:compile options
1359 #  3:filenames of source files
1360 #  4:action and options.
1361 #  5:name of output file
1362 #  6:language (optional)
1363 #
1364 # Actions:
1365 # objdump: Apply objdump options on result.  Compare with regex (last arg).
1366 # nm: Apply nm options on result.  Compare with regex (last arg).
1367 # readelf: Apply readelf options on result.  Compare with regex (last arg).
1368 #
1369 proc run_cc_link_tests { ldtests } {
1370     global nm
1371     global objdump
1372     global READELF
1373     global srcdir
1374     global subdir
1375     global env
1376     global CC
1377     global CXX
1378     global CFLAGS
1379
1380     foreach testitem $ldtests {
1381         set testname [lindex $testitem 0]
1382         set ldflags [lindex $testitem 1]
1383         set cflags [lindex $testitem 2]
1384         set src_files  [lindex $testitem 3]
1385         set actions [lindex $testitem 4]
1386         set binfile tmpdir/[lindex $testitem 5]
1387         set lang [lindex $testitem 6]
1388         set objfiles {}
1389         set is_unresolved 0
1390         set failed 0
1391
1392         # Compile each file in the test.
1393         foreach src_file $src_files {
1394             set objfile "tmpdir/[file rootname $src_file].o"
1395             lappend objfiles $objfile
1396
1397             # We ignore warnings since some compilers may generate
1398             # incorrect section attributes and the assembler will warn
1399             # them.
1400             ld_compile "$CC -c $CFLAGS $cflags" $srcdir/$subdir/$src_file $objfile
1401         }
1402
1403         # Clear error and warning counts.
1404         reset_vars
1405
1406         if { [ string match "c++" $lang ] } {
1407             set cc_cmd $CXX
1408         } else {
1409             set cc_cmd $CC
1410         }
1411
1412         if ![ld_simple_link $cc_cmd $binfile "-L$srcdir/$subdir $ldflags $objfiles"] {
1413             fail $testname
1414         } else {
1415             set failed 0
1416             foreach actionlist $actions {
1417                 set action [lindex $actionlist 0]
1418                 set progopts [lindex $actionlist 1]
1419
1420                 # There are actions where we run regexp_diff on the
1421                 # output, and there are other actions (presumably).
1422                 # Handling of the former look the same.
1423                 set dump_prog ""
1424                 switch -- $action {
1425                     objdump
1426                         { set dump_prog $objdump }
1427                     nm
1428                         { set dump_prog $nm }
1429                     readelf
1430                         { set dump_prog $READELF }
1431                     default
1432                         {
1433                             perror "Unrecognized action $action"
1434                             set is_unresolved 1
1435                             break
1436                         }
1437                     }
1438
1439                 if { $dump_prog != "" } {
1440                     set dumpfile [lindex $actionlist 2]
1441                     set binary $dump_prog
1442
1443                     # Ensure consistent sorting of symbols
1444                     if {[info exists env(LC_ALL)]} {
1445                         set old_lc_all $env(LC_ALL)
1446                     }
1447                     set env(LC_ALL) "C"
1448                     set cmd "$binary $progopts $binfile > dump.out"
1449                     send_log "$cmd\n"
1450                     catch "exec $cmd" comp_output
1451                     if {[info exists old_lc_all]} {
1452                         set env(LC_ALL) $old_lc_all
1453                     } else {
1454                         unset env(LC_ALL)
1455                     }
1456                     set comp_output [prune_warnings $comp_output]
1457
1458                     if ![string match "" $comp_output] then {
1459                         send_log "$comp_output\n"
1460                         set failed 1
1461                         break
1462                     }
1463
1464                     if { [regexp_diff "dump.out" "$srcdir/$subdir/$dumpfile"] } then {
1465                         verbose "output is [file_contents "dump.out"]" 2
1466                         set failed 1
1467                         break
1468                     }
1469                 }
1470             }
1471
1472             if { $failed != 0 } {
1473                 fail $testname
1474             } else { if { $is_unresolved == 0 } {
1475                 pass $testname
1476             } }
1477         }
1478
1479         # Catch action errors.
1480         if { $is_unresolved != 0 } {
1481             unresolved $testname
1482             continue
1483         }
1484     }
1485 }