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