[MIPS] Add Loongson 2K1000 proccessor support.
[deliverable/binutils-gdb.git] / binutils / testsuite / lib / utils-lib.exp
index e27f21710c9e8d67f44c42bdb1d1565dd1ce12be..ede77b2cfec436f445fe41e60bb927c94a1ac2cc 100644 (file)
@@ -1,18 +1,18 @@
-#   Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc.
+# Copyright (C) 1993-2018 Free Software Foundation, Inc.
 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
+# the Free Software Foundation; either version 3 of the License, or
 # (at your option) any later version.
-# 
+#
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
 
 # Please email any bugs, comments, and/or additions to this file to:
 # bug-dejagnu@prep.ai.mit.edu
 # This file was written by Rob Savoye <rob@cygnus.com>
 # and extended by Ian Lance Taylor <ian@cygnus.com>
 
+proc load_common_lib { name } {
+    load_lib $name
+}
+
+load_common_lib binutils-common.exp
+
 proc binutil_version { prog } {
     if ![is_remote host] {
-       set path [which $prog];
+       set path [which $prog]
        if {$path == 0} then {
            perror "$prog can't be run, file not found."
            return ""
@@ -30,8 +36,8 @@ proc binutil_version { prog } {
     } else {
        set path $prog
     }
-    set state [remote_exec host $prog --version];
-    set tmp "[lindex $state 1]\n";
+    set state [remote_exec host $prog --version]
+    set tmp "[lindex $state 1]\n"
     # Should find a way to discard constant parts, keep whatever's
     # left, so the version string could be almost anything at all...
     regexp "\[^\n\]* (cygnus-|)(\[-0-9.a-zA-Z-\]+)\[\r\n\].*" "$tmp" version cyg number
@@ -45,12 +51,17 @@ proc binutil_version { prog } {
 # default_binutils_run
 #      run a program, returning the output
 #      sets binutils_run_failed if the program does not exist
+#      sets binutils_run_status to the exit status of the program
 #
 proc default_binutils_run { prog progargs } {
     global binutils_run_failed
+    global binutils_run_status
     global host_triplet
 
     set binutils_run_failed 0
+    if [info exists binutils_run_status] {
+       unset binutils_run_status
+    }
 
     if ![is_remote host] {
        if {[which $prog] == 0} then {
@@ -60,6 +71,15 @@ proc default_binutils_run { prog progargs } {
        }
     }
 
+    # For objdump, automatically translate standard section
+    # names to the targets one, if they are different.
+    set sect_names [get_standard_section_names]
+    if { $sect_names != "" && [string match "*objdump" $prog] } {
+        regsub -- "-j \\.text" $progargs "-j [lindex $sect_names 0]" progargs
+        regsub -- "-j \\.data" $progargs "-j [lindex $sect_names 1]" progargs
+        regsub -- "-j \\.bss"  $progargs "-j [lindex $sect_names 2]" progargs
+    }
+
     send_log "$prog $progargs\n"
     verbose "$prog $progargs"
 
@@ -68,19 +88,26 @@ proc default_binutils_run { prog progargs } {
     regsub -all "\\$" "$progargs" "\\$" progargs
 
     set state [remote_exec host $prog $progargs]
-    set exec_output [prune_warnings [lindex $state 1]];
+    set binutils_run_status [lindex $state 0]
+    set exec_output [prune_warnings [lindex $state 1]]
     if {![string match "" $exec_output]} then {
        send_log "$exec_output\n"
        verbose "$exec_output"
+    } else {
+       if { [lindex $state 0] != 0 } {
+           set exec_output "$prog exited with status [lindex $state 0]"
+           send_log "$exec_output\n"
+           verbose "$exec_output"
+       }
     }
     return $exec_output
 }
 
 #
-# default_binutils_assemble
+# default_binutils_assemble_flags
 #      assemble a file
 #
-proc default_binutils_assemble { source object } {
+proc default_binutils_assemble_flags { source object asflags } {
     global srcdir
     global host_triplet
 
@@ -90,14 +117,15 @@ proc default_binutils_assemble { source object } {
     # This is a hack in that it won't scale well if other targets need
     # similar transformations to assemble.  We'll generalize the hack
     # if/when other targets need similar handling.
-    if [istarget "hppa*-*-*" ] then {
-       send_log "sed -f $srcdir/config/hppa.sed < $source > asm.s\n"
-       verbose "sed -f $srcdir/config/hppa.sed < $source > asm.s"
-       catch "exec sed -f $srcdir/config/hppa.sed < $source > asm.s";
+    if { [istarget "hppa*-*-*"] && ![istarget "*-*-linux*" ] } then {
+        set sed_file $srcdir/config/hppa.sed
+       send_log "sed -f $sed_file < $source > asm.s\n"
+       verbose "sed -f $sed_file < $source > asm.s"
+       catch "exec sed -f $sed_file < $source > asm.s"
        set source asm.s
     }
 
-    set exec_output [target_assemble $source $object ""];
+    set exec_output [target_assemble $source $object $asflags]
     set exec_output [prune_warnings $exec_output]
 
     if [string match "" $exec_output] {
@@ -105,57 +133,584 @@ proc default_binutils_assemble { source object } {
     } else {
        send_log "$exec_output\n"
        verbose "$exec_output"
-       perror "$source: assembly failed"
        return 0
     }
 }
 
-if ![info exists target_assemble] {
 #
-# Stolen from dejagnu/lib/target.exp--please remove after 1/1/98.
+# exe_ext
+#      Returns target executable extension, if any.
+#
+proc exe_ext {} {
+    if { [istarget *-*-mingw*] || [istarget *-*-cygwin*] } {
+        return ".exe"
+    } else {
+        return ""
+    }
+}
+
+# Copied and modified from gas.
+
+# run_dump_test FILE (optional:) EXTRA_OPTIONS
+#
+# Assemble a .s file, then run some utility on it and check the output.
+#
+# There should be an assembly language file named FILE.s in the test
+# suite directory, and a pattern file called FILE.d.  `run_dump_test'
+# will assemble FILE.s, run some tool like `objdump', `objcopy', or
+# `nm' on the .o file to produce textual output, and then analyze that
+# with regexps.  The FILE.d file specifies what program to run, and
+# what to expect in its output.
+#
+# The FILE.d file begins with zero or more option lines, which specify
+# flags to pass to the assembler, the program to run to dump the
+# assembler's output, and the options it wants.  The option lines have
+# the syntax:
+#
+#         # OPTION: VALUE
+#
+# OPTION is the name of some option, like "name" or "objdump", and
+# VALUE is OPTION's value.  The valid options are described below.
+# Whitespace is ignored everywhere, except within VALUE.  The option
+# list ends with the first line that doesn't match the above syntax.
+# However, a line within the options that begins with a #, but doesn't
+# have a recognizable option name followed by a colon, is considered a
+# comment and entirely ignored.
+#
+# The optional EXTRA_OPTIONS argument to `run_dump_test' is a list of
+# two-element lists.  The first element of each is an option name, and
+# the second additional arguments to be added on to the end of the
+# option list as given in FILE.d.  (If omitted, no additional options
+# are added.)
+#
+# The interesting options are:
+#
+#   name: TEST-NAME
+#      The name of this test, passed to DejaGNU's `pass' and `fail'
+#       commands.  If omitted, this defaults to FILE, the root of the
+#       .s and .d files' names.
+#
+#   as: FLAGS
+#      When assembling FILE.s, pass FLAGS to the assembler.
+#
+#   PROG: PROGRAM-NAME
+#       The name of the program to run to modify or analyze the .o file
+#       produced by the assembler.  This option is required.  Recognised
+#       names are: ar, elfedit, nm, objcopy, ranlib, strings, and strip.
+#
+#   DUMPPROG: PROGRAM-NAME
+#       The name of the program to run to analyze the .o file after it has
+#       has been modified by PROG.  This can be omitted; run_dump_test will
+#       guess which program to run by seeing if any of the flags options
+#       for the recognised dump programs are set.  Recognised names are:
+#       addr2line, nm, objdump, readelf and size.
+#
+#   nm: FLAGS
+#   objcopy: FLAGS
+#   objdump: FLAGS
+#   readelf: FLAGS
+#   size: FLAGS
+#      Use the specified program to analyze the .o file, and pass it
+#      FLAGS, in addition to the .o file name.  Note that they are run
+#      with LC_ALL=C in the environment to give consistent sorting
+#      of symbols.
+#
+#   source: SOURCE
+#      Assemble the file SOURCE.s.  If omitted, this defaults to FILE.s.
+#       This is useful if several .d files want to share a .s file.
+#
+#   dump: DUMP
+#      Match against DUMP.d.  If omitted, this defaults to FILE.d.  This
+#      is useful if several .d files differ by options only.  Options are
+#      always read from FILE.d.
+#
+#   target: GLOB|PROC ...
+#      Run this test only on a specified list of targets.  More precisely,
+#      in the space-separated list each glob is passed to "istarget" and
+#      each proc is called as a TCL procedure.  List items are interpreted
+#      such that procs are denoted by surrounding square brackets, and any
+#      other items are consired globs.  If the call evaluates true for any
+#      of them, the test will be run, otherwise it will be marked
+#      unsupported.
+#
+#   not-target: GLOB|PROC ...
+#      Do not run this test on a specified list of targets.  Again, each
+#      glob in the space-separated list is passed to "istarget" and each
+#      proc is called as a TCL procedure, and the test is run if it
+#      evaluates *false* for *all* of them.  Otherwise it will be marked
+#      unsupported.
+#
+#   skip: GLOB|PROC ...
+#   not-skip: GLOB|PROC ...
+#       These are exactly the same as "not-target" and "target",
+#       respectively, except that they do nothing at all if the check
+#       fails.  They should only be used in groups, to construct a single
+#       test which is run on all targets but with variant options or
+#       expected output on some targets.  (For example, see
+#       gas/arm/inst.d and gas/arm/wince_inst.d.)
+#
+#   error: REGEX
+#      An error with message matching REGEX must be emitted for the test
+#      to pass.  The DUMPPROG, addr2line, nm, objdump, readelf and size
+#      options have no meaning and need not supplied if this is present.
+#      Multiple "error" directives append to the expected error message.
+#
+#   error_output: FILE
+#      Means the same as 'error', except the regular expression lines
+#      are contains in FILE.
 #
-uplevel #0 {
-    proc target_assemble { source destfile flags } {
-       return [default_target_assemble $source $destfile $flags];
+#   warning: REGEX
+#      Expect a warning matching REGEX.  It is an error to issue both
+#      "error" and "warning".  Multiple "warning" directives append to
+#      the expected linker warning message.
+#
+#   warning_output: FILE
+#      Means the same as 'warning', except the regular expression
+#      lines are contains in FILE.
+#
+# Each option may occur at most once.
+#
+# After the option lines come regexp lines.  `run_dump_test' calls
+# `regexp_diff' to compare the output of the dumping tool against the
+# regexps in FILE.d.  `regexp_diff' is defined in binutils-common.exp;
+# see further comments there.
+
+proc run_dump_test { name {extra_options {}} } {
+    global subdir srcdir
+    global OBJDUMP NM OBJCOPY READELF STRIP
+    global OBJDUMPFLAGS NMFLAGS OBJCOPYFLAGS READELFFLAGS STRIPFLAGS
+    global ELFEDIT ELFEDITFLAGS
+    global binutils_run_status
+    global host_triplet
+    global env
+    global copyfile
+    global tempfile
+
+    if [string match "*/*" $name] {
+       set file $name
+       set name [file tail $name]
+    } else {
+       set file "$srcdir/$subdir/$name"
+    }
+    set opt_array [slurp_options "${file}.d"]
+    if { $opt_array == -1 } {
+       perror "error reading options from $file.d"
+       unresolved $subdir/$name
+       return
+    }
+    set opts(addr2line) {}
+    set opts(ar) {}
+    set opts(as) {}
+    set opts(elfedit) {}
+    set opts(name) {}
+    set opts(nm) {}
+    set opts(objcopy) {}
+    set opts(objdump) {}
+    set opts(ranlib) {}
+    set opts(readelf) {}
+    set opts(size) {}
+    set opts(strings) {}
+    set opts(strip) {}
+    set opts(PROG) {}
+    set opts(DUMPPROG) {}
+    set opts(source) {}
+    set opts(dump) {}
+    set opts(error) {}
+    set opts(warning) {}
+    set opts(error_output) {}
+    set opts(warning_output) {}
+    set opts(target) {}
+    set opts(not-target) {}
+    set opts(skip) {}
+    set opts(not-skip) {}
+
+    foreach i $opt_array {
+       set opt_name [lindex $i 0]
+       set opt_val [lindex $i 1]
+       if ![info exists opts($opt_name)] {
+           perror "unknown option $opt_name in file $file.d"
+           unresolved $subdir/$name
+           return
+       }
+
+       # Permit the option to use $srcdir to refer to the source
+       # directory.
+       regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
+
+       switch -- $opt_name {
+           warning {}
+           error {}
+           default {
+               if [string length $opts($opt_name)] {
+                   perror "option $opt_name multiply set in $file.d"
+                   unresolved $subdir/$name
+                   return
+               }
+           }
+       }
+       append opts($opt_name) $opt_val
     }
 
-    proc default_target_assemble { source destfile flags } {
-       global AS_FOR_TARGET;
-       global ASFLAGS_FOR_TARGET;
+    foreach i $extra_options {
+       set opt_name [lindex $i 0]
+       set opt_val [lindex $i 1]
+       if ![info exists opts($opt_name)] {
+           perror "unknown option $opt_name given in extra_opts"
+           unresolved $subdir/$name
+           return
+       }
+
+       # Permit the option to use $srcdir to refer to the source
+       # directory.
+       regsub -all "\\\$srcdir" "$opt_val" "$srcdir/$subdir" opt_val
 
-       if [info exists AS_FOR_TARGET] {
-           set AS "$AS_FOR_TARGET";
+       # add extra option to end of existing option, adding space
+       # if necessary.
+       if { ![regexp "warning|error" $opt_name]
+            && [string length $opts($opt_name)] } {
+           append opts($opt_name) " "
+       }
+       append opts($opt_name) $opt_val
+    }
+
+    if { $opts(name) == "" } {
+       set testname "$subdir/$name"
+    } else {
+       set testname $opts(name)
+    }
+    verbose "Testing $testname"
+
+    if {$opts(PROG) == ""} {
+       perror "PROG isn't set in $file.d"
+       unresolved $testname
+       return
+    }
+
+    set destopt ""
+    switch -- $opts(PROG) {
+       ar      { set program ar }
+       elfedit { set program elfedit }
+       nm      { set program nm }
+       objcopy { set program objcopy }
+       ranlib  { set program ranlib }
+       strings { set program strings }
+       strip   {
+           set program strip
+           set destopt "-o"
+       }
+       default {
+           perror "unrecognized program option $opts(PROG) in $file.d"
+           unresolved $testname
+           return }
+    }
+
+    set dumpprogram ""
+    # It's meaningless to require an output-testing method when we
+    # expect an error.
+    if { $opts(error) == "" && $opts(error_output) == "" } {
+       if { $opts(DUMPPROG) != "" } {
+           switch -- $opts(DUMPPROG) {
+               addr2line       { set dumpprogram addr2line }
+               nm              { set dumpprogram nm }
+               objdump         { set dumpprogram objdump }
+               readelf         { set dumpprogram readelf }
+               size            { set dumpprogram size }
+               default         {
+                   perror "unrecognized dump program option $opts(DUMPPROG)\
+                           in $file.d"
+                   unresolved $testname
+                   return
+               }
+           }
        } else {
-           if ![board_info target exists assembler] {
-               set AS [find_gas];
-           } else {
-               set AS [board_info target assembler];
+           # Guess which program to run, by seeing which option was specified.
+           foreach p {addr2line nm objdump readelf size} {
+               if {$opts($p) != ""} {
+                   if {$dumpprogram != ""} {
+                       perror "more than one possible dump program specified\
+                               in $file.d"
+                       unresolved $testname
+                       return
+                   } else {
+                       set dumpprogram $p
+                   }
+               }
            }
        }
+    }
 
-       if [info exists ASFLAGS_FOR_TARGET] {
-           append flags " $ASFLAGS_FOR_TARGET";
+    # Handle skipping the test on specified targets.
+    # You can have both skip/not-skip and target/not-target, but you can't
+    # have both skip and not-skip, or target and not-target, in the same file.
+    if { $opts(skip) != "" } then {
+       if { $opts(not-skip) != "" } then {
+           perror "$testname: mixing skip and not-skip directives is invalid"
+           unresolved $testname
+           return
+       }
+       foreach glob $opts(skip) {
+           if {[match_target $glob]} { return }
+       }
+    }
+    if { $opts(not-skip) != "" } then {
+       set skip 1
+       foreach glob $opts(not-skip) {
+           if {[match_target $glob]} {
+               set skip 0
+               break
+           }
        }
+       if {$skip} { return }
+    }
+    if { $opts(target) != "" } then {
+       set skip 1
+       foreach glob $opts(target) {
+           if {[match_target $glob]} {
+               set skip 0
+               break
+           }
+       }
+       if {$skip} {
+           unsupported $testname
+           return
+       }
+    }
+    if { $opts(not-target) != "" } then {
+       foreach glob $opts(not-target) {
+           if {[match_target $glob]} {
+               unsupported $testname
+               return
+           }
+       }
+    }
+
+    if { $opts(source) == "" } {
+       set srcfile ${file}.s
+    } else {
+       set srcfile $srcdir/$subdir/$opts(source)
+    }
+
+    if { $opts(dump) == "" } {
+       set dumpfile ${file}.d
+    } else {
+       set dumpfile $srcdir/$subdir/$opts(dump)
+    }
 
-       if [is_remote host] {
-           set source [remote_download host $source];
-           set dest "a.out"
+    if { $opts(as) == "binary" } {
+       while {[file type $srcfile] eq "link"} {
+           set newfile [file readlink $srcfile]
+           if {[string index $newfile 0] ne "/"} {
+               set newfile [file dirname $srcfile]/$newfile
+           }
+           set srcfile $newfile
+       }
+       # Make sure we copy the file if we are doing remote host testing.
+       remote_download host ${srcfile} $tempfile
+    } else {
+       set exec_output [binutils_assemble_flags ${srcfile} $tempfile $opts(as)]
+       if [string match "" $exec_output] then {
+           send_log "$exec_output\n"
+           verbose "$exec_output"
+           fail $testname
+          return
+       }
+    }
+
+    if { (($opts(warning) != "") && ($opts(error) != "")) \
+        || (($opts(warning) != "") && ($opts(error_output) != "")) \
+        || (($opts(warning) != "") && ($opts(warning_output) != "")) \
+        || (($opts(error) != "") && ($opts(warning_output) != "")) \
+        || (($opts(error) != "") && ($opts(error_output) != "")) \
+        || (($opts(warning_output) != "") && ($opts(error_output) != "")) } {
+       perror "bad mix of warning, error, warning_output, and error_output\
+               test-directives"
+       unresolved $testname
+       return
+    }
+
+    set check_prog(source) ""
+    set check_prog(terminal) 0
+    if { $opts(error) != "" \
+        || $opts(warning) != "" \
+        || $opts(error_output) != "" \
+        || $opts(warning_output) != "" } {
+
+       if { $opts(error) != "" || $opts(error_output) != "" } {
+           set check_prog(terminal) 1
        } else {
-           set dest $destfile
+           set check_prog(terminal) 0
        }
-       set status [remote_exec host "$AS $source $flags -o $dest"]
-       if [is_remote host] {
-           remote_upload host $dest $destfile
+
+       if { $opts(error) != "" || $opts(warning) != "" } {
+           set check_prog(source) "regex"
+           if { $opts(error) != "" } {
+               set check_prog(regex) $opts(error)
+           } else {
+               set check_prog(regex) $opts(warning)
+           }
+       } else {
+           set check_prog(source) "file"
+           if { $opts(error_output) != "" } {
+               set check_prog(file) $opts(error_output)
+           } else {
+               set check_prog(file) $opts(warning_output)
+           }
        }
+    }
+
+    set progopts1 $opts($program)
+    eval set progopts \$[string toupper $program]FLAGS
+    eval set binary \$[string toupper $program]
 
-       set comp_output [prune_warnings [lindex $status 1]];
-       if { [lindex $status 0] != 0 } {
-           verbose -log "assembler exited with status [lindex $status 0]";
+    set exec_output [binutils_run $binary "$progopts $progopts1 $tempfile $destopt ${copyfile}.o"]
+    set cmdret 0
+    if [info exists binutils_run_status] {
+       set cmdret $binutils_run_status
+    }
+
+    regsub "\n$" $exec_output "" exec_output
+    if { $cmdret != 0 || $exec_output != "" || $check_prog(source) != "" } {
+       set exitstat "succeeded"
+       if { $cmdret != 0 } {
+           set exitstat "failed"
        }
-       if { [lindex $status 1] != "" } {
-           verbose -log "assembler output is:\n[lindex $status 1]" 2;
+
+       if { $check_prog(source) == "regex" } {
+           verbose -log "$exitstat with: <$exec_output>,\
+                         expected: <$check_prog(regex)>"
+       } elseif { $check_prog(source) == "file" } {
+           verbose -log "$exitstat with: <$exec_output>,\
+                         expected in file $check_prog(file)"
+           set_file_contents "tmpdir/prog.messages" "$exec_output"
+       } else {
+           verbose -log "$exitstat with: <$exec_output>, no expected output"
        }
-       return ${comp_output};
+       send_log -- "$exec_output\n"
+       verbose "$exec_output"
+
+       if { (($check_prog(source) == "") == ($exec_output == "")) \
+            && (($cmdret == 0) == ($check_prog(terminal) == 0)) \
+            && ((($check_prog(source) == "regex") \
+                 && ($check_prog(regex) == "") == ($exec_output == "") \
+                 && [regexp -- $check_prog(regex) $exec_output]) \
+                || (($check_prog(source) == "file") \
+                    && (![regexp_diff "tmpdir/prog.messages" \
+                          "$srcdir/$subdir/$check_prog(file)"]))) } {
+           # We have the expected output from prog.
+           if { $check_prog(terminal) || $program == "" } {
+               pass $testname
+               return
+           }
+       } else {
+           fail $testname
+           return
+       }
+    }
+
+    set progopts1 $opts($dumpprogram)
+    eval set progopts \$[string toupper $dumpprogram]FLAGS
+    eval set binary \$[string toupper $dumpprogram]
+
+    if { ![is_remote host] && [which $binary] == 0 } {
+       untested $testname
+       return
+    }
+
+    # For objdump, automatically translate standard section names to the targets one,
+    # if they are different.
+    set sect_names [get_standard_section_names]
+    if { $sect_names != "" && $dumpprogram == "objdump"} {
+        regsub -- "-j \\.text" $progopts1 "-j [lindex $sect_names 0]" progopts1
+        regsub -- "-j \\.data" $progopts1 "-j [lindex $sect_names 1]" progopts1
+        regsub -- "-j \\.bss"  $progopts1 "-j [lindex $sect_names 2]" progopts1
+    }
+
+    verbose "running $binary $progopts $progopts1" 3
+
+    set cmd "$binary $progopts $progopts1 ${copyfile}.o"
+
+    # Ensure consistent sorting of symbols
+    if {[info exists env(LC_ALL)]} {
+       set old_lc_all $env(LC_ALL)
+    }
+    set env(LC_ALL) "C"
+    send_log "$cmd\n"
+    set comp_output [remote_exec host $cmd "" "/dev/null" "tmpdir/dump.out"]
+    if {[info exists old_lc_all]} {
+       set env(LC_ALL) $old_lc_all
+    } else {
+       unset env(LC_ALL)
+    }
+    if { [lindex $comp_output 0] != 0 } then {
+       send_log "$comp_output\n"
+       fail $testname
+       return
+    }
+    set comp_output [prune_warnings [lindex $comp_output 1]]
+    if ![string match "" $comp_output] then {
+       send_log "$comp_output\n"
+       fail $testname
+       return
+    }
+
+    verbose_eval {[file_contents "tmpdir/dump.out"]} 3
+    if { [regexp_diff "tmpdir/dump.out" "${dumpfile}"] } then {
+       fail $testname
+       verbose "output is [file_contents "tmpdir/dump.out"]" 2
+       return
+    }
+
+    pass $testname
 }
+
+proc slurp_options { file } {
+    if [catch { set f [open $file r] } x] {
+       #perror "couldn't open `$file': $x"
+       perror "$x"
+       return -1
+    }
+    set opt_array {}
+    # whitespace expression
+    set ws  {[         ]*}
+    set nws {[^        ]*}
+    # whitespace is ignored anywhere except within the options list;
+    # option names are alphabetic plus dash
+    set pat "^#${ws}(\[a-zA-Z-\]*)$ws:${ws}(.*)$ws\$"
+    while { [gets $f line] != -1 } {
+       set line [string trim $line]
+       # Whitespace here is space-tab.
+       if [regexp $pat $line xxx opt_name opt_val] {
+           # match!
+           lappend opt_array [list $opt_name $opt_val]
+       } elseif {![regexp "^#" $line ]} {
+           break
+       }
+    }
+    close $f
+    return $opt_array
 }
+
+proc file_contents { filename } {
+    set file [open $filename r]
+    set contents [read $file]
+    close $file
+    return $contents
+}
+
+proc verbose_eval { expr { level 1 } } {
+    global verbose
+    if $verbose>$level then { eval verbose "$expr" $level }
+}
+
+# Internal procedure: return the names of the standard sections
+#
+proc get_standard_section_names {} {
+    if [istarget "rx-*-*"] {
+        return { "P" "D_1" "B_1" }
+    }
+    if [istarget "alpha*-*-*vms*"] {
+        # Double quote: for TCL and for sh.
+        return { "\\\$CODE\\\$" "\\\$DATA\\\$" "\\\$BSS\\\$" }
+    }
+    return
 }
This page took 0.031623 seconds and 4 git commands to generate.