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: GLOB|PROC ...
 228 #       Run this test only on a specified list of targets.  More precisely,
 229 #       in the space-separated list each glob is passed to "istarget" and
 230 #       each proc is called as a TCL procedure.  List items are interpreted
 231 #       such that procs are denoted by surrounding square brackets, and any
 232 #       other items are consired globs.  If the call evaluates true for any
 233 #       of them, the test will be run, otherwise it will be marked
 234 #       unsupported.
 235 #
 236 #   not-target: GLOB|PROC ...
 237 #       Do not run this test on a specified list of targets.  Again, each
 238 #       glob in the space-separated list is passed to "istarget" and each
 239 #       proc is called as a TCL procedure, and the test is run if it
 240 #       evaluates *false* for *all* of them.  Otherwise it will be marked
 241 #       unsupported.
 242 #
 243 #   skip: GLOB|PROC ...
 244 #   not-skip: GLOB|PROC ...
 245 #       These are exactly the same as "not-target" and "target",
 246 #       respectively, except that they do nothing at all if the check
 247 #       fails.  They should only be used in groups, to construct a single
 248 #       test which is run on all targets but with variant options or
 249 #       expected output on some targets.  (For example, see
 250 #       gas/arm/inst.d and gas/arm/wince_inst.d.)
 251 #
 252 #   error: REGEX
 253 #       An error with message matching REGEX must be emitted for the test
 254 #       to pass.  The DUMPPROG, addr2line, nm, objdump, readelf and size
 255 #       options have no meaning and need not supplied if this is present.
 256 #       Multiple "error" directives append to the expected error message.
 257 #
 258 #   error_output: FILE
 259 #       Means the same as 'error', except the regular expression lines
 260 #       are contains in FILE.
 261 #
 262 #   warning: REGEX
 263 #       Expect a warning matching REGEX.  It is an error to issue both
 264 #       "error" and "warning".  Multiple "warning" directives append to
 265 #       the expected linker warning message.
 266 #
 267 #   warning_output: FILE
 268 #       Means the same as 'warning', except the regular expression
 269 #       lines are contains in FILE.
 270 #
 271 # Each option may occur at most once.
 272 #
 273 # After the option lines come regexp lines.  `run_dump_test' calls
 274 # `regexp_diff' to compare the output of the dumping tool against the
 275 # regexps in FILE.d.  `regexp_diff' is defined in binutils-common.exp;
 276 # see further comments there.
 277
 278 proc run_dump_test { name {extra_options {}} } {
 279     global subdir srcdir
 280     global OBJDUMP NM OBJCOPY READELF STRIP
 281     global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
 282     global ELFEDIT ELFEDITFLAGS
 283     global binutils_run_status
 284     global host_triplet
 285     global env
 286     global copyfile
 287     global tempfile
 288
 289     if [string match "*/*" $name] {
 290         set file $name
 291         set name [file tail $name]
 292     } else {
 293         set file "$srcdir/$subdir/$name"
 294     }
 295     set opt_array [slurp_options "${file}.d"]
 296     if { $opt_array == -1 } {
 297         perror "error reading options from $file.d"
 298         unresolved $subdir/$name
 299         return
 300     }
 301     set opts(addr2line) {}
 302     set opts(ar) {}
 303     set opts(as) {}
 304     set opts(elfedit) {}
 305     set opts(name) {}
 306     set opts(nm) {}
 307     set opts(objcopy) {}
 308     set opts(objdump) {}
 309     set opts(ranlib) {}
 310     set opts(readelf) {}
 311     set opts(size) {}
 312     set opts(strings) {}
 313     set opts(strip) {}
 314     set opts(PROG) {}
 315     set opts(DUMPPROG) {}
 316     set opts(source) {}
 317     set opts(dump) {}
 318     set opts(error) {}
 319     set opts(warning) {}
 320     set opts(error_output) {}
 321     set opts(warning_output) {}
 322     set opts(target) {}
 323     set opts(not-target) {}
 324     set opts(skip) {}
 325     set opts(not-skip) {}
 326
 327     foreach i $opt_array {
 328         set opt_name [lindex $i 0]
 329         set opt_val [lindex $i 1]
 330         if ![info exists opts($opt_name)] {
 331             perror "unknown option $opt_name in file $file.d"
 332             unresolved $subdir/$name
 333             return
 334         }
 335
 336         # Permit the option to use $srcdir to refer to the source
 337         # directory.
 338         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 339
 340         switch -- $opt_name {
 341             warning {}
 342             error {}
 343             default {
 344                 if [string length $opts($opt_name)] {
 345                     perror "option $opt_name multiply set in $file.d"
 346                     unresolved $subdir/$name
 347                     return
 348                 }
 349             }
 350         }
 351         append opts($opt_name) $opt_val
 352     }
 353
 354     foreach i $extra_options {
 355         set opt_name [lindex $i 0]
 356         set opt_val [lindex $i 1]
 357         if ![info exists opts($opt_name)] {
 358             perror "unknown option $opt_name given in extra_opts"
 359             unresolved $subdir/$name
 360             return
 361         }
 362
 363         # Permit the option to use $srcdir to refer to the source
 364         # directory.
 365         regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 366
 367         # add extra option to end of existing option, adding space
 368         # if necessary.
 369         if { ![regexp "warning|error" $opt_name]
 370              && [string length $opts($opt_name)] } {
 371             append opts($opt_name) " "
 372         }
 373         append opts($opt_name) $opt_val
 374     }
 375
 376     if { $opts(name) == "" } {
 377         set testname "$subdir/$name"
 378     } else {
 379         set testname $opts(name)
 380     }
 381     verbose "Testing $testname"
 382
 383     if {$opts(PROG) == ""} {
 384         perror "PROG isn't set in $file.d"
 385         unresolved $testname
 386         return
 387     }
 388
 389     set destopt ""
 390     switch -- $opts(PROG) {
 391         ar      { set program ar }
 392         elfedit { set program elfedit }
 393         nm      { set program nm }
 394         objcopy { set program objcopy }
 395         ranlib  { set program ranlib }
 396         strings { set program strings }
 397         strip   {
 398             set program strip
 399             set destopt "-o"
 400         }
 401         default {
 402             perror "unrecognized program option $opts(PROG) in $file.d"
 403             unresolved $testname
 404             return }
 405     }
 406
 407     set dumpprogram ""
 408     # It's meaningless to require an output-testing method when we
 409     # expect an error.
 410     if { $opts(error) == "" && $opts(error_output) == "" } {
 411         if { $opts(DUMPPROG) != "" } {
 412             switch -- $opts(DUMPPROG) {
 413                 addr2line       { set dumpprogram addr2line }
 414                 nm              { set dumpprogram nm }
 415                 objdump         { set dumpprogram objdump }
 416                 readelf         { set dumpprogram readelf }
 417                 size            { set dumpprogram size }
 418                 default         {
 419                     perror "unrecognized dump program option $opts(DUMPPROG)\
 420                             in $file.d"
 421                     unresolved $testname
 422                     return
 423                 }
 424             }
 425         } else {
 426             # Guess which program to run, by seeing which option was specified.
 427             foreach p {addr2line nm objdump readelf size} {
 428                 if {$opts($p) != ""} {
 429                     if {$dumpprogram != ""} {
 430                         perror "more than one possible dump program specified\
 431                                 in $file.d"
 432                         unresolved $testname
 433                         return
 434                     } else {
 435                         set dumpprogram $p
 436                     }
 437                 }
 438             }
 439         }
 440     }
 441
 442     # Handle skipping the test on specified targets.
 443     # You can have both skip/not-skip and target/not-target, but you can't
 444     # have both skip and not-skip, or target and not-target, in the same file.
 445     if { $opts(skip) != "" } then {
 446         if { $opts(not-skip) != "" } then {
 447             perror "$testname: mixing skip and not-skip directives is invalid"
 448             unresolved $testname
 449             return
 450         }
 451         foreach glob $opts(skip) {
 452             if {[match_target $glob]} { return }
 453         }
 454     }
 455     if { $opts(not-skip) != "" } then {
 456         set skip 1
 457         foreach glob $opts(not-skip) {
 458             if {[match_target $glob]} {
 459                 set skip 0
 460                 break
 461             }
 462         }
 463         if {$skip} { return }
 464     }
 465     if { $opts(target) != "" } then {
 466         set skip 1
 467         foreach glob $opts(target) {
 468             if {[match_target $glob]} {
 469                 set skip 0
 470                 break
 471             }
 472         }
 473         if {$skip} {
 474             unsupported $testname
 475             return
 476         }
 477     }
 478     if { $opts(not-target) != "" } then {
 479         foreach glob $opts(not-target) {
 480             if {[match_target $glob]} {
 481                 unsupported $testname
 482                 return
 483             }
 484         }
 485     }
 486
 487     if { $opts(source) == "" } {
 488         set srcfile ${file}.s
 489     } else {
 490         set srcfile $srcdir/$subdir/$opts(source)
 491     }
 492
 493     if { $opts(dump) == "" } {
 494         set dumpfile ${file}.d
 495     } else {
 496         set dumpfile $srcdir/$subdir/$opts(dump)
 497     }
 498
 499     if { $opts(as) == "binary" } {
 500         while {[file type $srcfile] eq "link"} {
 501             set newfile [file readlink $srcfile]
 502             if {[string index $newfile 0] ne "/"} {
 503                 set newfile [file dirname $srcfile]/$newfile
 504             }
 505             set srcfile $newfile
 506         }
 507         # Make sure we copy the file if we are doing remote host testing.
 508         remote_download host ${srcfile} $tempfile
 509     } else {
 510         set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
 511         if [string match "" $exec_output] then {
 512             send_log "$exec_output\n"
 513             verbose "$exec_output"
 514             fail $testname
 515            return
 516         }
 517     }
 518
 519     if { (($opts(warning) != "") && ($opts(error) != "")) \
 520          || (($opts(warning) != "") && ($opts(error_output) != "")) \
 521          || (($opts(warning) != "") && ($opts(warning_output) != "")) \
 522          || (($opts(error) != "") && ($opts(warning_output) != "")) \
 523          || (($opts(error) != "") && ($opts(error_output) != "")) \
 524          || (($opts(warning_output) != "") && ($opts(error_output) != "")) } {
 525         perror "bad mix of warning, error, warning_output, and error_output\
 526                 test-directives"
 527         unresolved $testname
 528         return
 529     }
 530
 531     set check_prog(source) ""
 532     set check_prog(terminal) 0
 533     if { $opts(error) != "" \
 534          || $opts(warning) != "" \
 535          || $opts(error_output) != "" \
 536          || $opts(warning_output) != "" } {
 537
 538         if { $opts(error) != "" || $opts(error_output) != "" } {
 539             set check_prog(terminal) 1
 540         } else {
 541             set check_prog(terminal) 0
 542         }
 543
 544         if { $opts(error) != "" || $opts(warning) != "" } {
 545             set check_prog(source) "regex"
 546             if { $opts(error) != "" } {
 547                 set check_prog(regex) $opts(error)
 548             } else {
 549                 set check_prog(regex) $opts(warning)
 550             }
 551         } else {
 552             set check_prog(source) "file"
 553             if { $opts(error_output) != "" } {
 554                 set check_prog(file) $opts(error_output)
 555             } else {
 556                 set check_prog(file) $opts(warning_output)
 557             }
 558         }
 559     }
 560
 561     set progopts1 $opts($program)
 562     eval set progopts \$[string toupper $program]FLAGS
 563     eval set binary \$[string toupper $program]
 564
 565     set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
 566     set cmdret 0
 567     if [info exists binutils_run_status] {
 568         set cmdret $binutils_run_status
 569     }
 570
 571     regsub "\n$" $exec_output "" exec_output
 572     if { $cmdret != 0 || $exec_output != "" || $check_prog(source) != "" } {
 573         set exitstat "succeeded"
 574         if { $cmdret != 0 } {
 575             set exitstat "failed"
 576         }
 577
 578         if { $check_prog(source) == "regex" } {
 579             verbose -log "$exitstat with: <$exec_output>,\
 580                           expected: <$check_prog(regex)>"
 581         } elseif { $check_prog(source) == "file" } {
 582             verbose -log "$exitstat with: <$exec_output>,\
 583                           expected in file $check_prog(file)"
 584             set_file_contents "tmpdir/prog.messages" "$exec_output"
 585         } else {
 586             verbose -log "$exitstat with: <$exec_output>, no expected output"
 587         }
 588         send_log -- "$exec_output\n"
 589         verbose "$exec_output"
 590
 591         if { (($check_prog(source) == "") == ($exec_output == "")) \
 592              && (($cmdret == 0) == ($check_prog(terminal) == 0)) \
 593              && ((($check_prog(source) == "regex") \
 594                   && ($check_prog(regex) == "") == ($exec_output == "") \
 595                   && [regexp -- $check_prog(regex) $exec_output]) \
 596                  || (($check_prog(source) == "file") \
 597                      && (![regexp_diff "tmpdir/prog.messages" \
 598                            "$srcdir/$subdir/$check_prog(file)"]))) } {
 599             # We have the expected output from prog.
 600             if { $check_prog(terminal) || $program == "" } {
 601                 pass $testname
 602                 return
 603             }
 604         } else {
 605             fail $testname
 606             return
 607         }
 608     }
 609
 610     set progopts1 $opts($dumpprogram)
 611     eval set progopts \$[string toupper $dumpprogram]FLAGS
 612     eval set binary \$[string toupper $dumpprogram]
 613
 614     if { ![is_remote host] && [which $binary] == 0 } {
 615         untested $testname
 616         return
 617     }
 618
 619     # For objdump, automatically translate standard section names to the targets one,
 620     # if they are different.
 621     set sect_names [get_standard_section_names]
 622     if { $sect_names != "" && $dumpprogram == "objdump"} {
 623         regsub -- "-j \\.text" $progopts1 "-j [lindex $sect_names 0]" progopts1
 624         regsub -- "-j \\.data" $progopts1 "-j [lindex $sect_names 1]" progopts1
 625         regsub -- "-j \\.bss"  $progopts1 "-j [lindex $sect_names 2]" progopts1
 626     }
 627
 628     verbose "running $binary $progopts $progopts1" 3
 629
 630     set cmd "$binary $progopts $progopts1 ${copyfile}.o"
 631
 632     # Ensure consistent sorting of symbols
 633     if {[info exists env(LC_ALL)]} {
 634         set old_lc_all $env(LC_ALL)
 635     }
 636     set env(LC_ALL) "C"
 637     send_log "$cmd\n"
 638     set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
 639     if {[info exists old_lc_all]} {
 640         set env(LC_ALL) $old_lc_all
 641     } else {
 642         unset env(LC_ALL)
 643     }
 644     if { [lindex $comp_output 0] != 0 } then {
 645         send_log "$comp_output\n"
 646         fail $testname
 647         return
 648     }
 649     set comp_output [prune_warnings [lindex $comp_output 1]]
 650     if ![string match "" $comp_output] then {
 651         send_log "$comp_output\n"
 652         fail $testname
 653         return
 654     }
 655
 656     verbose_eval {[file_contents "tmpdir/dump.out"]} 3
 657     if { [regexp_diff "tmpdir/dump.out" "${dumpfile}"] } then {
 658         fail $testname
 659         verbose "output is [file_contents "tmpdir/dump.out"]" 2
 660         return
 661     }
 662
 663     pass $testname
 664 }
 665
 666 proc slurp_options { file } {
 667     if [catch { set f [open $file r] } x] {
 668         #perror "couldn't open `$file': $x"
 669         perror "$x"
 670         return -1
 671     }
 672     set opt_array {}
 673     # whitespace expression
 674     set ws  {[  ]*}
 675     set nws {[^         ]*}
 676     # whitespace is ignored anywhere except within the options list;
 677     # option names are alphabetic plus dash
 678     set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
 679     while { [gets $f line] != -1 } {
 680         set line [string trim $line]
 681         # Whitespace here is space-tab.
 682         if [regexp $pat $line xxx opt_name opt_val] {
 683             # match!
 684             lappend opt_array [list $opt_name $opt_val]
 685         } elseif {![regexp "^#" $line ]} {
 686             break
 687         }
 688     }
 689     close $f
 690     return $opt_array
 691 }
 692
 693 proc file_contents { filename } {
 694     set file [open $filename r]
 695     set contents [read $file]
 696     close $file
 697     return $contents
 698 }
 699
 700 proc verbose_eval { expr { level 1 } } {
 701     global verbose
 702     if $verbose>$level then { eval verbose "$expr" $level }
 703 }
 704
 705 # Internal procedure: return the names of the standard sections
 706 #
 707 proc get_standard_section_names {} {
 708     if [istarget "rx-*-*"] {
 709         return { "P" "D_1" "B_1" }
 710     }
 711     if [istarget "alpha*-*-*vms*"] {
 712         # Double quote: for TCL and for sh.
 713         return { "\\\$CODE\\\$" "\\\$DATA\\\$" "\\\$BSS\\\$" }
 714     }
 715     return
 716 }