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