ld/testsuite/lib/ld.exp

   1 #
   2 # default_ld_version
   3 #       extract and print the version number of ld
   4 #
   5 proc default_ld_version { ld } {
   6     global host_triplet
   7
   8     if { [which $ld] == 0 } then {
   9         perror "$ld does not exist"
  10         exit 1
  11     }
  12
  13     catch "exec $ld --version" tmp
  14     set tmp [prune_system_crud $host_triplet $tmp]
  15     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" $tmp version cyg number
  16     if [info exists number] then {
  17         clone_output "$ld $number\n"
  18     }
  19 }
  20
  21 #
  22 # default_ld_relocate
  23 #       link an object using relocation
  24 #
  25 proc default_ld_relocate { ld target objects } {
  26     global HOSTING_EMU
  27     global host_triplet
  28
  29     if { [which $ld] == 0 } then {
  30         perror "$ld does not exist"
  31         return 0
  32     }
  33
  34     verbose -log "$ld $HOSTING_EMU -o $target -r $objects"
  35
  36     catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
  37     set exec_output [prune_system_crud $host_triplet $exec_output]
  38     if [string match "" $exec_output] then {
  39         return 1
  40     } else {
  41         verbose -log "$exec_output"
  42         return 0
  43     }
  44 }
  45
  46
  47 #
  48 # default_ld_link
  49 #       link a program using ld
  50 #
  51 proc default_ld_link { ld target objects } {
  52     global HOSTING_EMU
  53     global HOSTING_CRT0
  54     global HOSTING_LIBS
  55     global host_triplet
  56
  57     set objs "$HOSTING_CRT0 $objects"
  58     set libs "$HOSTING_LIBS"
  59
  60     if { [which $ld] == 0 } then {
  61         perror "$ld does not exist"
  62         return 0
  63     }
  64
  65     verbose -log "$ld $HOSTING_EMU -o $target $objs $libs"
  66
  67     catch "exec $ld $HOSTING_EMU -o $target $objs $libs" exec_output
  68     set exec_output [prune_system_crud $host_triplet $exec_output]
  69     if [string match "" $exec_output] then {
  70         return 1
  71     } else {
  72         verbose -log "$exec_output"
  73         return 0
  74     }
  75 }
  76
  77 #
  78 # default_ld_simple_link
  79 #       link a program using ld, without including any libraries
  80 #
  81 proc default_ld_simple_link { ld target objects } {
  82     global host_triplet
  83
  84     if { [which $ld] == 0 } then {
  85         perror "$ld does not exist"
  86         return 0
  87     }
  88
  89     verbose -log "$ld -o $target $objects"
  90
  91     catch "exec $ld -o $target $objects" exec_output
  92     set exec_output [prune_system_crud $host_triplet $exec_output]
  93
  94     # We don't care if we get a warning about a non-existent start
  95     # symbol, since the default linker script might use ENTRY.
  96     regsub -all "(^|\n)($ld: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
  97
  98     if [string match "" $exec_output] then {
  99         return 1
 100     } else {
 101         verbose -log "$exec_output"
 102         return 0
 103     }
 104 }
 105
 106 #
 107 # default_ld_compile
 108 #       compile an object using cc
 109 #
 110 proc default_ld_compile { cc source object } {
 111     global CFLAGS
 112     global srcdir
 113     global subdir
 114     global host_triplet
 115
 116     set cc_prog $cc
 117     if {[llength $cc_prog] > 1} then {
 118         set cc_prog [lindex $cc_prog 0]
 119     }
 120     if {[which $cc_prog] == 0} then {
 121         perror "$cc_prog does not exist"
 122         return 0
 123     }
 124
 125     catch "exec rm -f $object" exec_output
 126
 127     verbose -log "$cc -I$srcdir$subdir -c $CFLAGS $source -o $object"
 128
 129     catch "exec $cc -I$srcdir$subdir -c $CFLAGS $source -o $object" exec_output
 130     set exec_output [prune_system_crud $host_triplet $exec_output]
 131     if [string match "" $exec_output] then {
 132         if {![file exists $object]} then {
 133             regexp ".*/(\[^/\]*)$" $source all dobj
 134             regsub "\\.c" $dobj ".o" realobj
 135             verbose "looking for $realobj"
 136             if {[file exists $realobj]} then {
 137                 verbose -log "mv $realobj $object"
 138                 catch "exec mv $realobj $object" exec_output
 139                 set exec_output [prune_system_crud $host_triplet $exec_output]
 140                 if {![string match "" $exec_output]} then {
 141                     verbose -log "$exec_output"
 142                     perror "could not move $realobj to $object"
 143                     return 0
 144                 }
 145             } else {
 146                 perror "$object not found after compilation"
 147                 return 0
 148             }
 149         }
 150         return 1
 151     } else {
 152         verbose -log "$exec_output"
 153         perror "$source: compilation failed"
 154         return 0
 155     }
 156 }
 157
 158 #
 159 # default_ld_assemble
 160 #       assemble a file
 161 #
 162 proc default_ld_assemble { as source object } {
 163     global ASFLAGS
 164     global host_triplet
 165
 166     if {[which $as] == 0} then {
 167         perror "$as does not exist"
 168         return 0
 169     }
 170
 171     if ![info exists ASFLAGS] { set ASFLAGS "" }
 172
 173     verbose -log "$as $ASFLAGS -o $object $source"
 174
 175     catch "exec $as $ASFLAGS -o $object $source" exec_output
 176     set exec_output [prune_system_crud $host_triplet $exec_output]
 177     if [string match "" $exec_output] then {
 178         return 1
 179     } else {
 180         verbose -log "$exec_output"
 181         perror "$source: assembly failed"
 182         return 0
 183     }
 184 }
 185
 186 #
 187 # default_ld_nm
 188 #       run nm on a file, putting the result in the array nm_output
 189 #
 190 proc default_ld_nm { nm object } {
 191     global NMFLAGS
 192     global nm_output
 193     global host_triplet
 194
 195     if {[which $nm] == 0} then {
 196         perror "$nm does not exist"
 197         return 0
 198     }
 199
 200     if ![info exists NMFLAGS] { set NMFLAGS "" }
 201
 202     verbose -log "$nm $NMFLAGS $object >tmpdir/nm.out"
 203
 204     catch "exec $nm $NMFLAGS $object >tmpdir/nm.out" exec_output
 205     set exec_output [prune_system_crud $host_triplet $exec_output]
 206     if [string match "" $exec_output] then {
 207         set file [open tmpdir/nm.out r]
 208         while { [gets $file line] != -1 } {
 209             verbose "$line" 2
 210             if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] (.+)$" $line whole value name] {
 211                 verbose "Setting nm_output($name) to 0x$value" 2
 212                 set nm_output($name) 0x$value
 213             }
 214         }
 215         close $file
 216         return 1
 217     } else {
 218         verbose -log "$exec_output"
 219         perror "$object: nm failed"
 220         return 0
 221     }
 222 }
 223
 224 #
 225 # simple_diff
 226 #       compares two files line-by-line
 227 #       returns differences if exist
 228 #       returns null if file(s) cannot be opened
 229 #
 230 proc simple_diff { file_1 file_2 } {
 231     global target
 232
 233     set eof -1
 234     set differences 0
 235
 236     if [file exists $file_1] then {
 237         set file_a [open $file_1 r]
 238     } else {
 239         warning "$file_1 doesn't exist"
 240         return
 241     }
 242
 243     if [file exists $file_2] then {
 244         set file_b [open $file_2 r]
 245     } else {
 246         fail "$file_2 doesn't exist"
 247         return
 248     }
 249
 250     verbose "# Diff'ing: $file_1 $file_2\n" 2
 251
 252     while { [gets $file_a line] != $eof } {
 253         if [regexp "^#.*$" $line] then {
 254             continue
 255         } else {
 256             lappend list_a $line
 257         }
 258     }
 259     close $file_a
 260
 261     while { [gets $file_b line] != $eof } {
 262         if [regexp "^#.*$" $line] then {
 263             continue
 264         } else {
 265             lappend list_b $line
 266         }
 267     }
 268     close $file_b
 269
 270     for { set i 0 } { $i < [llength $list_a] } { incr i } {
 271         set line_a [lindex $list_a $i]
 272         set line_b [lindex $list_b $i]
 273
 274         verbose "\t$file_1: $i: $line_a\n" 3
 275         verbose "\t$file_2: $i: $line_b\n" 3
 276         if [string compare $line_a $line_b] then {
 277             verbose -log "\t$file_1: $i: $line_a\n"
 278             verbose -log "\t$file_2: $i: $line_b\n"
 279
 280             fail "Test: $target"
 281             return
 282         }
 283     }
 284
 285     if { [llength $list_a] != [llength $list_b] } {
 286         fail "Test: $target"
 287         return
 288     }
 289
 290     if $differences<1 then {
 291         pass "Test: $target"
 292     }
 293 }
 294
 295 # This definition is taken from an unreleased version of DejaGnu.  Once
 296 # that version gets released, and has been out in the world for a few
 297 # months at least, it may be safe to delete this copy.
 298 if ![string length [info proc prune_system_crud]] {
 299     #
 300     # prune_system_crud -- delete various system verbosities from TEXT on SYSTEM
 301     #
 302     # An example is:
 303     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
 304     #
 305     # SYSTEM is typical $target_triplet or $host_triplet.
 306     #
 307     # This is useful when trying to do pattern matches on program output.
 308     # Sites with particular verbose os's may wish to override this in site.exp.
 309     #
 310     proc prune_system_crud { system text } {
 311         # This is from sun4's.  Do it for all machines for now.
 312         # The "\\1" is to try to preserve a "\n" but only if necessary.
 313         regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
 314
 315         # It might be tempting to get carried away and delete blank lines, etc.
 316         # Just delete *exactly* what we're ask to, and that's it.
 317         return $text
 318     }
 319 }