ld/testsuite/lib/ld-lib.exp

   1 # Support routines for LD testsuite.
   2 #   Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
   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 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     verbose -log "$nm $NMFLAGS $object >tmpdir/nm.out"
 303
 304     catch "exec $nm $NMFLAGS $object >tmpdir/nm.out" exec_output
 305     set exec_output [prune_warnings $exec_output]
 306     if [string match "" $exec_output] then {
 307         set file [open tmpdir/nm.out r]
 308         while { [gets $file line] != -1 } {
 309             verbose "$line" 2
 310             if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] (.+)$" $line whole value name] {
 311                 set name [string trimleft $name "_"]
 312                 verbose "Setting nm_output($name) to 0x$value" 2
 313                 set nm_output($name) 0x$value
 314             }
 315         }
 316         close $file
 317         return 1
 318     } else {
 319         verbose -log "$exec_output"
 320         perror "$object: nm failed"
 321         return 0
 322     }
 323 }
 324
 325 #
 326 # simple_diff
 327 #       compares two files line-by-line
 328 #       returns differences if exist
 329 #       returns null if file(s) cannot be opened
 330 #
 331 proc simple_diff { file_1 file_2 } {
 332     global target
 333
 334     set eof -1
 335     set differences 0
 336
 337     if [file exists $file_1] then {
 338         set file_a [open $file_1 r]
 339     } else {
 340         warning "$file_1 doesn't exist"
 341         return
 342     }
 343
 344     if [file exists $file_2] then {
 345         set file_b [open $file_2 r]
 346     } else {
 347         fail "$file_2 doesn't exist"
 348         return
 349     }
 350
 351     verbose "# Diff'ing: $file_1 $file_2\n" 2
 352
 353     while { [gets $file_a line] != $eof } {
 354         if [regexp "^#.*$" $line] then {
 355             continue
 356         } else {
 357             lappend list_a $line
 358         }
 359     }
 360     close $file_a
 361
 362     while { [gets $file_b line] != $eof } {
 363         if [regexp "^#.*$" $line] then {
 364             continue
 365         } else {
 366             lappend list_b $line
 367         }
 368     }
 369     close $file_b
 370
 371     for { set i 0 } { $i < [llength $list_a] } { incr i } {
 372         set line_a [lindex $list_a $i]
 373         set line_b [lindex $list_b $i]
 374
 375         verbose "\t$file_1: $i: $line_a\n" 3
 376         verbose "\t$file_2: $i: $line_b\n" 3
 377         if [string compare $line_a $line_b] then {
 378             verbose -log "\t$file_1: $i: $line_a\n"
 379             verbose -log "\t$file_2: $i: $line_b\n"
 380
 381             fail "Test: $target"
 382             return
 383         }
 384     }
 385
 386     if { [llength $list_a] != [llength $list_b] } {
 387         fail "Test: $target"
 388         return
 389     }
 390
 391     if $differences<1 then {
 392         pass "Test: $target"
 393     }
 394 }
 395
 396 # This definition is taken from an unreleased version of DejaGnu.  Once
 397 # that version gets released, and has been out in the world for a few
 398 # months at least, it may be safe to delete this copy.
 399 if ![string length [info proc prune_warnings]] {
 400     #
 401     # prune_warnings -- delete various system verbosities from TEXT
 402     #
 403     # An example is:
 404     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
 405     #
 406     # Sites with particular verbose os's may wish to override this in site.exp.
 407     #
 408     proc prune_warnings { text } {
 409         # This is from sun4's.  Do it for all machines for now.
 410         # The "\\1" is to try to preserve a "\n" but only if necessary.
 411         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
 412
 413         # It might be tempting to get carried away and delete blank lines, etc.
 414         # Just delete *exactly* what we're ask to, and that's it.
 415         return $text
 416     }
 417 }