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 modify or analyze the .o file
 184 #       produced by the assembler.  This option is required.  Recognised
 185 #       names are: ar, elfedit, nm, objcopy, ranlib, strings, and strip.
 186 #
 187 #   DUMPPROG: PROGRAM-NAME
 188 #       The name of the program to run to analyze the .o file after it has
 189 #       has been modified by PROG.  This can be omitted; run_dump_test will
 190 #       guess which program to run by seeing if any of the flags options
 191 #       for the recognised dump programs are set.  Recognised names are:
 192 #       addr2line, nm, objdump, readelf and size.
 193 #
 194 #   nm: FLAGS
 195 #   objcopy: FLAGS
 196 #   objdump: FLAGS
 197 #   readelf: FLAGS
 198 #   size: FLAGS
 199 #       Use the specified program to analyze the .o file, and pass it
 200 #       FLAGS, in addition to the .o file name.  Note that they are run
 201 #       with LC_ALL=C in the environment to give consistent sorting
 202 #       of symbols.
 203 #
 204 #   source: SOURCE
 205 #       Assemble the file SOURCE.s.  If omitted, this defaults to FILE.s.
 206 #       This is useful if several .d files want to share a .s file.
 207 #
 208 #   target: GLOBS...
 209 #       Run this test only on a specified list of targets.  More precisely,
 210 #       each glob in the space-separated list is passed to "istarget"; if
 211 #       it evaluates true for any of them, the test will be run, otherwise
 212 #       it will be marked unsupported.
 213 #
 214 #   not-target: GLOBS...
 215 #       Do not run this test on a specified list of targets.  Again,
 216 #       the each glob in the space-separated list is passed to
 217 #       "istarget", and the test is run if it evaluates *false* for
 218 #       *all* of them.  Otherwise it will be marked unsupported.
 219 #
 220 #   skip: GLOBS...
 221 #   not-skip: GLOBS...
 222 #       These are exactly the same as "not-target" and "target",
 223 #       respectively, except that they do nothing at all if the check
 224 #       fails.  They should only be used in groups, to construct a single
 225 #       test which is run on all targets but with variant options or
 226 #       expected output on some targets.  (For example, see
 227 #       gas/arm/inst.d and gas/arm/wince_inst.d.)
 228 #
 229 #   error: REGEX
 230 #       An error with message matching REGEX must be emitted for the test
 231 #       to pass.  The PROG, objdump, nm and objcopy options have no
 232 #       meaning and need not supplied if this is present.
 233 #
 234 #   warning: REGEX
 235 #       Expect a gas warning matching REGEX.  It is an error to issue
 236 #       both "error" and "warning".
 237 #
 238 #   stderr: FILE
 239 #       FILE contains regexp lines to be matched against the diagnostic
 240 #       output of the assembler.  This does not preclude the use of
 241 #       PROG, nm, objdump, or objcopy.
 242 #
 243 #   error-output: FILE
 244 #       Means the same as 'stderr', but also indicates that the assembler
 245 #       is expected to exit unsuccessfully (therefore PROG, objdump, nm,
 246 #       and objcopy have no meaning and should not be supplied).
 247 #
 248 # Each option may occur at most once.
 249 #
 250 # After the option lines come regexp lines.  `run_dump_test' calls
 251 # `regexp_diff' to compare the output of the dumping tool against the
 252 # regexps in FILE.d.  `regexp_diff' is defined in binutils-common.exp;
 253 # see further comments there.
 254
 255 proc run_dump_test { name {extra_options {}} } {
 256     global subdir srcdir
 257     global OBJDUMP NM OBJCOPY READELF STRIP
 258     global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
 259     global ELFEDIT ELFEDITFLAGS
 260     global host_triplet
 261     global env
 262     global copyfile
 263     global tempfile
 264
 265     if [string match "*/*" $name] {
 266         set file $name
 267         set name [file tail $name]
 268     } else {
 269         set file "$srcdir/$subdir/$name"
 270     }
 271     set opt_array [slurp_options "${file}.d"]
 272     if { $opt_array == -1 } {
 273         perror "error reading options from $file.d"
 274         unresolved $subdir/$name
 275         return
 276     }
 277     set opts(addr2line) {}
 278     set opts(ar) {}
 279     set opts(as) {}
 280     set opts(elfedit) {}
 281     set opts(name) {}
 282     set opts(nm) {}
 283     set opts(objcopy) {}
 284     set opts(objdump) {}
 285     set opts(ranlib) {}
 286     set opts(readelf) {}
 287     set opts(size) {}
 288     set opts(strings) {}
 289     set opts(strip) {}
 290     set opts(PROG) {}
 291     set opts(DUMPPROG) {}
 292     set opts(source) {}
 293     set opts(target) {}
 294     set opts(not-target) {}
 295     set opts(skip) {}
 296     set opts(not-skip) {}
 297
 298     foreach i $opt_array {
 299         set opt_name [lindex $i 0]
 300         set opt_val [lindex $i 1]
 301         if ![info exists opts($opt_name)] {
 302             perror "unknown option $opt_name in file $file.d"
 303             unresolved $subdir/$name
 304             return
 305         }
 306
 307         # Permit the option to use $srcdir to refer to the source
 308         # directory.
 309         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 310
 311         if [string length $opts($opt_name)] {
 312             perror "option $opt_name multiply set in $file.d"
 313             unresolved $subdir/$name
 314             return
 315         }
 316         set opts($opt_name) $opt_val
 317     }
 318
 319     foreach i $extra_options {
 320         set opt_name [lindex $i 0]
 321         set opt_val [lindex $i 1]
 322         if ![info exists opts($opt_name)] {
 323             perror "unknown option $opt_name given in extra_opts"
 324             unresolved $subdir/$name
 325             return
 326         }
 327
 328         # Permit the option to use $srcdir to refer to the source
 329         # directory.
 330         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 331
 332         # add extra option to end of existing option, adding space
 333         # if necessary.
 334         if [string length $opts($opt_name)] {
 335             append opts($opt_name) " "
 336         }
 337         append opts($opt_name) $opt_val
 338     }
 339
 340     if { $opts(name) == "" } {
 341         set testname "$subdir/$name"
 342     } else {
 343         set testname $opts(name)
 344     }
 345     verbose "Testing $testname"
 346
 347     if {$opts(PROG) == ""} {
 348         perror "PROG isn't set in $file.d"
 349         unresolved $testname
 350         return
 351     }
 352
 353     set destopt ""
 354     switch -- $opts(PROG) {
 355         ar      { set program ar }
 356         elfedit { set program elfedit }
 357         nm      { set program nm }
 358         objcopy { set program objcopy }
 359         ranlib  { set program ranlib }
 360         strings { set program strings }
 361         strip   {
 362             set program strip
 363             set destopt "-o"
 364         }
 365         default {
 366             perror "unrecognized program option $opts(PROG) in $file.d"
 367             unresolved $testname
 368             return }
 369     }
 370
 371     set dumpprogram ""
 372     if { $opts(DUMPPROG) != "" } {
 373         switch -- $opts(DUMPPROG) {
 374             addr2line   { set dumpprogram addr2line }
 375             nm          { set dumpprogram nm }
 376             objdump     { set dumpprogram objdump }
 377             readelf     { set dumpprogram readelf }
 378             size        { set dumpprogram size }
 379             default     {
 380                 perror "unrecognized dump program option $opts(DUMPPROG) in $file.d"
 381                 unresolved $testname
 382                 return }
 383         }
 384     } else {
 385         # Guess which program to run, by seeing which option was specified.
 386         foreach p {addr2line nm objdump readelf size} {
 387             if {$opts($p) != ""} {
 388                 if {$dumpprogram != ""} {
 389                     perror "more than one possible dump program specified in $file.d"
 390                     unresolved $testname
 391                     return
 392                 } else {
 393                     set dumpprogram $p
 394                 }
 395             }
 396         }
 397     }
 398
 399     # Handle skipping the test on specified targets.
 400     # You can have both skip/not-skip and target/not-target, but you can't
 401     # have both skip and not-skip, or target and not-target, in the same file.
 402     if { $opts(skip) != "" } then {
 403         if { $opts(not-skip) != "" } then {
 404             perror "$testname: mixing skip and not-skip directives is invalid"
 405             unresolved $testname
 406             return
 407         }
 408         foreach glob $opts(skip) {
 409             if {[istarget $glob]} { return }
 410         }
 411     }
 412     if { $opts(not-skip) != "" } then {
 413         set skip 1
 414         foreach glob $opts(not-skip) {
 415             if {[istarget $glob]} {
 416                 set skip 0
 417                 break
 418             }
 419         }
 420         if {$skip} { return }
 421     }
 422     if { $opts(target) != "" } then {
 423         set skip 1
 424         foreach glob $opts(target) {
 425             if {[istarget $glob]} {
 426                 set skip 0
 427                 break
 428             }
 429         }
 430         if {$skip} {
 431             unsupported $testname
 432             return
 433         }
 434     }
 435     if { $opts(not-target) != "" } then {
 436         foreach glob $opts(not-target) {
 437             if {[istarget $glob]} {
 438                 unsupported $testname
 439                 return
 440             }
 441         }
 442     }
 443
 444     if { $opts(source) == "" } {
 445         set srcfile ${file}.s
 446     } else {
 447         set srcfile $srcdir/$subdir/$opts(source)
 448     }
 449
 450     set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
 451     if [string match "" $exec_output] then {
 452         send_log "$exec_output\n"
 453         verbose "$exec_output"
 454         fail $testname
 455         return
 456     }
 457
 458     set progopts1 $opts($program)
 459     eval set progopts \$[string toupper $program]FLAGS
 460     eval set binary \$[string toupper $program]
 461
 462     set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
 463     if ![string match "" $exec_output] {
 464         send_log "$exec_output\n"
 465         verbose "$exec_output"
 466         fail $testname
 467         return
 468     }
 469
 470     set progopts1 $opts($dumpprogram)
 471     eval set progopts \$[string toupper $dumpprogram]FLAGS
 472     eval set binary \$[string toupper $dumpprogram]
 473
 474     if { ![is_remote host] && [which $binary] == 0 } {
 475         untested $testname
 476         return
 477     }
 478
 479     verbose "running $binary $progopts $progopts1" 3
 480
 481     set cmd "$binary $progopts $progopts1 ${copyfile}.o"
 482
 483     # Ensure consistent sorting of symbols
 484     if {[info exists env(LC_ALL)]} {
 485         set old_lc_all $env(LC_ALL)
 486     }
 487     set env(LC_ALL) "C"
 488     send_log "$cmd\n"
 489     set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
 490     if {[info exists old_lc_all]} {
 491         set env(LC_ALL) $old_lc_all
 492     } else {
 493         unset env(LC_ALL)
 494     }
 495     if { [lindex $comp_output 0] != 0 } then {
 496         send_log "$comp_output\n"
 497         fail $testname
 498         return
 499     }
 500     set comp_output [prune_warnings [lindex $comp_output 1]]
 501     if ![string match "" $comp_output] then {
 502         send_log "$comp_output\n"
 503         fail $testname
 504         return
 505     }
 506
 507     verbose_eval {[file_contents "tmpdir/dump.out"]} 3
 508     if { [regexp_diff "tmpdir/dump.out" "${file}.d"] } then {
 509         fail $testname
 510         verbose "output is [file_contents "tmpdir/dump.out"]" 2
 511         return
 512     }
 513
 514     pass $testname
 515 }
 516
 517 proc slurp_options { file } {
 518     if [catch { set f [open $file r] } x] {
 519         #perror "couldn't open `$file': $x"
 520         perror "$x"
 521         return -1
 522     }
 523     set opt_array {}
 524     # whitespace expression
 525     set ws  {[  ]*}
 526     set nws {[^         ]*}
 527     # whitespace is ignored anywhere except within the options list;
 528     # option names are alphabetic plus dash
 529     set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
 530     while { [gets $f line] != -1 } {
 531         set line [string trim $line]
 532         # Whitespace here is space-tab.
 533         if [regexp $pat $line xxx opt_name opt_val] {
 534             # match!
 535             lappend opt_array [list $opt_name $opt_val]
 536         } elseif {![regexp "^#" $line ]} {
 537             break
 538         }
 539     }
 540     close $f
 541     return $opt_array
 542 }
 543
 544 proc file_contents { filename } {
 545     set file [open $filename r]
 546     set contents [read $file]
 547     close $file
 548     return $contents
 549 }
 550
 551 proc verbose_eval { expr { level 1 } } {
 552     global verbose
 553     if $verbose>$level then { eval verbose "$expr" $level }
 554 }