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