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