binutils/testsuite/lib/utils-lib.exp

   1 # Copyright (C) 1993-2018 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 #       sets binutils_run_status to the exit status of the program
  55 #
  56 proc default_binutils_run { prog progargs } {
  57     global binutils_run_failed
  58     global binutils_run_status
  59     global host_triplet
  60
  61     set binutils_run_failed 0
  62     if [info exists binutils_run_status] {
  63         unset binutils_run_status
  64     }
  65
  66     if ![is_remote host] {
  67         if {[which $prog] == 0} then {
  68             perror "$prog does not exist"
  69             set binutils_run_failed 1
  70             return ""
  71         }
  72     }
  73
  74     # For objdump, automatically translate standard section
  75     # names to the targets one, if they are different.
  76     set sect_names [get_standard_section_names]
  77     if { $sect_names != "" && [string match "*objdump" $prog] } {
  78         regsub -- "-j \\.text" $progargs "-j [lindex $sect_names 0]" progargs
  79         regsub -- "-j \\.data" $progargs "-j [lindex $sect_names 1]" progargs
  80         regsub -- "-j \\.bss"  $progargs "-j [lindex $sect_names 2]" progargs
  81     }
  82
  83     send_log "$prog $progargs\n"
  84     verbose "$prog $progargs"
  85
  86     # Gotta quote dollar-signs because they get mangled by the
  87     # shell otherwise.
  88     regsub -all "\\$" "$progargs" "\\$" progargs
  89
  90     set state [remote_exec host $prog $progargs]
  91     set binutils_run_status [lindex $state 0]
  92     set exec_output [prune_warnings [lindex $state 1]]
  93     if {![string match "" $exec_output]} then {
  94         send_log "$exec_output\n"
  95         verbose "$exec_output"
  96     } else {
  97         if { [lindex $state 0] != 0 } {
  98             set exec_output "$prog exited with status [lindex $state 0]"
  99             send_log "$exec_output\n"
 100             verbose "$exec_output"
 101         }
 102     }
 103     return $exec_output
 104 }
 105
 106 #
 107 # default_binutils_assemble_flags
 108 #       assemble a file
 109 #
 110 proc default_binutils_assemble_flags { source object asflags } {
 111     global srcdir
 112     global host_triplet
 113
 114     # The HPPA assembler syntax is a little different than most, to make
 115     # the test source file assemble we need to run it through sed.
 116     #
 117     # This is a hack in that it won't scale well if other targets need
 118     # similar transformations to assemble.  We'll generalize the hack
 119     # if/when other targets need similar handling.
 120     if { [istarget "hppa*-*-*"] && ![istarget "*-*-linux*" ] } then {
 121         set sed_file $srcdir/config/hppa.sed
 122         send_log "sed -f $sed_file < $source > asm.s\n"
 123         verbose "sed -f $sed_file < $source > asm.s"
 124         catch "exec sed -f $sed_file < $source > asm.s"
 125         set source asm.s
 126     }
 127
 128     set exec_output [target_assemble $source $object $asflags]
 129     set exec_output [prune_warnings $exec_output]
 130
 131     if [string match "" $exec_output] {
 132         return 1
 133     } else {
 134         send_log "$exec_output\n"
 135         verbose "$exec_output"
 136         return 0
 137     }
 138 }
 139
 140 #
 141 # exe_ext
 142 #       Returns target executable extension, if any.
 143 #
 144 proc exe_ext {} {
 145     if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
 146         return ".exe"
 147     } else {
 148         return ""
 149     }
 150 }
 151
 152 # Copied and modified from gas.
 153
 154 # run_dump_test FILE (optional:) EXTRA_OPTIONS
 155 #
 156 # Assemble a .s file, then run some utility on it and check the output.
 157 #
 158 # There should be an assembly language file named FILE.s in the test
 159 # suite directory, and a pattern file called FILE.d.  `run_dump_test'
 160 # will assemble FILE.s, run some tool like `objdump', `objcopy', or
 161 # `nm' on the .o file to produce textual output, and then analyze that
 162 # with regexps.  The FILE.d file specifies what program to run, and
 163 # what to expect in its output.
 164 #
 165 # The FILE.d file begins with zero or more option lines, which specify
 166 # flags to pass to the assembler, the program to run to dump the
 167 # assembler's output, and the options it wants.  The option lines have
 168 # the syntax:
 169 #
 170 #         # OPTION: VALUE
 171 #
 172 # OPTION is the name of some option, like "name" or "objdump", and
 173 # VALUE is OPTION's value.  The valid options are described below.
 174 # Whitespace is ignored everywhere, except within VALUE.  The option
 175 # list ends with the first line that doesn't match the above syntax.
 176 # However, a line within the options that begins with a #, but doesn't
 177 # have a recognizable option name followed by a colon, is considered a
 178 # comment and entirely ignored.
 179 #
 180 # The optional EXTRA_OPTIONS argument to `run_dump_test' is a list of
 181 # two-element lists.  The first element of each is an option name, and
 182 # the second additional arguments to be added on to the end of the
 183 # option list as given in FILE.d.  (If omitted, no additional options
 184 # are added.)
 185 #
 186 # The interesting options are:
 187 #
 188 #   name: TEST-NAME
 189 #       The name of this test, passed to DejaGNU's `pass' and `fail'
 190 #       commands.  If omitted, this defaults to FILE, the root of the
 191 #       .s and .d files' names.
 192 #
 193 #   as: FLAGS
 194 #       When assembling FILE.s, pass FLAGS to the assembler.
 195 #
 196 #   PROG: PROGRAM-NAME
 197 #       The name of the program to run to modify or analyze the .o file
 198 #       produced by the assembler.  This option is required.  Recognised
 199 #       names are: ar, elfedit, nm, objcopy, ranlib, strings, and strip.
 200 #
 201 #   DUMPPROG: PROGRAM-NAME
 202 #       The name of the program to run to analyze the .o file after it has
 203 #       has been modified by PROG.  This can be omitted; run_dump_test will
 204 #       guess which program to run by seeing if any of the flags options
 205 #       for the recognised dump programs are set.  Recognised names are:
 206 #       addr2line, nm, objdump, readelf and size.
 207 #
 208 #   nm: FLAGS
 209 #   objcopy: FLAGS
 210 #   objdump: FLAGS
 211 #   readelf: FLAGS
 212 #   size: FLAGS
 213 #       Use the specified program to analyze the .o file, and pass it
 214 #       FLAGS, in addition to the .o file name.  Note that they are run
 215 #       with LC_ALL=C in the environment to give consistent sorting
 216 #       of symbols.
 217 #
 218 #   source: SOURCE
 219 #       Assemble the file SOURCE.s.  If omitted, this defaults to FILE.s.
 220 #       This is useful if several .d files want to share a .s file.
 221 #
 222 #   dump: DUMP
 223 #       Match against DUMP.d.  If omitted, this defaults to FILE.d.  This
 224 #       is useful if several .d files differ by options only.  Options are
 225 #       always read from FILE.d.
 226 #
 227 #   target: GLOBS...
 228 #       Run this test only on a specified list of targets.  More precisely,
 229 #       each glob in the space-separated list is passed to "istarget"; if
 230 #       it evaluates true for any of them, the test will be run, otherwise
 231 #       it will be marked unsupported.
 232 #
 233 #   not-target: GLOBS...
 234 #       Do not run this test on a specified list of targets.  Again,
 235 #       the each glob in the space-separated list is passed to
 236 #       "istarget", and the test is run if it evaluates *false* for
 237 #       *all* of them.  Otherwise it will be marked unsupported.
 238 #
 239 #   skip: GLOBS...
 240 #   not-skip: GLOBS...
 241 #       These are exactly the same as "not-target" and "target",
 242 #       respectively, except that they do nothing at all if the check
 243 #       fails.  They should only be used in groups, to construct a single
 244 #       test which is run on all targets but with variant options or
 245 #       expected output on some targets.  (For example, see
 246 #       gas/arm/inst.d and gas/arm/wince_inst.d.)
 247 #
 248 #   error: REGEX
 249 #       An error with message matching REGEX must be emitted for the test
 250 #       to pass.  The DUMPPROG, addr2line, nm, objdump, readelf and size
 251 #       options have no meaning and need not supplied if this is present.
 252 #       Multiple "error" directives append to the expected error message.
 253 #
 254 #   error_output: FILE
 255 #       Means the same as 'error', except the regular expression lines
 256 #       are contains in FILE.
 257 #
 258 #   warning: REGEX
 259 #       Expect a warning matching REGEX.  It is an error to issue both
 260 #       "error" and "warning".  Multiple "warning" directives append to
 261 #       the expected linker warning message.
 262 #
 263 #   warning_output: FILE
 264 #       Means the same as 'warning', except the regular expression
 265 #       lines are contains in FILE.
 266 #
 267 # Each option may occur at most once.
 268 #
 269 # After the option lines come regexp lines.  `run_dump_test' calls
 270 # `regexp_diff' to compare the output of the dumping tool against the
 271 # regexps in FILE.d.  `regexp_diff' is defined in binutils-common.exp;
 272 # see further comments there.
 273
 274 proc run_dump_test { name {extra_options {}} } {
 275     global subdir srcdir
 276     global OBJDUMP NM OBJCOPY READELF STRIP
 277     global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
 278     global ELFEDIT ELFEDITFLAGS
 279     global binutils_run_status
 280     global host_triplet
 281     global env
 282     global copyfile
 283     global tempfile
 284
 285     if [string match "*/*" $name] {
 286         set file $name
 287         set name [file tail $name]
 288     } else {
 289         set file "$srcdir/$subdir/$name"
 290     }
 291     set opt_array [slurp_options "${file}.d"]
 292     if { $opt_array == -1 } {
 293         perror "error reading options from $file.d"
 294         unresolved $subdir/$name
 295         return
 296     }
 297     set opts(addr2line) {}
 298     set opts(ar) {}
 299     set opts(as) {}
 300     set opts(elfedit) {}
 301     set opts(name) {}
 302     set opts(nm) {}
 303     set opts(objcopy) {}
 304     set opts(objdump) {}
 305     set opts(ranlib) {}
 306     set opts(readelf) {}
 307     set opts(size) {}
 308     set opts(strings) {}
 309     set opts(strip) {}
 310     set opts(PROG) {}
 311     set opts(DUMPPROG) {}
 312     set opts(source) {}
 313     set opts(dump) {}
 314     set opts(error) {}
 315     set opts(warning) {}
 316     set opts(error_output) {}
 317     set opts(warning_output) {}
 318     set opts(target) {}
 319     set opts(not-target) {}
 320     set opts(skip) {}
 321     set opts(not-skip) {}
 322
 323     foreach i $opt_array {
 324         set opt_name [lindex $i 0]
 325         set opt_val [lindex $i 1]
 326         if ![info exists opts($opt_name)] {
 327             perror "unknown option $opt_name in file $file.d"
 328             unresolved $subdir/$name
 329             return
 330         }
 331
 332         # Permit the option to use $srcdir to refer to the source
 333         # directory.
 334         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 335
 336         switch -- $opt_name {
 337             warning {}
 338             error {}
 339             default {
 340                 if [string length $opts($opt_name)] {
 341                     perror "option $opt_name multiply set in $file.d"
 342                     unresolved $subdir/$name
 343                     return
 344                 }
 345             }
 346         }
 347         append opts($opt_name) $opt_val
 348     }
 349
 350     foreach i $extra_options {
 351         set opt_name [lindex $i 0]
 352         set opt_val [lindex $i 1]
 353         if ![info exists opts($opt_name)] {
 354             perror "unknown option $opt_name given in extra_opts"
 355             unresolved $subdir/$name
 356             return
 357         }
 358
 359         # Permit the option to use $srcdir to refer to the source
 360         # directory.
 361         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 362
 363         # add extra option to end of existing option, adding space
 364         # if necessary.
 365         if { ![regexp "warning|error" $opt_name]
 366              && [string length $opts($opt_name)] } {
 367             append opts($opt_name) " "
 368         }
 369         append opts($opt_name) $opt_val
 370     }
 371
 372     if { $opts(name) == "" } {
 373         set testname "$subdir/$name"
 374     } else {
 375         set testname $opts(name)
 376     }
 377     verbose "Testing $testname"
 378
 379     if {$opts(PROG) == ""} {
 380         perror "PROG isn't set in $file.d"
 381         unresolved $testname
 382         return
 383     }
 384
 385     set destopt ""
 386     switch -- $opts(PROG) {
 387         ar      { set program ar }
 388         elfedit { set program elfedit }
 389         nm      { set program nm }
 390         objcopy { set program objcopy }
 391         ranlib  { set program ranlib }
 392         strings { set program strings }
 393         strip   {
 394             set program strip
 395             set destopt "-o"
 396         }
 397         default {
 398             perror "unrecognized program option $opts(PROG) in $file.d"
 399             unresolved $testname
 400             return }
 401     }
 402
 403     set dumpprogram ""
 404     # It's meaningless to require an output-testing method when we
 405     # expect an error.
 406     if { $opts(error) == "" && $opts(error_output) == "" } {
 407         if { $opts(DUMPPROG) != "" } {
 408             switch -- $opts(DUMPPROG) {
 409                 addr2line       { set dumpprogram addr2line }
 410                 nm              { set dumpprogram nm }
 411                 objdump         { set dumpprogram objdump }
 412                 readelf         { set dumpprogram readelf }
 413                 size            { set dumpprogram size }
 414                 default         {
 415                     perror "unrecognized dump program option $opts(DUMPPROG)\
 416                             in $file.d"
 417                     unresolved $testname
 418                     return
 419                 }
 420             }
 421         } else {
 422             # Guess which program to run, by seeing which option was specified.
 423             foreach p {addr2line nm objdump readelf size} {
 424                 if {$opts($p) != ""} {
 425                     if {$dumpprogram != ""} {
 426                         perror "more than one possible dump program specified\
 427                                 in $file.d"
 428                         unresolved $testname
 429                         return
 430                     } else {
 431                         set dumpprogram $p
 432                     }
 433                 }
 434             }
 435         }
 436     }
 437
 438     # Handle skipping the test on specified targets.
 439     # You can have both skip/not-skip and target/not-target, but you can't
 440     # have both skip and not-skip, or target and not-target, in the same file.
 441     if { $opts(skip) != "" } then {
 442         if { $opts(not-skip) != "" } then {
 443             perror "$testname: mixing skip and not-skip directives is invalid"
 444             unresolved $testname
 445             return
 446         }
 447         foreach glob $opts(skip) {
 448             if {[istarget $glob]} { return }
 449         }
 450     }
 451     if { $opts(not-skip) != "" } then {
 452         set skip 1
 453         foreach glob $opts(not-skip) {
 454             if {[istarget $glob]} {
 455                 set skip 0
 456                 break
 457             }
 458         }
 459         if {$skip} { return }
 460     }
 461     if { $opts(target) != "" } then {
 462         set skip 1
 463         foreach glob $opts(target) {
 464             if {[istarget $glob]} {
 465                 set skip 0
 466                 break
 467             }
 468         }
 469         if {$skip} {
 470             unsupported $testname
 471             return
 472         }
 473     }
 474     if { $opts(not-target) != "" } then {
 475         foreach glob $opts(not-target) {
 476             if {[istarget $glob]} {
 477                 unsupported $testname
 478                 return
 479             }
 480         }
 481     }
 482
 483     if { $opts(source) == "" } {
 484         set srcfile ${file}.s
 485     } else {
 486         set srcfile $srcdir/$subdir/$opts(source)
 487     }
 488
 489     if { $opts(dump) == "" } {
 490         set dumpfile ${file}.d
 491     } else {
 492         set dumpfile $srcdir/$subdir/$opts(dump)
 493     }
 494
 495     if { $opts(as) == "binary" } {
 496         while {[file type $srcfile] eq "link"} {
 497             set newfile [file readlink $srcfile]
 498             if {[string index $newfile 0] ne "/"} {
 499                 set newfile [file dirname $srcfile]/$newfile
 500             }
 501             set srcfile $newfile
 502         }
 503         # Make sure we copy the file if we are doing remote host testing.
 504         remote_download host ${srcfile} $tempfile
 505     } else {
 506         set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
 507         if [string match "" $exec_output] then {
 508             send_log "$exec_output\n"
 509             verbose "$exec_output"
 510             fail $testname
 511            return
 512         }
 513     }
 514
 515     if { (($opts(warning) != "") && ($opts(error) != "")) \
 516          || (($opts(warning) != "") && ($opts(error_output) != "")) \
 517          || (($opts(warning) != "") && ($opts(warning_output) != "")) \
 518          || (($opts(error) != "") && ($opts(warning_output) != "")) \
 519          || (($opts(error) != "") && ($opts(error_output) != "")) \
 520          || (($opts(warning_output) != "") && ($opts(error_output) != "")) } {
 521         perror "bad mix of warning, error, warning_output, and error_output\
 522                 test-directives"
 523         unresolved $testname
 524         return
 525     }
 526
 527     set check_prog(source) ""
 528     set check_prog(terminal) 0
 529     if { $opts(error) != "" \
 530          || $opts(warning) != "" \
 531          || $opts(error_output) != "" \
 532          || $opts(warning_output) != "" } {
 533
 534         if { $opts(error) != "" || $opts(error_output) != "" } {
 535             set check_prog(terminal) 1
 536         } else {
 537             set check_prog(terminal) 0
 538         }
 539
 540         if { $opts(error) != "" || $opts(warning) != "" } {
 541             set check_prog(source) "regex"
 542             if { $opts(error) != "" } {
 543                 set check_prog(regex) $opts(error)
 544             } else {
 545                 set check_prog(regex) $opts(warning)
 546             }
 547         } else {
 548             set check_prog(source) "file"
 549             if { $opts(error_output) != "" } {
 550                 set check_prog(file) $opts(error_output)
 551             } else {
 552                 set check_prog(file) $opts(warning_output)
 553             }
 554         }
 555     }
 556
 557     set progopts1 $opts($program)
 558     eval set progopts \$[string toupper $program]FLAGS
 559     eval set binary \$[string toupper $program]
 560
 561     set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
 562     set cmdret 0
 563     if [info exists binutils_run_status] {
 564         set cmdret $binutils_run_status
 565     }
 566
 567     regsub "\n$" $exec_output "" exec_output
 568     if { $cmdret != 0 || $exec_output != "" || $check_prog(source) != "" } {
 569         set exitstat "succeeded"
 570         if { $cmdret != 0 } {
 571             set exitstat "failed"
 572         }
 573
 574         if { $check_prog(source) == "regex" } {
 575             verbose -log "$exitstat with: <$exec_output>,\
 576                           expected: <$check_prog(regex)>"
 577         } elseif { $check_prog(source) == "file" } {
 578             verbose -log "$exitstat with: <$exec_output>,\
 579                           expected in file $check_prog(file)"
 580             set_file_contents "tmpdir/prog.messages" "$exec_output"
 581         } else {
 582             verbose -log "$exitstat with: <$exec_output>, no expected output"
 583         }
 584         send_log -- "$exec_output\n"
 585         verbose "$exec_output"
 586
 587         if { (($check_prog(source) == "") == ($exec_output == "")) \
 588              && (($cmdret == 0) == ($check_prog(terminal) == 0)) \
 589              && ((($check_prog(source) == "regex") \
 590                   && ($check_prog(regex) == "") == ($exec_output == "") \
 591                   && [regexp -- $check_prog(regex) $exec_output]) \
 592                  || (($check_prog(source) == "file") \
 593                      && (![regexp_diff "tmpdir/prog.messages" \
 594                            "$srcdir/$subdir/$check_prog(file)"]))) } {
 595             # We have the expected output from prog.
 596             if { $check_prog(terminal) || $program == "" } {
 597                 pass $testname
 598                 return
 599             }
 600         } else {
 601             fail $testname
 602             return
 603         }
 604     }
 605
 606     set progopts1 $opts($dumpprogram)
 607     eval set progopts \$[string toupper $dumpprogram]FLAGS
 608     eval set binary \$[string toupper $dumpprogram]
 609
 610     if { ![is_remote host] && [which $binary] == 0 } {
 611         untested $testname
 612         return
 613     }
 614
 615     # For objdump, automatically translate standard section names to the targets one,
 616     # if they are different.
 617     set sect_names [get_standard_section_names]
 618     if { $sect_names != "" && $dumpprogram == "objdump"} {
 619         regsub -- "-j \\.text" $progopts1 "-j [lindex $sect_names 0]" progopts1
 620         regsub -- "-j \\.data" $progopts1 "-j [lindex $sect_names 1]" progopts1
 621         regsub -- "-j \\.bss"  $progopts1 "-j [lindex $sect_names 2]" progopts1
 622     }
 623
 624     verbose "running $binary $progopts $progopts1" 3
 625
 626     set cmd "$binary $progopts $progopts1 ${copyfile}.o"
 627
 628     # Ensure consistent sorting of symbols
 629     if {[info exists env(LC_ALL)]} {
 630         set old_lc_all $env(LC_ALL)
 631     }
 632     set env(LC_ALL) "C"
 633     send_log "$cmd\n"
 634     set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
 635     if {[info exists old_lc_all]} {
 636         set env(LC_ALL) $old_lc_all
 637     } else {
 638         unset env(LC_ALL)
 639     }
 640     if { [lindex $comp_output 0] != 0 } then {
 641         send_log "$comp_output\n"
 642         fail $testname
 643         return
 644     }
 645     set comp_output [prune_warnings [lindex $comp_output 1]]
 646     if ![string match "" $comp_output] then {
 647         send_log "$comp_output\n"
 648         fail $testname
 649         return
 650     }
 651
 652     verbose_eval {[file_contents "tmpdir/dump.out"]} 3
 653     if { [regexp_diff "tmpdir/dump.out" "${dumpfile}"] } then {
 654         fail $testname
 655         verbose "output is [file_contents "tmpdir/dump.out"]" 2
 656         return
 657     }
 658
 659     pass $testname
 660 }
 661
 662 proc slurp_options { file } {
 663     if [catch { set f [open $file r] } x] {
 664         #perror "couldn't open `$file': $x"
 665         perror "$x"
 666         return -1
 667     }
 668     set opt_array {}
 669     # whitespace expression
 670     set ws  {[  ]*}
 671     set nws {[^         ]*}
 672     # whitespace is ignored anywhere except within the options list;
 673     # option names are alphabetic plus dash
 674     set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
 675     while { [gets $f line] != -1 } {
 676         set line [string trim $line]
 677         # Whitespace here is space-tab.
 678         if [regexp $pat $line xxx opt_name opt_val] {
 679             # match!
 680             lappend opt_array [list $opt_name $opt_val]
 681         } elseif {![regexp "^#" $line ]} {
 682             break
 683         }
 684     }
 685     close $f
 686     return $opt_array
 687 }
 688
 689 proc file_contents { filename } {
 690     set file [open $filename r]
 691     set contents [read $file]
 692     close $file
 693     return $contents
 694 }
 695
 696 proc verbose_eval { expr { level 1 } } {
 697     global verbose
 698     if $verbose>$level then { eval verbose "$expr" $level }
 699 }
 700
 701 # Internal procedure: return the names of the standard sections
 702 #
 703 proc get_standard_section_names {} {
 704     if [istarget "rx-*-*"] {
 705         return { "P" "D_1" "B_1" }
 706     }
 707     if [istarget "alpha*-*-*vms*"] {
 708         # Double quote: for TCL and for sh.
 709         return { "\\\$CODE\\\$" "\\\$DATA\\\$" "\\\$BSS\\\$" }
 710     }
 711     return
 712 }