diff options
Diffstat (limited to 'binutils/testsuite/lib/utils-lib.exp')
| -rw-r--r-- | binutils/testsuite/lib/utils-lib.exp | 561 |
1 files changed, 0 insertions, 561 deletions
diff --git a/binutils/testsuite/lib/utils-lib.exp b/binutils/testsuite/lib/utils-lib.exp index 5f5ce03f3e1..45c1f03c5e0 100644 --- a/binutils/testsuite/lib/utils-lib.exp +++ b/binutils/testsuite/lib/utils-lib.exp @@ -149,568 +149,7 @@ proc exe_ext {} { } } -# 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 considered globs. If the call evaluates true for -# any of them, the test will be run, otherwise it will be marked -# unsupported. -# -# notarget: 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 ... -# noskip: GLOB|PROC ... -# These are exactly the same as "notarget" 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. -# -# 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(notarget) {} - set opts(skip) {} - set opts(noskip) {} - - 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 - } - - 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 - - # 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 { - # 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 - } - } - } - } - } - - # Handle skipping the test on specified targets. - # You can have both skip/noskip and target/notarget, but you can't - # have both skip and noskip, or target and notarget, in the same file. - if { $opts(skip) != "" } then { - if { $opts(noskip) != "" } then { - perror "$testname: mixing skip and noskip directives is invalid" - unresolved $testname - return - } - foreach glob $opts(skip) { - if {[match_target $glob]} { return } - } - } - if { $opts(noskip) != "" } then { - set skip 1 - foreach glob $opts(noskip) { - 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(notarget) != "" } then { - foreach glob $opts(notarget) { - 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 { $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 check_prog(terminal) 0 - } - - 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 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 { $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" - } - 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 -} |