binutils/testsuite/lib/utils-lib.exp

   1 # Copyright (C) 1993-2015 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  16
  17 # Please email any bugs, comments, and/or additions to this file to:
  18 # bug-dejagnu@prep.ai.mit.edu
  19
  20 # This file was written by Rob Savoye <rob@cygnus.com>
  21 # and extended by Ian Lance Taylor <ian@cygnus.com>
  22
  23 proc load_common_lib { name } {
  24     load_lib $name
  25 }
  26
  27 load_common_lib binutils-common.exp
  28
  29 proc binutil_version { prog } {
  30     if ![is_remote host] {
  31         set path [which $prog]
  32         if {$path == 0} then {
  33             perror "$prog can't be run, file not found."
  34             return ""
  35         }
  36     } else {
  37         set path $prog
  38     }
  39     set state [remote_exec host $prog --version]
  40     set tmp "[lindex $state 1]\n"
  41     # Should find a way to discard constant parts, keep whatever's
  42     # left, so the version string could be almost anything at all...
  43     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" "$tmp" version cyg number
  44     if ![info exists number] then {
  45         return "$path (no version number)\n"
  46     }
  47     return "$path $number\n"
  48 }
  49
  50 #
  51 # default_binutils_run
  52 #       run a program, returning the output
  53 #       sets binutils_run_failed if the program does not exist
  54 #
  55 proc default_binutils_run { prog progargs } {
  56     global binutils_run_failed
  57     global host_triplet
  58
  59     set binutils_run_failed 0
  60
  61     if ![is_remote host] {
  62         if {[which $prog] == 0} then {
  63             perror "$prog does not exist"
  64             set binutils_run_failed 1
  65             return ""
  66         }
  67     }
  68
  69     send_log "$prog $progargs\n"
  70     verbose "$prog $progargs"
  71
  72     # Gotta quote dollar-signs because they get mangled by the
  73     # shell otherwise.
  74     regsub -all "\\$" "$progargs" "\\$" progargs
  75
  76     set state [remote_exec host $prog $progargs]
  77     set exec_output [prune_warnings [lindex $state 1]]
  78     if {![string match "" $exec_output]} then {
  79         send_log "$exec_output\n"
  80         verbose "$exec_output"
  81     } else {
  82         if { [lindex $state 0] != 0 } {
  83             set exec_output "$prog exited with status [lindex $state 0]"
  84             send_log "$exec_output\n"
  85             verbose "$exec_output"
  86         }
  87     }
  88     return $exec_output
  89 }
  90
  91 #
  92 # default_binutils_assemble_flags
  93 #       assemble a file
  94 #
  95 proc default_binutils_assemble_flags { source object asflags } {
  96     global srcdir
  97     global host_triplet
  98
  99     # The HPPA assembler syntax is a little different than most, to make
 100     # the test source file assemble we need to run it through sed.
 101     #
 102     # This is a hack in that it won't scale well if other targets need
 103     # similar transformations to assemble.  We'll generalize the hack
 104     # if/when other targets need similar handling.
 105     if { [istarget "hppa*-*-*"] && ![istarget "*-*-linux*" ] } then {
 106         set sed_file $srcdir/config/hppa.sed
 107         send_log "sed -f $sed_file < $source > asm.s\n"
 108         verbose "sed -f $sed_file < $source > asm.s"
 109         catch "exec sed -f $sed_file < $source > asm.s"
 110         set source asm.s
 111     }
 112
 113     set exec_output [target_assemble $source $object $asflags]
 114     set exec_output [prune_warnings $exec_output]
 115
 116     if [string match "" $exec_output] {
 117         return 1
 118     } else {
 119         send_log "$exec_output\n"
 120         verbose "$exec_output"
 121         perror "$source: assembly failed"
 122         return 0
 123     }
 124 }
 125
 126 #
 127 # exe_ext
 128 #       Returns target executable extension, if any.
 129 #
 130 proc exe_ext {} {
 131     if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
 132         return ".exe"
 133     } else {
 134         return ""
 135     }
 136 }
 137
 138 # Copied and modified from gas.
 139
 140 # run_dump_test FILE (optional:) EXTRA_OPTIONS
 141 #
 142 # Assemble a .s file, then run some utility on it and check the output.
 143 #
 144 # There should be an assembly language file named FILE.s in the test
 145 # suite directory, and a pattern file called FILE.d.  `run_dump_test'
 146 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
 147 # `nm' on the .o file to produce textual output, and then analyze that
 148 # with regexps.  The FILE.d file specifies what program to run, and
 149 # what to expect in its output.
 150 #
 151 # The FILE.d file begins with zero or more option lines, which specify
 152 # flags to pass to the assembler, the program to run to dump the
 153 # assembler's output, and the options it wants.  The option lines have
 154 # the syntax:
 155 #
 156 #         # OPTION: VALUE
 157 #
 158 # OPTION is the name of some option, like "name" or "objdump", and
 159 # VALUE is OPTION's value.  The valid options are described below.
 160 # Whitespace is ignored everywhere, except within VALUE.  The option
 161 # list ends with the first line that doesn't match the above syntax.
 162 # However, a line within the options that begins with a #, but doesn't
 163 # have a recognizable option name followed by a colon, is considered a
 164 # comment and entirely ignored.
 165 #
 166 # The optional EXTRA_OPTIONS argument to `run_dump_test' is a list of
 167 # two-element lists.  The first element of each is an option name, and
 168 # the second additional arguments to be added on to the end of the
 169 # option list as given in FILE.d.  (If omitted, no additional options
 170 # are added.)
 171 #
 172 # The interesting options are:
 173 #
 174 #   name: TEST-NAME
 175 #       The name of this test, passed to DejaGNU's `pass' and `fail'
 176 #       commands.  If omitted, this defaults to FILE, the root of the
 177 #       .s and .d files' names.
 178 #
 179 #   as: FLAGS
 180 #       When assembling FILE.s, pass FLAGS to the assembler.
 181 #
 182 #   PROG: PROGRAM-NAME
 183 #       The name of the program to run to analyze the .o file produced
 184 #       by the assembler.  This can be omitted; run_dump_test will guess
 185 #       which program to run by seeing which of the flags options below
 186 #       is present.
 187 #
 188 #   objdump: FLAGS
 189 #   nm: FLAGS
 190 #   objcopy: FLAGS
 191 #       Use the specified program to analyze the .o file, and pass it
 192 #       FLAGS, in addition to the .o file name.  Note that they are run
 193 #       with LC_ALL=C in the environment to give consistent sorting
 194 #       of symbols.
 195 #
 196 #   source: SOURCE
 197 #       Assemble the file SOURCE.s.  If omitted, this defaults to FILE.s.
 198 #       This is useful if several .d files want to share a .s file.
 199 #
 200 #   target: GLOBS...
 201 #       Run this test only on a specified list of targets.  More precisely,
 202 #       each glob in the space-separated list is passed to "istarget"; if
 203 #       it evaluates true for any of them, the test will be run, otherwise
 204 #       it will be marked unsupported.
 205 #
 206 #   not-target: GLOBS...
 207 #       Do not run this test on a specified list of targets.  Again,
 208 #       the each glob in the space-separated list is passed to
 209 #       "istarget", and the test is run if it evaluates *false* for
 210 #       *all* of them.  Otherwise it will be marked unsupported.
 211 #
 212 #   skip: GLOBS...
 213 #   not-skip: GLOBS...
 214 #       These are exactly the same as "not-target" and "target",
 215 #       respectively, except that they do nothing at all if the check
 216 #       fails.  They should only be used in groups, to construct a single
 217 #       test which is run on all targets but with variant options or
 218 #       expected output on some targets.  (For example, see
 219 #       gas/arm/inst.d and gas/arm/wince_inst.d.)
 220 #
 221 #   error: REGEX
 222 #       An error with message matching REGEX must be emitted for the test
 223 #       to pass.  The PROG, objdump, nm and objcopy options have no
 224 #       meaning and need not supplied if this is present.
 225 #
 226 #   warning: REGEX
 227 #       Expect a gas warning matching REGEX.  It is an error to issue
 228 #       both "error" and "warning".
 229 #
 230 #   stderr: FILE
 231 #       FILE contains regexp lines to be matched against the diagnostic
 232 #       output of the assembler.  This does not preclude the use of
 233 #       PROG, nm, objdump, or objcopy.
 234 #
 235 #   error-output: FILE
 236 #       Means the same as 'stderr', but also indicates that the assembler
 237 #       is expected to exit unsuccessfully (therefore PROG, objdump, nm,
 238 #       and objcopy have no meaning and should not be supplied).
 239 #
 240 # Each option may occur at most once.
 241 #
 242 # After the option lines come regexp lines.  `run_dump_test' calls
 243 # `regexp_diff' to compare the output of the dumping tool against the
 244 # regexps in FILE.d.  `regexp_diff' is defined in binutils-common.exp;
 245 # see further comments there.
 246
 247 proc run_dump_test { name {extra_options {}} } {
 248     global subdir srcdir
 249     global OBJDUMP NM OBJCOPY READELF STRIP
 250     global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
 251     global ELFEDIT ELFEDITFLAGS
 252     global host_triplet
 253     global env
 254     global copyfile
 255     global tempfile
 256
 257     if [string match "*/*" $name] {
 258         set file $name
 259         set name [file tail $name]
 260     } else {
 261         set file "$srcdir/$subdir/$name"
 262     }
 263     set opt_array [slurp_options "${file}.d"]
 264     if { $opt_array == -1 } {
 265         perror "error reading options from $file.d"
 266         unresolved $subdir/$name
 267         return
 268     }
 269     set opts(addr2line) {}
 270     set opts(ar) {}
 271     set opts(as) {}
 272     set opts(nm) {}
 273     set opts(objcopy) {}
 274     set opts(objdump) {}
 275     set opts(strip) {}
 276     set opts(ranlib) {}
 277     set opts(readelf) {}
 278     set opts(size) {}
 279     set opts(strings) {}
 280     set opts(name) {}
 281     set opts(elfedit) {}
 282     set opts(PROG) {}
 283     set opts(DUMPPROG) {}
 284     set opts(source) {}
 285     set opts(target) {}
 286     set opts(not-target) {}
 287     set opts(skip) {}
 288     set opts(not-skip) {}
 289
 290     foreach i $opt_array {
 291         set opt_name [lindex $i 0]
 292         set opt_val [lindex $i 1]
 293         if ![info exists opts($opt_name)] {
 294             perror "unknown option $opt_name in file $file.d"
 295             unresolved $subdir/$name
 296             return
 297         }
 298
 299         # Permit the option to use $srcdir to refer to the source
 300         # directory.
 301         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 302
 303         if [string length $opts($opt_name)] {
 304             perror "option $opt_name multiply set in $file.d"
 305             unresolved $subdir/$name
 306             return
 307         }
 308         set opts($opt_name) $opt_val
 309     }
 310
 311     foreach i $extra_options {
 312         set opt_name [lindex $i 0]
 313         set opt_val [lindex $i 1]
 314         if ![info exists opts($opt_name)] {
 315             perror "unknown option $opt_name given in extra_opts"
 316             unresolved $subdir/$name
 317             return
 318         }
 319
 320         # Permit the option to use $srcdir to refer to the source
 321         # directory.
 322         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 323
 324         # add extra option to end of existing option, adding space
 325         # if necessary.
 326         if [string length $opts($opt_name)] {
 327             append opts($opt_name) " "
 328         }
 329         append opts($opt_name) $opt_val
 330     }
 331
 332     if { $opts(name) == "" } {
 333         set testname "$subdir/$name"
 334     } else {
 335         set testname $opts(name)
 336     }
 337     verbose "Testing $testname"
 338
 339     if {$opts(PROG) == ""} {
 340         perror "program isn't set in $file.d"
 341         unresolved $testname
 342         return
 343     }
 344
 345     set destopt ""
 346     switch -- $opts(PROG) {
 347         ar      { set program ar }
 348         objcopy { set program objcopy }
 349         ranlib  { set program ranlib }
 350         strip   {
 351             set program strip
 352             set destopt "-o"
 353         }
 354         strings { set program strings }
 355         elfedit { set program elfedit }
 356         nm      { set program nm }
 357         default {
 358             perror "unrecognized program option $opts(PROG) in $file.d"
 359             unresolved $testname
 360             return }
 361     }
 362
 363     set dumpprogram ""
 364     if { $opts(DUMPPROG) != "" } {
 365         switch -- $opts(DUMPPROG) {
 366             addr2line   { set dumpprogram addr2line }
 367             nm          { set dumpprogram nm }
 368             objdump     { set dumpprogram objdump }
 369             readelf     { set dumpprogram readelf }
 370             size        { set dumpprogram size }
 371             default     {
 372                 perror "unrecognized dump program option $opts(DUMPPROG) in $file.d"
 373                 unresolved $testname
 374                 return }
 375         }
 376     } else {
 377         # Guess which program to run, by seeing which option was specified.
 378         foreach p {objdump nm readelf} {
 379             if {$opts($p) != ""} {
 380                 if {$dumpprogram != ""} {
 381                     perror "ambiguous dump program in $file.d"
 382                     unresolved $testname
 383                     return
 384                 } else {
 385                     set dumpprogram $p
 386                 }
 387             }
 388         }
 389     }
 390
 391     # Handle skipping the test on specified targets.
 392     # You can have both skip/not-skip and target/not-target, but you can't
 393     # have both skip and not-skip, or target and not-target, in the same file.
 394     if { $opts(skip) != "" } then {
 395         if { $opts(not-skip) != "" } then {
 396             perror "$testname: mixing skip and not-skip directives is invalid"
 397             unresolved $testname
 398             return
 399         }
 400         foreach glob $opts(skip) {
 401             if {[istarget $glob]} { return }
 402         }
 403     }
 404     if { $opts(not-skip) != "" } then {
 405         set skip 1
 406         foreach glob $opts(not-skip) {
 407             if {[istarget $glob]} {
 408                 set skip 0
 409                 break
 410             }
 411         }
 412         if {$skip} { return }
 413     }
 414     if { $opts(target) != "" } then {
 415         if { $opts(not-target) != "" } then {
 416             perror "$testname: mixing target and not-target directives is invalid"
 417             unresolved $testname
 418             return
 419         }
 420         set skip 1
 421         foreach glob $opts(target) {
 422             if {[istarget $glob]} {
 423                 set skip 0
 424                 break
 425             }
 426         }
 427         if {$skip} {
 428             unsupported $testname
 429             return
 430         }
 431     }
 432     if { $opts(not-target) != "" } then {
 433         foreach glob $opts(not-target) {
 434             if {[istarget $glob]} {
 435                 unsupported $testname
 436                 return
 437             }
 438         }
 439     }
 440
 441     if { [string match "*--compress-debug-sections*" $opts(as)] \
 442          && ![is_zlib_supported] } {
 443         unsupported $testname
 444         return
 445     }
 446
 447     if { $opts(source) == "" } {
 448         set srcfile ${file}.s
 449     } else {
 450         set srcfile $srcdir/$subdir/$opts(source)
 451     }
 452
 453     set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
 454     if [string match "" $exec_output] then {
 455         send_log "$exec_output\n"
 456         verbose "$exec_output"
 457         fail $testname
 458         return
 459     }
 460
 461     set progopts1 $opts($program)
 462     eval set progopts \$[string toupper $program]FLAGS
 463     eval set binary \$[string toupper $program]
 464
 465     set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
 466     if ![string match "" $exec_output] {
 467         send_log "$exec_output\n"
 468         verbose "$exec_output"
 469         fail $testname
 470         return
 471     }
 472
 473     set progopts1 $opts($dumpprogram)
 474     eval set progopts \$[string toupper $dumpprogram]FLAGS
 475     eval set binary \$[string toupper $dumpprogram]
 476
 477     if { ![is_remote host] && [which $binary] == 0 } {
 478         untested $testname
 479         return
 480     }
 481
 482     verbose "running $binary $progopts $progopts1" 3
 483
 484     set cmd "$binary $progopts $progopts1 ${copyfile}.o"
 485
 486     # Ensure consistent sorting of symbols
 487     if {[info exists env(LC_ALL)]} {
 488         set old_lc_all $env(LC_ALL)
 489     }
 490     set env(LC_ALL) "C"
 491     send_log "$cmd\n"
 492     set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
 493     if {[info exists old_lc_all]} {
 494         set env(LC_ALL) $old_lc_all
 495     } else {
 496         unset env(LC_ALL)
 497     }
 498     if { [lindex $comp_output 0] != 0 } then {
 499         send_log "$comp_output\n"
 500         fail $testname
 501         return
 502     }
 503     set comp_output [prune_warnings [lindex $comp_output 1]]
 504     if ![string match "" $comp_output] then {
 505         send_log "$comp_output\n"
 506         fail $testname
 507         return
 508     }
 509
 510     verbose_eval {[file_contents "tmpdir/dump.out"]} 3
 511     if { [regexp_diff "tmpdir/dump.out" "${file}.d"] } then {
 512         fail $testname
 513         verbose "output is [file_contents "tmpdir/dump.out"]" 2
 514         return
 515     }
 516
 517     pass $testname
 518 }
 519
 520 proc slurp_options { file } {
 521     if [catch { set f [open $file r] } x] {
 522         #perror "couldn't open `$file': $x"
 523         perror "$x"
 524         return -1
 525     }
 526     set opt_array {}
 527     # whitespace expression
 528     set ws  {[  ]*}
 529     set nws {[^         ]*}
 530     # whitespace is ignored anywhere except within the options list;
 531     # option names are alphabetic plus dash
 532     set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
 533     while { [gets $f line] != -1 } {
 534         set line [string trim $line]
 535         # Whitespace here is space-tab.
 536         if [regexp $pat $line xxx opt_name opt_val] {
 537             # match!
 538             lappend opt_array [list $opt_name $opt_val]
 539         } elseif {![regexp "^#" $line ]} {
 540             break
 541         }
 542     }
 543     close $f
 544     return $opt_array
 545 }
 546
 547 proc file_contents { filename } {
 548     set file [open $filename r]
 549     set contents [read $file]
 550     close $file
 551     return $contents
 552 }
 553
 554 proc verbose_eval { expr { level 1 } } {
 555     global verbose
 556     if $verbose>$level then { eval verbose "$expr" $level }
 557 }