ld/testsuite/lib/ld-lib.exp

   1 # Support routines for LD testsuite.
   2 #   Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
   3 #   Free Software Foundation, Inc.
   4 #
   5 # This file is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  18 #
  19 #
  20 # default_ld_version
  21 #       extract and print the version number of ld
  22 #
  23 proc default_ld_version { ld } {
  24     global host_triplet
  25
  26     if { [which $ld] == 0 } then {
  27         perror "$ld does not exist"
  28         exit 1
  29     }
  30
  31     catch "exec $ld --version" tmp
  32     set tmp [prune_warnings $tmp]
  33     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number
  34     if [info exists number] then {
  35         clone_output "$ld $number\n"
  36     }
  37 }
  38
  39 #
  40 # default_ld_relocate
  41 #       link an object using relocation
  42 #
  43 proc default_ld_relocate { ld target objects } {
  44     global HOSTING_EMU
  45     global host_triplet
  46
  47     if { [which $ld] == 0 } then {
  48         perror "$ld does not exist"
  49         return 0
  50     }
  51
  52     verbose -log "$ld $HOSTING_EMU -o $target -r $objects"
  53
  54     catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
  55     set exec_output [prune_warnings $exec_output]
  56     if [string match "" $exec_output] then {
  57         return 1
  58     } else {
  59         verbose -log "$exec_output"
  60         return 0
  61     }
  62 }
  63
  64 # Check to see if ld is being invoked with a non-endian output format
  65
  66 proc is_endian_output_format { object_flags } {
  67
  68     if {[string match "*-oformat binary*" $object_flags] ||      \
  69         [string match "*-oformat ieee*" $object_flags] ||        \
  70         [string match "*-oformat ihex*" $object_flags] ||        \
  71         [string match "*-oformat netbsd-core*" $object_flags] || \
  72         [string match "*-oformat srec*" $object_flags] ||        \
  73         [string match "*-oformat tekhex*" $object_flags] ||      \
  74         [string match "*-oformat trad-core*" $object_flags] } then {
  75         return 0
  76     } else {
  77         return 1
  78     }
  79 }
  80
  81 # Look for big-endian or little-endian switches in the multlib
  82 # options and translate these into a -EB or -EL switch.  Note
  83 # we cannot rely upon proc process_multilib_options to do this
  84 # for us because for some targets the compiler does not support
  85 # -EB/-EL but it does support -mbig-endian/-mlittle-endian, and
  86 # the site.exp file will include the switch "-mbig-endian"
  87 # (rather than "big-endian") which is not detected by proc
  88 # process_multilib_options.
  89
  90 proc big_or_little_endian {} {
  91
  92     if [board_info [target_info name] exists multilib_flags] {
  93         set tmp_flags " [board_info [target_info name] multilib_flags]"
  94
  95         foreach x $tmp_flags {
  96             case $x in {
  97                 {*big*endian eb EB -eb -EB -mb} {
  98                     set flags " -EB"
  99                     return $flags
 100                 }
 101                 {*little*endian el EL -el -EL -ml} {
 102                     set flags " -EL"
 103                     return $flags
 104                 }
 105             }
 106         }
 107     }
 108
 109     set flags ""
 110     return $flags
 111 }
 112
 113 #
 114 # default_ld_link
 115 #       link a program using ld
 116 #
 117 proc default_ld_link { ld target objects } {
 118     global HOSTING_EMU
 119     global HOSTING_CRT0
 120     global HOSTING_LIBS
 121     global LIBS
 122     global host_triplet
 123     global link_output
 124
 125     set objs "$HOSTING_CRT0 $objects"
 126     set libs "$LIBS $HOSTING_LIBS"
 127
 128     if { [which $ld] == 0 } then {
 129         perror "$ld does not exist"
 130         return 0
 131     }
 132
 133     if [is_endian_output_format $objects] then {
 134         set flags [big_or_little_endian]
 135     } else {
 136         set flags ""
 137     }
 138     verbose -log "$ld $HOSTING_EMU $flags -o $target $objs $libs"
 139
 140     catch "exec $ld $HOSTING_EMU $flags -o $target $objs $libs" link_output
 141     set exec_output [prune_warnings $link_output]
 142     if [string match "" $link_output] then {
 143         return 1
 144     } else {
 145         verbose -log "$link_output"
 146         return 0
 147     }
 148 }
 149
 150 #
 151 # default_ld_simple_link
 152 #       link a program using ld, without including any libraries
 153 #
 154 proc default_ld_simple_link { ld target objects } {
 155     global host_triplet
 156     global link_output
 157     global gcc_ld_flag
 158
 159     if { [which $ld] == 0 } then {
 160         perror "$ld does not exist"
 161         return 0
 162     }
 163
 164     if [is_endian_output_format $objects] then {
 165         set flags [big_or_little_endian]
 166     } else {
 167         set flags ""
 168     }
 169
 170     # If we are compiling with gcc, we want to add gcc_ld_flag to
 171     # flags.  Rather than determine this in some complex way, we guess
 172     # based on the name of the compiler.
 173     set ldexe $ld
 174     set ldparm [string first " " $ld]
 175     if { $ldparm > 0 } then {
 176         set ldexe [string range $ld 0 $ldparm]
 177     }
 178     set ldexe [string replace $ldexe 0 [string last "/" $ldexe] ""]
 179     if {[string match "*gcc*" $ldexe] || [string match "*++*" $ldexe]} then {
 180         set flags "$gcc_ld_flag $flags"
 181     }
 182
 183     verbose -log "$ld $flags -o $target $objects"
 184
 185     catch "exec $ld $flags -o $target $objects" link_output
 186     set exec_output [prune_warnings $link_output]
 187
 188     # We don't care if we get a warning about a non-existent start
 189     # symbol, since the default linker script might use ENTRY.
 190     regsub -all "(^|\n)(\[^\n\]*: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
 191
 192     if [string match "" $exec_output] then {
 193         return 1
 194     } else {
 195         verbose -log "$exec_output"
 196         return 0
 197     }
 198 }
 199
 200 #
 201 # default_ld_compile
 202 #       compile an object using cc
 203 #
 204 proc default_ld_compile { cc source object } {
 205     global CFLAGS
 206     global srcdir
 207     global subdir
 208     global host_triplet
 209     global gcc_gas_flag
 210
 211     set cc_prog $cc
 212     if {[llength $cc_prog] > 1} then {
 213         set cc_prog [lindex $cc_prog 0]
 214     }
 215     if {[which $cc_prog] == 0} then {
 216         perror "$cc_prog does not exist"
 217         return 0
 218     }
 219
 220     catch "exec rm -f $object" exec_output
 221
 222     set flags "-I$srcdir/$subdir $CFLAGS"
 223
 224     # If we are compiling with gcc, we want to add gcc_gas_flag to
 225     # flags.  Rather than determine this in some complex way, we guess
 226     # based on the name of the compiler.
 227     set ccexe $cc
 228     set ccparm [string first " " $cc]
 229     if { $ccparm > 0 } then {
 230         set ccexe [string range $cc 0 $ccparm]
 231     }
 232     set ccexe [string replace $ccexe 0 [string last "/" $ccexe] ""]
 233     if {[string match "*gcc*" $ccexe] || [string match "*++*" $ccexe]} then {
 234         set flags "$gcc_gas_flag $flags"
 235     }
 236
 237     if [board_info [target_info name] exists multilib_flags] {
 238         append flags " [board_info [target_info name] multilib_flags]"
 239     }
 240
 241     verbose -log "$cc $flags -c $source -o $object"
 242
 243     catch "exec $cc $flags -c $source -o $object" exec_output
 244     set exec_output [prune_warnings $exec_output]
 245     if [string match "" $exec_output] then {
 246         if {![file exists $object]} then {
 247             regexp ".*/(\[^/\]*)$" $source all dobj
 248             regsub "\\.c" $dobj ".o" realobj
 249             verbose "looking for $realobj"
 250             if {[file exists $realobj]} then {
 251                 verbose -log "mv $realobj $object"
 252                 catch "exec mv $realobj $object" exec_output
 253                 set exec_output [prune_warnings $exec_output]
 254                 if {![string match "" $exec_output]} then {
 255                     verbose -log "$exec_output"
 256                     perror "could not move $realobj to $object"
 257                     return 0
 258                 }
 259             } else {
 260                 perror "$object not found after compilation"
 261                 return 0
 262             }
 263         }
 264         return 1
 265     } else {
 266         verbose -log "$exec_output"
 267         perror "$source: compilation failed"
 268         return 0
 269     }
 270 }
 271
 272 #
 273 # default_ld_assemble
 274 #       assemble a file
 275 #
 276 proc default_ld_assemble { as source object } {
 277     global ASFLAGS
 278     global host_triplet
 279
 280     if {[which $as] == 0} then {
 281         perror "$as does not exist"
 282         return 0
 283     }
 284
 285     if ![info exists ASFLAGS] { set ASFLAGS "" }
 286
 287     set flags [big_or_little_endian]
 288
 289     verbose -log "$as $flags $ASFLAGS -o $object $source"
 290
 291     catch "exec $as $flags $ASFLAGS -o $object $source" exec_output
 292     set exec_output [prune_warnings $exec_output]
 293     if [string match "" $exec_output] then {
 294         return 1
 295     } else {
 296         verbose -log "$exec_output"
 297         perror "$source: assembly failed"
 298         return 0
 299     }
 300 }
 301
 302 #
 303 # default_ld_nm
 304 #       run nm on a file, putting the result in the array nm_output
 305 #
 306 proc default_ld_nm { nm nmflags object } {
 307     global NMFLAGS
 308     global nm_output
 309     global host_triplet
 310
 311     if {[which $nm] == 0} then {
 312         perror "$nm does not exist"
 313         return 0
 314     }
 315
 316     if {[info exists nm_output]} {
 317       unset nm_output
 318     }
 319
 320     if ![info exists NMFLAGS] { set NMFLAGS "" }
 321
 322     # Ensure consistent sorting of symbols
 323     if {[info exists env(LC_ALL)]} {
 324         set old_lc_all $env(LC_ALL)
 325     }
 326     set env(LC_ALL) "C"
 327     verbose -log "$nm $NMFLAGS $nmflags $object >tmpdir/nm.out"
 328
 329     catch "exec $nm $NMFLAGS $nmflags $object >tmpdir/nm.out" exec_output
 330     if {[info exists old_lc_all]} {
 331         set env(LC_ALL) $old_lc_all
 332     } else {
 333         unset env(LC_ALL)
 334     }
 335     set exec_output [prune_warnings $exec_output]
 336     if [string match "" $exec_output] then {
 337         set file [open tmpdir/nm.out r]
 338         while { [gets $file line] != -1 } {
 339             verbose "$line" 2
 340             if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] \\.*(.+)$" $line whole value name] {
 341                 set name [string trimleft $name "_"]
 342                 verbose "Setting nm_output($name) to 0x$value" 2
 343                 set nm_output($name) 0x$value
 344             }
 345         }
 346         close $file
 347         return 1
 348     } else {
 349         verbose -log "$exec_output"
 350         perror "$object: nm failed"
 351         return 0
 352     }
 353 }
 354
 355 #
 356 # is_elf_format
 357 #       true if the object format is known to be ELF
 358 #
 359 proc is_elf_format {} {
 360     if { ![istarget *-*-sysv4*] \
 361          && ![istarget *-*-unixware*] \
 362          && ![istarget *-*-elf*] \
 363          && ![istarget *-*-eabi*] \
 364          && ![istarget hppa*64*-*-hpux*] \
 365          && ![istarget *-*-linux*] \
 366          && ![istarget frv-*-uclinux*] \
 367          && ![istarget *-*-irix5*] \
 368          && ![istarget *-*-irix6*] \
 369          && ![istarget *-*-netbsd*] \
 370          && ![istarget *-*-solaris2*] } {
 371         return 0
 372     }
 373
 374     if { [istarget *-*-linux*aout*] \
 375          || [istarget *-*-linux*oldld*] } {
 376         return 0
 377     }
 378
 379     if { ![istarget *-*-netbsdelf*] \
 380          && ([istarget *-*-netbsd*aout*] \
 381              || [istarget *-*-netbsdpe*] \
 382              || [istarget arm*-*-netbsd*] \
 383              || [istarget sparc-*-netbsd*] \
 384              || [istarget i*86-*-netbsd*] \
 385              || [istarget m68*-*-netbsd*] \
 386              || [istarget vax-*-netbsd*] \
 387              || [istarget ns32k-*-netbsd*]) } {
 388         return 0
 389     }
 390     return 1
 391 }
 392
 393 #
 394 # is_elf64
 395 #       true if the object format is known to be 64bit ELF
 396 proc is_elf64 { binary_file } {
 397     global READELF
 398     global READELFFLAGS
 399
 400     set readelf_size ""
 401     catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got
 402
 403     if ![string match "" $got] then {
 404         return 0
 405     }
 406
 407     if { ![regexp "\n\[ \]*Class:\[ \]*ELF(\[0-9\]+)\n" \
 408            [file_contents readelf.out] nil readelf_size] } {
 409         return 0
 410     }
 411
 412     if { $readelf_size == "64" } {
 413         return 1
 414     }
 415
 416     return 0
 417 }
 418
 419 #
 420 # is_pecoff_format
 421 #       true if the object format is known to be PECOFF
 422 #
 423 proc is_pecoff_format {} {
 424     if { ![istarget *-*-mingw32*] \
 425          && ![istarget *-*-cygwin*] \
 426          && ![istarget *-*-pe*] } {
 427         return 0
 428     }
 429
 430     return 1
 431 }
 432
 433 #
 434 # simple_diff
 435 #       compares two files line-by-line
 436 #       returns differences if exist
 437 #       returns null if file(s) cannot be opened
 438 #
 439 proc simple_diff { file_1 file_2 } {
 440     global target
 441
 442     set eof -1
 443     set differences 0
 444
 445     if [file exists $file_1] then {
 446         set file_a [open $file_1 r]
 447     } else {
 448         warning "$file_1 doesn't exist"
 449         return
 450     }
 451
 452     if [file exists $file_2] then {
 453         set file_b [open $file_2 r]
 454     } else {
 455         fail "$file_2 doesn't exist"
 456         return
 457     }
 458
 459     verbose "# Diff'ing: $file_1 $file_2\n" 2
 460
 461     while { [gets $file_a line] != $eof } {
 462         if [regexp "^#.*$" $line] then {
 463             continue
 464         } else {
 465             lappend list_a $line
 466         }
 467     }
 468     close $file_a
 469
 470     while { [gets $file_b line] != $eof } {
 471         if [regexp "^#.*$" $line] then {
 472             continue
 473         } else {
 474             lappend list_b $line
 475         }
 476     }
 477     close $file_b
 478
 479     for { set i 0 } { $i < [llength $list_a] } { incr i } {
 480         set line_a [lindex $list_a $i]
 481         set line_b [lindex $list_b $i]
 482
 483         verbose "\t$file_1: $i: $line_a\n" 3
 484         verbose "\t$file_2: $i: $line_b\n" 3
 485         if [string compare $line_a $line_b] then {
 486             verbose -log "\t$file_1: $i: $line_a\n"
 487             verbose -log "\t$file_2: $i: $line_b\n"
 488
 489             fail "Test: $target"
 490             return
 491         }
 492     }
 493
 494     if { [llength $list_a] != [llength $list_b] } {
 495         fail "Test: $target"
 496         return
 497     }
 498
 499     if $differences<1 then {
 500         pass "Test: $target"
 501     }
 502 }
 503
 504 # run_dump_test FILE
 505 # Copied from gas testsuite, tweaked and further extended.
 506 #
 507 # Assemble a .s file, then run some utility on it and check the output.
 508 #
 509 # There should be an assembly language file named FILE.s in the test
 510 # suite directory, and a pattern file called FILE.d.  `run_dump_test'
 511 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
 512 # `nm' on the .o file to produce textual output, and then analyze that
 513 # with regexps.  The FILE.d file specifies what program to run, and
 514 # what to expect in its output.
 515 #
 516 # The FILE.d file begins with zero or more option lines, which specify
 517 # flags to pass to the assembler, the program to run to dump the
 518 # assembler's output, and the options it wants.  The option lines have
 519 # the syntax:
 520 #
 521 #         # OPTION: VALUE
 522 #
 523 # OPTION is the name of some option, like "name" or "objdump", and
 524 # VALUE is OPTION's value.  The valid options are described below.
 525 # Whitespace is ignored everywhere, except within VALUE.  The option
 526 # list ends with the first line that doesn't match the above syntax
 527 # (hmm, not great for error detection).
 528 #
 529 # The interesting options are:
 530 #
 531 #   name: TEST-NAME
 532 #       The name of this test, passed to DejaGNU's `pass' and `fail'
 533 #       commands.  If omitted, this defaults to FILE, the root of the
 534 #       .s and .d files' names.
 535 #
 536 #   as: FLAGS
 537 #       When assembling, pass FLAGS to the assembler.
 538 #       If assembling several files, you can pass different assembler
 539 #       options in the "source" directives.  See below.
 540 #
 541 #   ld: FLAGS
 542 #       Link assembled files using FLAGS, in the order of the "source"
 543 #       directives, when using multiple files.
 544 #
 545 #   objcopy_linked_file: FLAGS
 546 #       Run objcopy on the linked file with the specified flags.
 547 #       This lets you transform the linked file using objcopy, before the
 548 #       result is analyzed by an analyzer program specified below (which
 549 #       may in turn *also* be objcopy).
 550 #
 551 #   PROG: PROGRAM-NAME
 552 #       The name of the program to run to analyze the .o file produced
 553 #       by the assembler or the linker output.  This can be omitted;
 554 #       run_dump_test will guess which program to run by seeing which of
 555 #       the flags options below is present.
 556 #
 557 #   objdump: FLAGS
 558 #   nm: FLAGS
 559 #   objcopy: FLAGS
 560 #       Use the specified program to analyze the assembler or linker
 561 #       output file, and pass it FLAGS, in addition to the output name.
 562 #       Note that they are run with LC_ALL=C in the environment to give
 563 #       consistent sorting of symbols.
 564 #
 565 #   source: SOURCE [FLAGS]
 566 #       Assemble the file SOURCE.s using the flags in the "as" directive
 567 #       and the (optional) FLAGS.  If omitted, the source defaults to
 568 #       FILE.s.
 569 #       This is useful if several .d files want to share a .s file.
 570 #       More than one "source" directive can be given, which is useful
 571 #       when testing linking.
 572 #
 573 #   xfail: TARGET
 574 #       The test is expected to fail on TARGET.  This may occur more than
 575 #       once.
 576 #
 577 #   target: TARGET
 578 #       Only run the test for TARGET.  This may occur more than once; the
 579 #       target being tested must match at least one.
 580 #
 581 #   notarget: TARGET
 582 #       Do not run the test for TARGET.  This may occur more than once;
 583 #       the target being tested must not match any of them.
 584 #
 585 #   error: REGEX
 586 #       An error with message matching REGEX must be emitted for the test
 587 #       to pass.  The PROG, objdump, nm and objcopy options have no
 588 #       meaning and need not supplied if this is present.
 589 #
 590 #   warning: REGEX
 591 #       Expect a linker warning matching REGEX.  It is an error to issue
 592 #       both "error" and "warning".
 593 #
 594 # Each option may occur at most once unless otherwise mentioned.
 595 #
 596 # After the option lines come regexp lines.  `run_dump_test' calls
 597 # `regexp_diff' to compare the output of the dumping tool against the
 598 # regexps in FILE.d.  `regexp_diff' is defined later in this file; see
 599 # further comments there.
 600
 601 proc run_dump_test { name } {
 602     global subdir srcdir
 603     global OBJDUMP NM AS OBJCOPY READELF LD
 604     global OBJDUMPFLAGS NMFLAGS ASFLAGS OBJCOPYFLAGS READELFFLAGS LDFLAGS
 605     global host_triplet runtests
 606     global env
 607
 608     if [string match "*/*" $name] {
 609         set file $name
 610         set name [file tail $name]
 611     } else {
 612         set file "$srcdir/$subdir/$name"
 613     }
 614
 615     if ![runtest_file_p $runtests $name] then {
 616         return
 617     }
 618
 619     set opt_array [slurp_options "${file}.d"]
 620     if { $opt_array == -1 } {
 621         perror "error reading options from $file.d"
 622         unresolved $subdir/$name
 623         return
 624     }
 625     set dumpfile tmpdir/dump.out
 626     set run_ld 0
 627     set run_objcopy 0
 628     set opts(as) {}
 629     set opts(ld) {}
 630     set opts(xfail) {}
 631     set opts(target) {}
 632     set opts(notarget) {}
 633     set opts(objdump) {}
 634     set opts(nm) {}
 635     set opts(objcopy) {}
 636     set opts(readelf) {}
 637     set opts(name) {}
 638     set opts(PROG) {}
 639     set opts(source) {}
 640     set opts(error) {}
 641     set opts(warning) {}
 642     set opts(objcopy_linked_file) {}
 643     set asflags(${file}.s) {}
 644
 645     foreach i $opt_array {
 646         set opt_name [lindex $i 0]
 647         set opt_val [lindex $i 1]
 648         if ![info exists opts($opt_name)] {
 649             perror "unknown option $opt_name in file $file.d"
 650             unresolved $subdir/$name
 651             return
 652         }
 653
 654         switch -- $opt_name {
 655             xfail {}
 656             target {}
 657             notarget {}
 658             source {
 659                 # Move any source-specific as-flags to a separate array to
 660                 # simplify processing.
 661                 if { [llength $opt_val] > 1 } {
 662                     set asflags([lindex $opt_val 0]) [lrange $opt_val 1 end]
 663                     set opt_val [lindex $opt_val 0]
 664                 } else {
 665                     set asflags($opt_val) {}
 666                 }
 667             }
 668             default {
 669                 if [string length $opts($opt_name)] {
 670                     perror "option $opt_name multiply set in $file.d"
 671                     unresolved $subdir/$name
 672                     return
 673                 }
 674
 675                 # A single "# ld:" with no options should do the right thing.
 676                 if { $opt_name == "ld" } {
 677                     set run_ld 1
 678                 }
 679                 # Likewise objcopy_linked_file.
 680                 if { $opt_name == "objcopy_linked_file" } {
 681                     set run_objcopy 1
 682                 }
 683             }
 684         }
 685         set opts($opt_name) [concat $opts($opt_name) $opt_val]
 686     }
 687
 688     # Decide early whether we should run the test for this target.
 689     if { [llength $opts(target)] > 0 } {
 690         set targmatch 0
 691         foreach targ $opts(target) {
 692             if [istarget $targ] {
 693                 set targmatch 1
 694                 break
 695             }
 696         }
 697         if { $targmatch == 0 } {
 698             return
 699         }
 700     }
 701     foreach targ $opts(notarget) {
 702         if [istarget $targ] {
 703             return
 704         }
 705     }
 706
 707     if {$opts(PROG) != ""} {
 708         switch -- $opts(PROG) {
 709             objdump
 710                 { set program objdump }
 711             nm
 712                 { set program nm }
 713             objcopy
 714                 { set program objcopy }
 715             readelf
 716                 { set program readelf }
 717             default
 718                 { perror "unrecognized program option $opts(PROG) in $file.d"
 719                   unresolved $subdir/$name
 720                   return }
 721         }
 722     } elseif { $opts(error) != "" } {
 723         # It's meaningless to require an output-testing method when we
 724         # expect an error.  For simplicity, we fake an arbitrary method.
 725         set program "nm"
 726     } else {
 727         # Guess which program to run, by seeing which option was specified.
 728         set program ""
 729         foreach p {objdump objcopy nm readelf} {
 730             if {$opts($p) != ""} {
 731                 if {$program != ""} {
 732                     perror "ambiguous dump program in $file.d"
 733                     unresolved $subdir/$name
 734                     return
 735                 } else {
 736                     set program $p
 737                 }
 738             }
 739         }
 740         if {$program == ""} {
 741             perror "dump program unspecified in $file.d"
 742             unresolved $subdir/$name
 743             return
 744         }
 745     }
 746
 747     set progopts1 $opts($program)
 748     eval set progopts \$[string toupper $program]FLAGS
 749     eval set binary \$[string toupper $program]
 750     if { $opts(name) == "" } {
 751         set testname "$subdir/$name"
 752     } else {
 753         set testname $opts(name)
 754     }
 755
 756     if { $opts(source) == "" } {
 757         set sourcefiles [list ${file}.s]
 758     } else {
 759         set sourcefiles {}
 760         foreach sf $opts(source) {
 761             if { [string match "/*" $sf] } {
 762                 lappend sourcefiles "$sf"
 763             } {
 764                 lappend sourcefiles "$srcdir/$subdir/$sf"
 765             }
 766             # Must have asflags indexed on source name.
 767             set asflags($srcdir/$subdir/$sf) $asflags($sf)
 768         }
 769     }
 770
 771     # Time to setup xfailures.
 772     foreach targ $opts(xfail) {
 773         setup_xfail $targ
 774     }
 775
 776     # Assemble each file.
 777     set objfiles {}
 778     for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
 779         set sourcefile [lindex $sourcefiles $i]
 780
 781         set objfile "tmpdir/dump$i.o"
 782         lappend objfiles $objfile
 783         set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
 784
 785         send_log "$cmd\n"
 786         set cmdret [catch "exec $cmd" comp_output]
 787         set comp_output [prune_warnings $comp_output]
 788
 789         # We accept errors at assembly stage too, unless we're supposed to
 790         # link something.
 791         if { $cmdret != 0 || ![string match "" $comp_output] } then {
 792             send_log "$comp_output\n"
 793             verbose "$comp_output" 3
 794             if { $opts(error) != "" && $run_ld == 0 } {
 795                 if [regexp $opts(error) $comp_output] {
 796                     pass $testname
 797                     return
 798                 }
 799             }
 800             fail $testname
 801             return
 802         }
 803     }
 804
 805     # Perhaps link the file(s).
 806     if { $run_ld } {
 807         set objfile "tmpdir/dump"
 808         set expmsg $opts(error)
 809
 810         if { $opts(warning) != "" } {
 811             if { $expmsg != "" } {
 812                 perror "$testname: mixing error and warning test-directives"
 813                 return
 814             }
 815             set expmsg $opts(warning)
 816         }
 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 || $comp_output != "" || $expmsg != "" } 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 { $cmdret != 0 && [lindex $errorCode 0] == "NONE" } {
 836                 set cmdret 0
 837             }
 838
 839             set exitstat "succeeded"
 840             if { $cmdret != 0 } { set exitstat "failed" }
 841             verbose -log "$exitstat with: <$comp_output>, expected: <$expmsg>"
 842             send_log "$comp_output\n"
 843             verbose "$comp_output" 3
 844             if { $expmsg != "" && $run_objcopy == 0 \
 845                     && [regexp $expmsg $comp_output] \
 846                     && (($cmdret == 0) == ($opts(warning) != "")) } {
 847                 # Only "pass" and return here if we expected (and got)
 848                 # an error.
 849                 if { $opts(error) != "" } {
 850                     pass $testname
 851                     return
 852                 }
 853             } {
 854                 fail $testname
 855                 return
 856             }
 857         }
 858
 859         if { $run_objcopy } {
 860             set infile $objfile
 861             set objfile "tmpdir/dump1"
 862
 863             # Note that we don't use OBJCOPYFLAGS here; any flags must be
 864             # explicitly specified.
 865             set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"
 866
 867             send_log "$cmd\n"
 868             set cmdret [catch "exec $cmd" comp_output]
 869             set comp_output [prune_warnings $comp_output]
 870
 871             if { $cmdret != 0 || ![string match "" $comp_output] } then {
 872                 verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
 873                 send_log "$comp_output\n"
 874                 verbose "$comp_output" 3
 875                 if { $opts(error) != "" } {
 876                     if [regexp $opts(error) $comp_output] {
 877                         pass $testname
 878                         return
 879                     }
 880                 }
 881                 fail $testname
 882                 return
 883             }
 884         }
 885     } else {
 886         set objfile "tmpdir/dump0.o"
 887     }
 888
 889     # We must not have expected failure if we get here.
 890     if { $opts(error) != "" } {
 891         fail $testname
 892         return
 893     }
 894
 895     if { [which $binary] == 0 } {
 896         untested $testname
 897         return
 898     }
 899
 900     if { $progopts1 == "" } { set $progopts1 "-r" }
 901     verbose "running $binary $progopts $progopts1" 3
 902
 903     # Objcopy, unlike the other two, won't send its output to stdout,
 904     # so we have to run it specially.
 905     set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
 906     if { $program == "objcopy" } {
 907         set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
 908     }
 909
 910     # Ensure consistent sorting of symbols
 911     if {[info exists env(LC_ALL)]} {
 912         set old_lc_all $env(LC_ALL)
 913     }
 914     set env(LC_ALL) "C"
 915     send_log "$cmd\n"
 916     catch "exec $cmd" comp_output
 917     if {[info exists old_lc_all]} {
 918         set env(LC_ALL) $old_lc_all
 919     } else {
 920         unset env(LC_ALL)
 921     }
 922     set comp_output [prune_warnings $comp_output]
 923     if ![string match "" $comp_output] then {
 924         send_log "$comp_output\n"
 925         fail $testname
 926         return
 927     }
 928
 929     verbose_eval {[file_contents $dumpfile]} 3
 930     if { [regexp_diff $dumpfile "${file}.d"] } then {
 931         fail $testname
 932         verbose "output is [file_contents $dumpfile]" 2
 933         return
 934     }
 935
 936     pass $testname
 937 }
 938
 939 proc slurp_options { file } {
 940     if [catch { set f [open $file r] } x] {
 941         #perror "couldn't open `$file': $x"
 942         perror "$x"
 943         return -1
 944     }
 945     set opt_array {}
 946     # whitespace expression
 947     set ws  {[  ]*}
 948     set nws {[^         ]*}
 949     # whitespace is ignored anywhere except within the options list;
 950     # option names are alphabetic plus underscore only.
 951     set pat "^#${ws}(\[a-zA-Z_\]*)$ws:${ws}(.*)$ws\$"
 952     while { [gets $f line] != -1 } {
 953         set line [string trim $line]
 954         # Whitespace here is space-tab.
 955         if [regexp $pat $line xxx opt_name opt_val] {
 956             # match!
 957             lappend opt_array [list $opt_name $opt_val]
 958         } else {
 959             break
 960         }
 961     }
 962     close $f
 963     return $opt_array
 964 }
 965
 966 # regexp_diff, copied from gas, based on simple_diff above.
 967 #       compares two files line-by-line
 968 #       file1 contains strings, file2 contains regexps and #-comments
 969 #       blank lines are ignored in either file
 970 #       returns non-zero if differences exist
 971 #
 972 proc regexp_diff { file_1 file_2 } {
 973
 974     set eof -1
 975     set end_1 0
 976     set end_2 0
 977     set differences 0
 978     set diff_pass 0
 979
 980     if [file exists $file_1] then {
 981         set file_a [open $file_1 r]
 982     } else {
 983         warning "$file_1 doesn't exist"
 984         return 1
 985     }
 986
 987     if [file exists $file_2] then {
 988         set file_b [open $file_2 r]
 989     } else {
 990         fail "$file_2 doesn't exist"
 991         close $file_a
 992         return 1
 993     }
 994
 995     verbose " Regexp-diff'ing: $file_1 $file_2" 2
 996
 997     while { 1 } {
 998         set line_a ""
 999         set line_b ""
1000         while { [string length $line_a] == 0 } {
1001             if { [gets $file_a line_a] == $eof } {
1002                 set end_1 1
1003                 break
1004             }
1005         }
1006         while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
1007             if [ string match "#pass" $line_b ] {
1008                 set end_2 1
1009                 set diff_pass 1
1010                 break
1011             } elseif [ string match "#..." $line_b ] {
1012                 if { [gets $file_b line_b] == $eof } {
1013                     set end_2 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 }