binutils-gdb/binutils/testsuite/lib/utils-lib.exp
Maciej W. Rozycki 6d9dabbbc6 testsuite: Support filtering targets by TCL procedure in `run_dump_test'
Implement a more complex way of selecting targets to include or exclude
with `run_dump_test' cases, by extending the syntax for the `target',
`not-target', `skip' and `not-skip' options (with the binutils and GAS
test suites) and the `target', `alltargets' and `notarget' options (with
the LD test suite) to also accept a name of a TCL procedure instead of a
target triplet glob matching expression.  The result, 1 or 0, of the
procedure determines whether the test is to be run or not.  This mimics
and expands `dg-require-effective-target' from the GCC test suite.

Names of TCL procedures are supplied in square brackets `[]' as with TCL
procedure calls, observing that target triplet glob matching expressions
do not normally start and end with matching square brackets both at a
time.  Arguments for procedures are allowed if required.

Having a way to specify a complex condition for a `run_dump_test' case
to run has the advantage of keeping it local within the test case itself
where tool options related to the check might be also present, removing
the need to wrap `run_dump_test' calls into an `if' block whose only
reason is to do a feature check, and ultimately lets one have the test
reported as UNSUPPORTED automagically if required (not currently
supported by the `run_dump_test' options used for LD).

	binutils/
	* testsuite/lib/binutils-common.exp (match_target): New procedure.
	* testsuite/lib/utils-lib.exp (run_dump_test): Use it in place
	of `istarget' for matching with `target', `not-target', `skip'
	and `not-skip' options.

	gas/
	* testsuite/lib/gas-defs.exp (run_dump_test): Use `match_target'
	in place of `istarget' for matching with `target', `not-target',
	`skip' and `not-skip' options.

	ld/
	* testsuite/lib/ld-lib.exp (run_dump_test): Use `match_target'
	in place of `istarget' for matching with `target', `alltargets'
	and `notarget' options.
2018-04-27 15:25:20 +01:00

717 lines
21 KiB
Plaintext

# 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 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., 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]
if {$path == 0} then {
perror "$prog can't be run, file not found."
return ""
}
} else {
set path $prog
}
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
if ![info exists number] then {
return "$path (no version number)\n"
}
return "$path $number\n"
}
#
# 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 {
perror "$prog does not exist"
set binutils_run_failed 1
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 != "" && [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"
# Gotta quote dollar-signs because they get mangled by the
# shell otherwise.
regsub -all "\\$" "$progargs" "\\$" progargs
set state [remote_exec host $prog $progargs]
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_flags
# assemble a file
#
proc default_binutils_assemble_flags { source object asflags } {
global srcdir
global host_triplet
# The HPPA assembler syntax is a little different than most, to make
# the test source file assemble we need to run it through sed.
#
# 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*-*-*"] && ![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 $asflags]
set exec_output [prune_warnings $exec_output]
if [string match "" $exec_output] {
return 1
} else {
send_log "$exec_output\n"
verbose "$exec_output"
return 0
}
}
#
# 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.
#
# 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
}
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/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 { $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
}