path: root/binutils/testsuite/lib/binutils-common.exp

# Copyright (C) 1993-2021 Free Software Foundation, Inc.
#
# This file is part of the GNU Binutils.
#
# This file 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.

# True if the object format is known to be ELF.
#
proc is_elf_format {} {
    # config.sub for these targets curiously transforms a target doublet
    # ending in -elf to -none.  eg. m68hc12-elf to m68hc12-unknown-none
    # They are always elf.
    if { [istarget m68hc1*-*] || [istarget s12z*-*] || [istarget xgate-*] } {
	return 1;
    }
# vxworks (and windiss) excluded due to number of ELF tests that need
# modifying to pass on those targets.
#	 && ![istarget *-*-vxworks*]
#	 && ![istarget *-*-windiss*]

    if {    ![istarget *-*-chorus*]
	 && ![istarget *-*-cloudabi*]
	 && ![istarget *-*-eabi*]
	 && ![istarget *-*-*elf*]
	 && ![istarget *-*-*freebsd*]
	 && ![istarget *-*-fuchsia*]
	 && ![istarget *-*-gnu*]
	 && ![istarget *-*-irix5*]
	 && ![istarget *-*-irix6*]
	 && ![istarget *-*-kaos*]
	 && ![istarget *-*-*linux*]
	 && ![istarget *-*-lynxos*]
	 && ![istarget *-*-nacl*]
	 && ![istarget *-*-netbsd*]
	 && ![istarget *-*-nto*]
	 && ![istarget *-*-openbsd*]
	 && ![istarget *-*-rtems*]
	 && ![istarget *-*-solaris2*]
	 && ![istarget *-*-sysv4*]
	 && ![istarget *-*-unixware*]
	 && ![istarget *-*-wasm32*]
	 && ![istarget avr-*-*]
	 && ![istarget hppa*64*-*-hpux*]
	 && ![istarget ia64-*-hpux*] } {
	return 0
    }

    if { [istarget *-*-linux*ecoff*]
	 || [istarget *-*-rtemscoff*] } {
	return 0
    }

    if { ![istarget *-*-netbsdelf*]
	 && (   [istarget vax-*-netbsd*]
	     || [istarget ns32k-*-netbsd*]) } {
    	return 0
    }

    if {    [istarget arm-*-openbsd*]
	 || [istarget ns32k-*-openbsd*]
	 || [istarget vax-*-openbsd*] } {
	return 0
    }

    return 1
}

# True if the object format is known to be a.out.
#
proc is_aout_format {} {
    if { [istarget *-*-*aout*]
	 || [istarget *-*-bsd*]
	 || [istarget *-*-msdos*]
	 || [istarget ns32k-*-*]
	 || [istarget pdp11-*-*]
	 || [istarget vax-*-netbsd] } {
	return 1
    }
    return 0
}

# True if the object format is known to be PE COFF.
#
proc is_pecoff_format args {
    if { [llength $args] == 1 } {
	set m_os [lindex $args 0]
    } else {
	set m_os *-*
    }
    if { [istarget $m_os-beospe*]
	 || [istarget $m_os-cegcc*]
	 || [istarget $m_os-cygwin*]
	 || [istarget $m_os-interix*]
	 || [istarget $m_os-mingw*]
	 || [istarget $m_os-netbsdpe*]
	 || [istarget $m_os-pe*]
	 || [istarget $m_os-winnt*] } {
	return 1
    }
    return 0
}

proc is_som_format {} {
    if { ![istarget hppa*-*-*] || [istarget hppa*64*-*-*] } {
	return 0;
    }
    if { [istarget *-*-osf*] \
	     || [istarget {*-*-h[ip]ux*}] \
	     || [istarget *-*-mpeix*] \
	     || [istarget *-*-bsd*] } {
	return 1;
    }
    return 0;
}

proc is_xcoff_format {} {
    if { [istarget rs6000-*-*]
	 || [istarget powerpc*-*-aix*]
	 || [istarget powerpc*-*-beos*]
	 || [istarget powerpc*-*-macos*] } {
	return 1;
    }
    return 0;
}

# True if the object format is known to be 64-bit ELF.
#
proc is_elf64 { binary_file } {
    global READELF
    global READELFFLAGS

    set tmpfile [file dirname $binary_file]/readelf.out
    set readelf_size ""
    catch "exec $READELF $READELFFLAGS -h $binary_file > $tmpfile" got

    if ![string match "" $got] then {
	return 0
    }

    if { ![regexp "\n\[ \]*Class:\[ \]*ELF(\[0-9\]+)\n" \
	   [file_contents $tmpfile] nil readelf_size] } {
	return 0
    }

    if { $readelf_size == "64" } {
	return 1
    }

    return 0
}

# True if the object format is known to use RELA relocations.
#
proc is_rela { binary_file } {
    global READELF
    global READELFFLAGS

    set tmpfile [file dirname $binary_file]/readelf.out
    catch "exec $READELF $READELFFLAGS -S $binary_file > $tmpfile" got

    if ![string match "" $got] then {
	return 0
    }

    if { ![regexp "RELA" [file_contents $tmpfile]] } {
	return 0
    }

    return 1
}

# True if the target matches TARGET, specified as a TCL procedure if
# in square brackets or as machine triplet otherwise.
#
proc match_target { target } {
   if [regexp {^!?\[.*\]$} $target] {
	return $target
   } else {
	return [istarget $target]
   }
}

# True if the ELF target supports setting the ELF header OSABI field
# to ELFOSABI_GNU or ELFOSABI_FREEBSD, a requirement for STT_GNU_IFUNC
# symbol and SHF_GNU_MBIND or SHF_GNU_RETAIN section support.
#
# This generally depends on the target OS only, however there are a
# number of exceptions for bare metal targets as follows.  The MSP430
# and Visium targets set OSABI to ELFOSABI_STANDALONE.  Likewise
# non-EABI ARM targets set OSABI to ELFOSABI_ARM
#
# Non-Linux HPPA defaults to ELFOSABI_HPUX.
#
# Note that some TI C6X targets use ELFOSABI_C6000_* but one doesn't,
# so we don't try to sort out tic6x here.  (The effect is that linker
# testcases will generally need to exclude tic6x or use a -m option.)
#
proc supports_gnu_osabi {} {
    if { [istarget *-*-gnu*]
	 || [istarget *-*-linux*]
	 || [istarget *-*-nacl*]
	 || ( [istarget *-*-*bsd*] && ![istarget arm*-*-netbsd*] )
	 || [istarget *-*-symbianelf]
	 || [istarget *-*-lynxos]
	 || ( [istarget *-*-nto*] && ![istarget arm*-*-*] )
	 || [istarget *-*-irix*]
	 || [istarget *-*-*eabi*]
	 || [istarget *-*-rtems*] } {
	return 1
    }
    if { [istarget "wasm32*-*-*"] } {
        return 1
    }
    if { ![istarget "*-*-elf*"] } {
	return 0
    }
    if { [istarget "arm*-*-*"]
	 || [istarget "msp430-*-*"]
	 || [istarget "hppa-unknown-elf"]
	 || [istarget "visium-*-*"] } {
	return 0
    }
    return 1
}

# Return true if target uses the generic_link_hash_table linker.
proc is_generic { } {
    if { [istarget "d30v-*-*"]
	 || [istarget "dlx-*-*"]
	 || [istarget "pj*-*-*"]
	 || [istarget "s12z-*-*"]
	 || [istarget "xgate-*-*"] } {
	return 1
    }
    return 0
}

# True if the ELF target supports STB_GNU_UNIQUE.
#
# This require ELFOSABI_GNU, and `bfd_elf_final_link'.
#
proc supports_gnu_unique {} {
    if { [istarget *-*-freebsd*] } {
	return 0
    }
    if { [supports_gnu_osabi] && ![is_generic] } {
	return 1
    }
    return 0
}

# True for targets that do not sort .symtab as per the ELF standard.
# ie. any that have mips_elf32_be_vec, mips_elf32_le_vec,
# mips_elf32_n_be_vec or mips_elf32_n_le_vec as the primary bfd target
# vector in config.bfd.  When syncing with config.bfd, don't forget that
# earlier case-matches trump later ones.
proc is_bad_symtab {} {
    if { ![istarget "mips*-*-*"] } {
	return 0;
    }
    if { [istarget "*-*-chorus*"]
	 || [istarget "*-*-irix5*"]
	 || [istarget "*-*-irix6*"]
	 || [istarget "*-*-none"]
	 || [istarget "*-*-rtems*"]
	 || [istarget "*-*-windiss"] } {
	return 1;
    }
    if { [istarget "*-*-elf*"]
	 && ![istarget "*-sde-*"]
	 && ![istarget "*-mti-*"]
	 && ![istarget "*-img-*"] } {
	return 1;
    }
    if { [istarget "*-*-openbsd*"]
	 && ![istarget "mips64*-*-*"] } {
	return 1;
    }
    return 0;
}

# Returns true if -shared is supported on the target

proc check_shared_lib_support { } {
    global shared_available_saved
    global ld

    if {![info exists shared_available_saved]} {
	set ld_output [remote_exec host $ld "-shared"]
	if { [ string first "not supported" $ld_output ] >= 0 } {
	    set shared_available_saved 0
	} else {
	    set shared_available_saved 1
	}
    }
    return $shared_available_saved
}

# Returns true if -pie is supported on the target

proc check_pie_support { } {
    global pie_available_saved
    global ld

    if {![info exists pie_available_saved]} {
	set ld_output [remote_exec host $ld "-pie"]
	if { [ string first "not supported" $ld_output ] >= 0 } {
	    set pie_available_saved 0
	} else {
	    set pie_available_saved 1
	}
    }
    return $pie_available_saved
}

proc check_relro_support { } {
    global relro_available_saved
    global ld

    if {![info exists relro_available_saved]} {
	remote_file host delete norelro
	set ld_output [remote_exec host $ld "-z norelro"]
	if { [string first "not supported" $ld_output] >= 0
	     || [string first "unrecognized option" $ld_output] >= 0
	     || [string first "-z norelro ignored" $ld_output] >= 0
	     || [string first "cannot find norelro" $ld_output] >= 0 } {
	    set relro_available_saved 0
	} else {
	    set relro_available_saved 1
	}
    }
    return $relro_available_saved
}

# Check for support of the .noinit section, used for data that is not
# initialized at load, or during the application's initialization sequence.
proc supports_noinit_section {} {
    # .noinit is only supported by ELF targets.
    if { ![is_elf_format] } {
	return 0;
    }

    # Targets that set HAVE_NOINIT=yes in their emulparams script utilizing
    # elf.sc, or explicitly define a .noinit section in their linker script.
    #
    # arc-*-* is not included here, since it only supports .noinit with the
    # non-default arcv2elf emulation.
    if {[istarget "arm-*-*"]
	  || [istarget "avr-*-*"]
	  || [istarget "msp430-*-*"]
	  || [istarget "pru-*-*"] } {
	return 1;
    }
    return 0;
}

# Check for support of the .persistent section, used for data that is
# initialized at load, but not during the application's initialization sequence.
proc supports_persistent_section {} {
    # .persistent is only supported by ELF targets.
    if { ![is_elf_format] } {
	return 0;
    }

    # Targets that set HAVE_PERSISTENT=yes in their emulparams script utilizing
    # elf.sc, or explicitly define a .persistent section in their linker script.
    if { [istarget "arm-*-*"]
	  || [istarget "msp430-*-*"] } {
	return 1;
    }
    return 0;
}

# Compare two files line-by-line.  FILE_1 is the actual output and FILE_2
# is the expected output.  Ignore blank lines in either file.
#
# FILE_2 is a series of regexps, comments and # directives.  The directives
# are:
#
#    #pass
#        Treat the test as a PASS if everything up till this point has
#        matched.  Ignore any remaining lines in either FILE_1 or FILE_2.
#
#    #failif
#        Reverse the sense of the test: expect differences to exist.
#
#    #...
#    REGEXP
#        Skip all lines in FILE_1 until the first that matches REGEXP.
#
#    #?REGEXP
#        Optionally match REGEXP against line from FILE_1.  If the REGEXP
#        does not match then the next line from FILE_2 is tried.
#
# Other # lines are comments.  Regexp lines starting with the `!' character
# specify inverse matching (use `\!' for literal matching against a leading
# `!').  Skip empty lines in both files.
#
# The first optional argument is a list of regexp substitutions of the form:
#
#    EXP1 SUBSPEC1 EXP2 SUBSPEC2 ...
#
# This tells the function to apply each regexp substitution EXPi->SUBSPECi
# in order to every line of FILE_2.
#
# Return nonzero if differences exist.
proc regexp_diff { file_1 file_2 args } {
    set eof -1
    set end_1 0
    set end_2 0
    set differences 0
    set diff_pass 0
    set fail_if_match 0
    set ref_subst ""
    if { [llength $args] > 0 } {
	set ref_subst [lindex $args 0]
    }
    if { [llength $args] > 1 } {
	perror "Too many arguments to regexp_diff"
	return 1
    }

    if [file exists $file_1] then {
	set file_a [open $file_1 r]
    } else {
	perror "$file_1 doesn't exist"
	return 1
    }

    if [file exists $file_2] then {
	set file_b [open $file_2 r]
    } else {
	perror "$file_2 doesn't exist"
	close $file_a
	return 1
    }

    verbose " Regexp-diff'ing: $file_1 $file_2" 2

    while { 1 } {
	set line_a ""
	set line_b ""
	while { [string length $line_a] == 0 } {
	    # Ignore blank line in FILE_1.
	    if { [gets $file_a line_a] == $eof } {
		set end_1 1
		break
	    }
	}
	while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
	    if { [string match "#pass" $line_b] } {
		set end_2 1
		set diff_pass 1
		break
	    } elseif { [string match "#failif" $line_b] } {
		send_log "fail if no difference\n"
		verbose "fail if no difference" 3
		set fail_if_match 1
	    } elseif { [string match "#..." $line_b] } {
		if { [gets $file_b line_b] == $eof } {
		    set end_2 1
		    set diff_pass 1
		    break
		}
		set negated [expr { [string index $line_b 0] == "!" }]
		set line_bx [string range $line_b $negated end]
		set n [expr { $negated ? "! " : "" }]
		# Substitute on the reference.
		foreach {name value} $ref_subst {
		    regsub -- $name $line_bx $value line_bx
		}
		verbose "looking for $n\"^$line_bx$\"" 3
		while { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
		    verbose "skipping    \"$line_a\"" 3
		    if { [gets $file_a line_a] == $eof } {
			set end_1 1
			break
		    }
		}
		break
	    } elseif { [string match "#\\?*" $line_b] } {
		if { ! $end_1 } {
		    set line_b [string replace $line_b 0 1]
		    set negated [expr { [string index $line_b 0] == "!" }]
		    set line_bx [string range $line_b $negated end]
		    set n [expr { $negated ? "! " : "" }]
		    # Substitute on the reference.
		    foreach {name value} $ref_subst {
			regsub -- $name $line_bx $value line_bx
		    }
		    verbose "optional match for $n\"^$line_bx$\"" 3
		    if { [expr [regexp "^$line_bx$" "$line_a"] != $negated] } {
			break
		    }
		}
	    }
	    if { [gets $file_b line_b] == $eof } {
		set end_2 1
		break
	    }
	}

	if { $diff_pass } {
	    break
	} elseif { $end_1 && $end_2 } {
	    break
	} elseif { $end_1 } {
	    send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
	    verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
	    set differences 1
	    break
	} elseif { $end_2 } {
	    send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
	    verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
	    set differences 1
	    break
	} else {
	    set negated [expr { [string index $line_b 0] == "!" }]
	    set line_bx [string range $line_b $negated end]
	    set n [expr { $negated ? "! " : "" }]
	    set s [expr { $negated ? "  " : "" }]
	    # Substitute on the reference.
	    foreach {name value} $ref_subst {
		regsub -- $name $line_bx $value line_bx
	    }
	    verbose "regexp $n\"^$line_bx$\"\nline   \"$line_a\"" 3
	    if { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
		send_log "regexp_diff match failure\n"
		send_log "regexp $n\"^$line_bx$\"\nline   $s\"$line_a\"\n"
		verbose "regexp_diff match failure\n" 3
		set differences 1
	    }
	}
    }

    if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
	send_log "$file_1 and $file_2 are different lengths\n"
	verbose "$file_1 and $file_2 are different lengths" 3
	set differences 1
    }

    if { $fail_if_match } {
	if { $differences == 0 } {
	    set differences 1
	} else {
	    set differences 0
	}
    }

    close $file_a
    close $file_b

    return $differences
}

# prune_warnings_extra -- delete extra warnings from TEXT.
#
# An example is:
# ld: warning: /lib64/ld-linux-x86-64.so.2: unsupported GNU_PROPERTY_TYPE (5) type : 0xc0010001
proc prune_warnings_extra { text } {
    global experimental
    # Warnings are only pruned from non-experimental code (ie code not
    # on a release branch).  For experimental code we want the warnings
    # as they indicate that the sources need to be updated to recognise
    # the new properties.
    if { "$experimental" == "false" } {
	# The "\\1" is to try to preserve a "\n" but only if necessary.
	regsub -all "(^|\n)(\[^\n\]*: warning:\[^\n\]*unsupported GNU_PROPERTY_TYPE\[^\n\]*\n?)+" $text "\\1" text
    }
    # PR binutils/23898: It is OK to have gaps in build notes.
    regsub -all "(^|\n)(\[^\n\]*: Warning: Gap in build notes detected from\[^\n\]*\n?)+" $text "\\1" text
    return $text
}

# This definition is taken from an unreleased version of DejaGnu.  Once
# that version gets released, and has been out in the world for a few
# months at least, it may be safe to delete this copy.
if ![string length [info proc prune_warnings]] {
    #
    # prune_warnings -- delete various system verbosities from TEXT
    #
    # An example is:
    # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
    #
    # Sites with particular verbose os's may wish to override this in site.exp.
    #
    proc prune_warnings { text } {
	# This is from sun4's.  Do it for all machines for now.
	# The "\\1" is to try to preserve a "\n" but only if necessary.
	regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
	# It might be tempting to get carried away and delete blank lines, etc.
	# Just delete *exactly* what we're ask to, and that's it.
	set text [prune_warnings_extra $text]
	return $text
    }
} elseif { [info procs saved-prune_warnings] == [list] } {
    rename prune_warnings saved-prune_warnings
    proc prune_warnings { text } {
	set text [saved-prune_warnings $text]
	set text [prune_warnings_extra $text]
	return $text
    }
}

# run_dump_test FILE (optional:) EXTRA_OPTIONS
#
# Assemble a .s file, then run some utility on it and check the output.
# Optionally generate the .s file first by running the compiler.
#
# 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, optionally run objcopy on the object file,
# optionally run ld, optionally run another objcopy, optionally run
# another tool under test specified by PROG, then run a dump tool like
# addr2line, nm, objdump, readelf or size on the object 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, pass FLAGS to the assembler.
#	If assembling several files, you can pass different assembler
#	options in the "source" directives.  See below.
#       Multiple instances of this directive tells run_dump_test to run the test
#       multiple times -- one time with each set of flags provided.
#       Each instance will run exactly as a file with a single "as" line, it is
#       not possible to condition any behaviour on which set of "as" flags is
#       used.  That means that the "source" specific options are appended to
#       the "as" flags for their corresponding files, and any extra processing
#       (e.g. with "ld" and "objcopy") is repeated for each test.
#
#   ld: FLAGS
#	Link assembled files using FLAGS, in the order of the "source"
#	directives, when using multiple files.
#
#   ld_after_inputfiles: FLAGS
#	Similar to "ld", but put FLAGS after all input files.
#
#   cc: FLAGS
#       Run the compiler with FLAGS (to which -S is added) to generate assembler
#       source first.  source: must be provided and should consist of .c files.
#       Source-specific CC flags are not supported.
#
#   objcopy_objects: FLAGS
#	Run objcopy with the specified flags after assembling any source
#	that has the special marker RUN_OBJCOPY in the source specific
#	flags.
#
#   objcopy_linked_file: FLAGS
#	Run objcopy on the linked file with the specified flags.
#	This lets you transform the linked file using objcopy, before the
#	result is analyzed by an analyzer program specified below.
#
#   PROG: PROGRAM-NAME
#	The name of a program under test, to run to modify or analyze the
#	.o file produced by the assembler.  Recognised names are: ar,
#	elfedit, nm, objcopy, ranlib, strings, and strip.
#
#   DUMPPROG: PROGRAM-NAME
#       The name of the program to run to analyze the file produced
#       by the assembler or the linker.  This can be omitted;
#       run_dump_test will guess which program to run from which of
#       the flags options below is present.
#
#   addr2line: FLAGS
#   nm: FLAGS
#   objdump: FLAGS
#   readelf: FLAGS
#   size: FLAGS
#	Use the specified program to analyze the output file, and pass it
#	FLAGS, in addition to the output name.  Note that they are run
#	with LC_ALL=C in the environment to give consistent sorting of
#	symbols.  If no FLAGS are needed then you can use:
#	    DUMPPROG: [nm objdump readelf addr2line]
#	instead, or just pass a flag that happens to be the default.
#	If objdump is the dump tool and we're not dumping binary, nor
#	have run ld, then the standard section names (.text, .data and
#	.bss) are replaced by target ones if any (eg. rx-elf uses "P"
#	instead of .text).  The substition is done for both the
#	objdump options (eg: "-j .text" is replaced by "-j P") and the
#	reference file.
#
#   source: SOURCE [FLAGS]
#	Assemble the file SOURCE.s using the flags in the "as" directive
#	and the (optional) FLAGS.  If omitted, the source defaults to
#	FILE.s.
#	This is useful if several .d files want to share a .s file.
#	More than one "source" directive can be given, which is useful
#	when testing linking.
#
#   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.
#
#   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.
#
#   alltargets: GLOB|PROC ...
#	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 *true* for *all* of them.  Otherwise it will be marked
#	unsupported.
#
#   skip: GLOB|PROC ...
#   anyskip: GLOB|PROC ...
#   noskip: GLOB|PROC ...
#	These are exactly the same as "notarget", "alltargets" 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.)
#
#   xfail: GLOB|PROC ...
#	Run this test and it is is expected to fail on a specified list
#	of targets.
#
#   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 warning message.
#
#   warning_output: FILE
#	Means the same as 'warning', except the regular expression
#	lines are contains in FILE.
#
#   map: FILE
#	Adding this option will cause the linker to generate a linker
#	map file, using the -Map=MAPFILE command line option.  If
#	there is no -Map=MAPFILE in the 'ld: FLAGS' then one will be
#	added to the linker command line.  The contents of the
#	generated MAPFILE are then compared against the regexp lines
#	in FILE using `regexp_diff' (see below for details).
#
#   section_subst: no
#	Means that the section substitution for objdump is disabled.
#
# Each option may occur at most once unless otherwise mentioned.
#
# 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.
#
proc run_dump_test { name {extra_options {}} } {
    global ADDR2LINE ADDR2LINEFLAGS AS ASFLAGS CC CFLAGS ELFEDIT ELFEDITFLAGS
    global LD LDFLAGS NM NMFLAGS OBJCOPY OBJCOPYFLAGS OBJDUMP OBJDUMPFLAGS
    global READELF READELFFLAGS STRIP STRIPFLAGS
    global copyfile env runtests srcdir subdir verbose

    if [string match "*/*" $name] {
	set file $name
	set name [file tail $name]
    } else {
	set file "$srcdir/$subdir/$name"
    }

    if ![runtest_file_p $runtests $name] then {
	return
    }

    set opt_array [slurp_options "${file}.d"]
    if { $opt_array == -1 } {
	perror "error reading options from $file.d"
	unresolved $subdir/$name
	return
    }
    set dumpfile tmpdir/dump.out
    set run_ld 0
    set run_objcopy 0
    set objfile_names {}
    set opts(PROG) {}
    set opts(DUMPPROG) {}
    set opts(addr2line) {}
    set opts(alltargets) {}
    set opts(anyskip) {}
    set opts(ar) {}
    set opts(as) {}
    set as_final_flags {}
    set as_additional_flags {}
    set opts(cc) {}
    set opts(dump) {}
    set opts(elfedit) {}
    set opts(error) {}
    set opts(error_output) {}
    set opts(ld) {}
    set opts(ld_after_inputfiles) {}
    set opts(map) {}
    set opts(name) {}
    set opts(nm) {}
    set opts(noskip) {}
    set opts(notarget) {}
    set opts(objcopy) {}
    set opts(objcopy_linked_file) {}
    set opts(objcopy_objects) {}
    set opts(objdump) {}
    set opts(ranlib) {}
    set opts(readelf) {}
    set opts(section_subst) {}
    set opts(size) {}
    set opts(strings) {}
    set opts(strip) {}
    set opts(skip) {}
    set opts(source) {}
    set opts(strip) {}
    set opts(target) {}
    set opts(warning) {}
    set opts(warning_output) {}
    set opts(xfail) {}

    set in_extra 0
    foreach i [concat $opt_array {{} {}} $extra_options] {
	set opt_name [lindex $i 0]
	set opt_val [lindex $i 1]
	if { $opt_name == "" } {
	    set in_extra 1
	    continue
	}
	if ![info exists opts($opt_name)] {
	    perror "unknown option $opt_name in file $file.d"
	    unresolved $subdir/$name
	    return
	}

	# Allow more substitutions, including tcl functions, for as, ld,
	# and cc.  Not done in general because extra quoting is needed for glob
	# args used for example in binutils-all/remove-relocs-04.d.
	if { $opt_name == "as" || $opt_name == "ld" || $opt_name == "cc" } {
	    set opt_val [subst $opt_val]
	} else {
	    # Just substitute $srcdir and $subdir
	    regsub -all {\$srcdir} "$opt_val" "$srcdir" opt_val
	    regsub -all {\$subdir} "$opt_val" "$subdir" opt_val
	}

	switch -- $opt_name {
	    xfail {}
	    target {}
	    alltargets {}
	    notarget {}
	    skip {}
	    anyskip {}
	    noskip {}
	    warning {}
	    error {}
	    source {
		# Move any source-specific as-flags to a separate list to
		# simplify processing.
		if { [llength $opt_val] > 1 } {
		    lappend asflags [lrange $opt_val 1 end]
		    set opt_val [lindex $opt_val 0]
		} else {
		    lappend asflags {}
		}

		# Create the object file name based on nothing but the source
		# file name.
		set new_objfile \
		    [concat tmpdir/[file rootname [file tail [lindex $opt_val 0]]].o]
		# But, sometimes, we have the exact same source filename in
		# different directories (foo/src.s bar/src.s) which would lead
		# us to try and create two src.o files.  We detect this
		# conflict here, and instead create src.o and src1.o.
		set j 0
		while { [lsearch $objfile_names $new_objfile] != -1 } {
		    incr j
		    set new_objfile \
			[concat tmpdir/[file rootname [file tail  [lindex $opt_val 0]]]${j}.o]
		}
		lappend objfile_names $new_objfile
	    }
	    default {
		if { !$in_extra
                     && [string length $opts($opt_name)]
                     && $opt_name != "as" } {
		    perror "option $opt_name multiply set in $file.d"
		    unresolved $subdir/$name
		    return
		}

		# A single "#ld:" with no options should do the right thing.
		if { $opt_name == "ld" } {
		    set run_ld 1
		}
		# Likewise objcopy_linked_file.
		if { $opt_name == "objcopy_linked_file" } {
		    set run_objcopy 1
		}
	    }
	}

	# Append differently whether it's a message (without space) or
	# an option or list (with space).
	switch -- $opt_name {
	    warning -
	    error {
		append opts($opt_name) $opt_val
	    }
            as {
                if { $in_extra } {
                    set as_additional_flags [concat $as_additional_flags $opt_val]
                } else {
                    lappend opts(as) $opt_val
                }
            }
	    default {
		set opts($opt_name) [concat $opts($opt_name) $opt_val]
	    }
	}
    }

    # Ensure there is something in $opts(as) for the foreach loop below.
    if { [llength $opts(as)] == 0 } {
        set opts(as) [list " "]
    }
    foreach x $opts(as) {
        if { [string length $x] && [string length $as_additional_flags] } {
            append x " "
        }
        append x $as_additional_flags
        regsub {\[big_or_little_endian\]} $x \
            [big_or_little_endian] x
        lappend as_final_flags $x
    }

    regsub {\[big_or_little_endian\]} $opts(ld) \
        [big_or_little_endian] opts(ld)

    if { $opts(name) == "" } {
	set testname "$subdir/$name"
    } else {
	set testname $opts(name)
    }

    set err_warn 0
    foreach opt { warning error warning_output error_output } {
	if { $opts($opt) != "" } {
	    if { $err_warn } {
		perror "$testname: bad mix of warning and error test directives"
		unresolved $testname
		return
	    }
	    set err_warn 1
	}
    }

    # Decide early whether we should run the test for this target.
    if { [llength $opts(noskip)] > 0 } {
	set targmatch 0
	foreach targ $opts(noskip) {
	    if [match_target $targ] {
		set targmatch 1
		break
	    }
	}
	if { $targmatch == 0 } {
	    return
	}
    }
    foreach targ $opts(anyskip) {
	if ![match_target $targ] {
	    return
	}
    }
    foreach targ $opts(skip) {
	if [match_target $targ] {
	    return
	}
    }
    if { [llength $opts(target)] > 0 } {
	set targmatch 0
	foreach targ $opts(target) {
	    if [match_target $targ] {
		set targmatch 1
		break
	    }
	}
	if { $targmatch == 0 } {
	    unsupported $testname
	    return
	}
    }
    foreach targ $opts(alltargets) {
	if ![match_target $targ] {
	    unsupported $testname
	    return
	}
    }
    foreach targ $opts(notarget) {
	if [match_target $targ] {
	    unsupported $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 DUMPPROG 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 "ambiguous dump program in $file.d"
			unresolved $testname
			return
		    } else {
			set dumpprogram $p
		    }
		}
	    }
	}
	if { $dumpprogram == "" && $opts(map) == "" && !$err_warn } {
	    perror "dump program unspecified in $file.d"
	    unresolved $testname
	    return
	}
    }

    # Possibly compile some of the inputs, and build up a replacement
    # for opts(source) with the output .s names substituted in as we go.
    # Set the .s names from the objfile_names to take advantage of the
    # uniquification that happened earlier.
    if { $opts(cc) != ""} {
	set cmdret 0
	set new_source ""

	foreach cfile $opts(source) ofile $objfile_names {
	    if { [file extension $cfile] != ".c" } {
		lappend new_source "$cfile"
		continue
	    }

	    if { ! [string match "./*" $cfile] } {
		set cfile "$srcdir/$subdir/$cfile"
	    }
	    # ofile is never absolute, so this always works to protect sfile
	    # from later absolutization.
	    set sfile "./[file rootname $ofile].s"
	    set cmd "$CC $CFLAGS -S $opts(cc) -o $sfile $cfile"
	    send_log "$cmd\n"
	    set cmdret [remote_exec host [concat sh -c [list "$cmd 2>&1"]] "" "/dev/null" "dump.tmp"]
	    remote_upload host "dump.tmp"
	    set comp_output [prune_warnings [file_contents "dump.tmp"]]
	    remote_file host delete "dump.tmp"
	    remote_file build delete "dump.tmp"
	    lappend new_source "$sfile"
	    set cmdret [lindex $cmdret 0]

	    regsub "\n$" $comp_output "" comp_output
	    if { $cmdret != 0} {
		send_log "compilation of $cfile failed, exit status $cmdret with <$comp_output>"
                # Should this be 'unresolved', or is that too silent?
		fail $testname
		return 0
	    }
	}
	set opts(source) $new_source
    }

    if { $opts(source) == "" } {
	set sourcefiles [list ${file}.s]
	set asflags [list ""]
	set objfile_names [list tmpdir/[file tail ${file}].o]
    } else {
	set sourcefiles {}
	foreach sf $opts(source) {
	    if { [string match "./*" $sf] } {
		lappend sourcefiles "$sf"
	    } else {
		lappend sourcefiles "$srcdir/$subdir/$sf"
	    }
	}
    }

    if { $opts(dump) == "" } {
	set dfile ${file}.d
    } else {
	set dfile $srcdir/$subdir/$opts(dump)
    }

    # Time to setup xfailures.
    foreach targ $opts(xfail) {
	if [match_target $targ] {
	    setup_xfail "*-*-*"
	    break
	}
    }

    foreach as_flags $as_final_flags {
        # Assemble each file.
        set objfiles {}
        for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
            set sourcefile [lindex $sourcefiles $i]
            set sourceasflags [lindex $asflags $i]
            set run_objcopy_objects 0

            if { [string match "*RUN_OBJCOPY*" $sourceasflags] } {
                set run_objcopy_objects 1
            }
            regsub "RUN_OBJCOPY" $sourceasflags "" sourceasflags

            set objfile [lindex $objfile_names $i]
            catch "exec rm -f $objfile" exec_output
            lappend objfiles $objfile

            if { $as_flags == "binary" } {
                while {[file type $sourcefile] eq "link"} {
                    set newfile [file readlink $sourcefile]
                    if {[string index $newfile 0] ne "/"} {
                        set newfile [file dirname $sourcefile]/$newfile
                    }
                    set sourcefile $newfile
                }
                set newfile [remote_download host $sourcefile $objfile]
                set cmdret 0
                if { $newfile == "" } {
                    set cmdret 1
                }
            } else {
                if { [istarget "hppa*-*-*"] \
                         && ![istarget "*-*-linux*"] \
                         && ![istarget "*-*-netbsd*" ] } {
                    set cmd "sed -e 's/^\[	 \]*\.comm \\(\[^,\]*\\),\\(.*\\)/\\1 .comm \\2/' < $sourcefile > tmpdir/asm.s"
                    send_log "$cmd\n"
                    set cmdret [remote_exec host [concat sh -c [list "$cmd"]]]
                    set cmdret [lindex $cmdret 0]
                    if { $cmdret != 0 } {
                        perror "sed failure"
                        unresolved $testname
                        continue
                    }
                    set sourcefile tmpdir/asm.s
                }
                set cmd "$AS $ASFLAGS $as_flags $sourceasflags -o $objfile $sourcefile"

                send_log "$cmd\n"
                set cmdret [remote_exec host [concat sh -c [list "$cmd 2>&1"]] "" "/dev/null" "dump.tmp"]
                remote_upload host "dump.tmp"
                set comp_output [prune_warnings [file_contents "dump.tmp"]]
                remote_file host delete "dump.tmp"
                remote_file build delete "dump.tmp"
                set cmdret [lindex $cmdret 0]
            }
            if { $cmdret == 0 && $run_objcopy_objects } {
                set cmd "$OBJCOPY $opts(objcopy_objects) $objfile"

                send_log "$cmd\n"
                set cmdret [remote_exec host [concat sh -c [list "$cmd 2>&1"]] \
                                "" "/dev/null" "dump.tmp"]
                remote_upload host "dump.tmp"
                append comp_output [prune_warnings [file_contents "dump.tmp"]]
                remote_file host delete "dump.tmp"
                remote_file build delete "dump.tmp"
                set cmdret [lindex $cmdret 0]
            }
        }

        # Perhaps link the file(s).
        if { $cmdret == 0 && $run_ld } {
            set objfile "tmpdir/dump"
            catch "exec rm -f $objfile" exec_output

            set ld_extra_opt ""
            global ld
            set ld "$LD"
	    if [check_relro_support] {
		set ld_extra_opt "-z norelro"
	    }

            # Add -L$srcdir/$subdir so that the linker command can use
            # linker scripts in the source directory.
            set cmd "$LD $ld_extra_opt $LDFLAGS -L$srcdir/$subdir \
		   $opts(ld) -o $objfile $objfiles $opts(ld_after_inputfiles)"

            # If needed then check for, or add a -Map option.
            set mapfile ""
            if { $opts(map) != "" } then {
                if { [regexp -- "-Map=(\[^ \]+)" $cmd all mapfile] } then {
                    # Found existing mapfile option
                    verbose -log "Existing mapfile '$mapfile' found"
                } else {
                    # No mapfile option.
                    set mapfile "tmpdir/dump.map"
                    verbose -log "Adding mapfile '$mapfile'"
                    set cmd "$cmd -Map=$mapfile"
                }
            }

            send_log "$cmd\n"
            set cmdret [remote_exec host [concat sh -c [list "$cmd 2>&1"]] "" "/dev/null" "dump.tmp"]
            remote_upload host "dump.tmp"
            append comp_output [file_contents "dump.tmp"]
            remote_file host delete "dump.tmp"
            remote_file build delete "dump.tmp"
            set cmdret [lindex $cmdret 0]

            if { $cmdret == 0 && $run_objcopy } {
                set infile $objfile
                set objfile "tmpdir/dump1"
                remote_file host delete $objfile

                # Note that we don't use OBJCOPYFLAGS here; any flags must be
                # explicitly specified.
                set cmd "$OBJCOPY $opts(objcopy_linked_file) $infile $objfile"

                send_log "$cmd\n"
                set cmdret [remote_exec host [concat sh -c [list "$cmd 2>&1"]] "" "/dev/null" "dump.tmp"]
                remote_upload host "dump.tmp"
                append comp_output [file_contents "dump.tmp"]
                remote_file host delete "dump.tmp"
                remote_file build delete "dump.tmp"
                set cmdret [lindex $cmdret 0]
            }
        } else {
            set objfile [lindex $objfiles 0]
        }

        if { $cmdret == 0 && $opts(PROG) != "" } {
            set destopt ${copyfile}.o
            switch -- $opts(PROG) {
                ar		{ set program ar }
                elfedit	{
                    set program elfedit
                    set destopt ""
                }
                nm		{ set program nm }
                objcopy	{ set program objcopy }
                ranlib	{ set program ranlib }
                strings	{ set program strings }
                strip	{
                    set program strip
                    set destopt "-o $destopt"
                }
                default	{
                    perror "unrecognized PROG option $opts(PROG) in $file.d"
                    unresolved $testname
                    continue
                }
            }

            set progopts1 $opts($program)
            eval set progopts \$[string toupper $program]FLAGS
            eval set binary \$[string toupper $program]

            if { ![is_remote host] && [which $binary] == 0 } {
                untested $testname
                continue
            }

            verbose "running $binary $progopts $progopts1" 3
            set cmd "$binary $progopts $progopts1 $objfile $destopt"

            # 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 cmdret [remote_exec host [concat sh -c [list "$cmd 2>dump.tmp"]] "" "/dev/null"]
            set cmdret [lindex $cmdret 0]
            remote_upload host "dump.tmp"
            append comp_output [prune_warnings [file_contents "dump.tmp"]]
            remote_file host delete "dump.tmp"
            remote_file build delete "dump.tmp"
            if {[info exists old_lc_all]} {
                set env(LC_ALL) $old_lc_all
            } else {
                unset env(LC_ALL)
            }
            if { $destopt != "" } {
                set objfile ${copyfile}.o
            }
        }

        set want_out(source) ""
        set want_out(terminal) 0
        if { $err_warn } {
            if { $opts(error) != "" || $opts(error_output) != "" } {
                set want_out(terminal) 1
            }

            if { $opts(error) != "" || $opts(warning) != "" } {
                set want_out(source) "regex"
                if { $opts(error) != "" } {
                    set want_out(regex) $opts(error)
                } else {
                    set want_out(regex) $opts(warning)
                }
            } else {
                set want_out(source) "file"
                if { $opts(error_output) != "" } {
                    set want_out(file) $opts(error_output)
                } else {
                    set want_out(file) $opts(warning_output)
                }
            }
        }

        regsub "\n$" $comp_output "" comp_output
        if { $cmdret != 0 || $comp_output != "" || $want_out(source) != "" } {
            set exitstat "succeeded"
            if { $cmdret != 0 } { set exitstat "failed" }

            if { $want_out(source) == "regex" } {
                verbose -log "$exitstat with: <$comp_output>, expected: <$want_out(regex)>"
            } elseif { $want_out(source) == "file" } {
                verbose -log "$exitstat with: <$comp_output>, expected in file $want_out(file)"
                set_file_contents "tmpdir/ld.messages" "$comp_output"
            } else {
                verbose -log "$exitstat with: <$comp_output>, no expected output"
            }

            if { (($want_out(source) == "") == ($comp_output == "")) \
                     && (($cmdret == 0) == ($want_out(terminal) == 0)) \
                     && ((($want_out(source) == "regex") \
                              && [regexp -- $want_out(regex) $comp_output]) \
                             || (($want_out(source) == "file") \
                                     && (![regexp_diff "tmpdir/ld.messages" "$srcdir/$subdir/$want_out(file)"]))) } {
                # We have the expected output.
                if { $want_out(terminal) || $dumpprogram == "" } {
                    pass $testname
                    continue
                }
            } else {
                fail $testname
                continue
            }
        }

        # We must not have expected failure if we get here.
        if { $opts(error) != "" } {
            fail $testname
            continue
        }

        if { $opts(map) != "" } then {
            # Check the map file matches.
            set map_pattern_file $srcdir/$subdir/$opts(map)
            verbose -log "Compare '$mapfile' against '$map_pattern_file'"
            if { [regexp_diff $mapfile $map_pattern_file] } then {
                fail "$testname (map file check)"
            } else {
                pass "$testname (map file check)"
            }

            if { $dumpprogram == "" } then {
                continue
            }
        }

        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
            continue
        }

        # For objdump of gas output, automatically translate standard section names
        set sect_names ""
        if { !$run_ld && $dumpprogram == "objdump" \
                 && $opts(section_subst) != "no" \
                 && ![string match "*-b binary*" $progopts1] } {
            set sect_names [get_standard_section_names]
            if { $sect_names != ""} {
                regsub -- "\\.text" $progopts1 "[lindex $sect_names 0]" progopts1
                regsub -- "\\.data" $progopts1 "[lindex $sect_names 1]" progopts1
                regsub -- "\\.bss"  $progopts1 "[lindex $sect_names 2]" progopts1
            }
        }

        if { $progopts1 == "" } { set $progopts1 "-r" }
        verbose "running $binary $progopts $progopts1" 3

        set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"

        # 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 cmdret [remote_exec host [concat sh -c [list "$cmd 2>dump.tmp"]] "" "/dev/null"]
        set cmdret [lindex $cmdret 0]
        remote_upload host "dump.tmp"
        set comp_output [prune_warnings [file_contents "dump.tmp"]]
        remote_file host delete "dump.tmp"
        remote_file build delete "dump.tmp"
        if {[info exists old_lc_all]} {
            set env(LC_ALL) $old_lc_all
        } else {
            unset env(LC_ALL)
        }
        if { $cmdret != 0 || $comp_output != "" } {
            send_log "exited abnormally with $cmdret, output:$comp_output\n"
            fail $testname
            continue
        }

        if { $verbose > 2 } then { verbose "output is [file_contents $dumpfile]" 3 }

        # Create the substition list for objdump output.
        set regexp_subst ""
        if { $sect_names != "" } {
            set regexp_subst [list "\\\\?\\.text" [lindex $sect_names 0] \
                                  "\\\\?\\.data" [lindex $sect_names 1] \
                                  "\\\\?\\.bss" [lindex $sect_names 2] ]
        }

        if { [regexp_diff $dumpfile "${dfile}" $regexp_subst] } then {
            fail $testname
            if { $verbose == 2 } then { verbose "output is [file_contents $dumpfile]" 2 }
            continue
        }

        pass $testname
    }
}

proc slurp_options { file } {
    # If options_regsub(foo) is set to {a b}, then the contents of a
    # "#foo:" line will have regsub -all applied to replace a with b.
    global options_regsub

    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 alphanumeric plus underscore.
    set pat "^#${ws}(\[a-zA-Z0-9_\]*)$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!
	    if [info exists options_regsub($opt_name)] {
		set subst $options_regsub($opt_name)
		regsub -all -- [lindex $subst 0] $opt_val [lindex $subst 1] \
		    opt_val
	    }
	    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 set_file_contents { filename contents } {
    set file [open $filename w]
    puts $file "$contents"
    close $file
}

# Look for big-endian or little-endian switches in the multlib
# options and translate these into a -EB or -EL switch.  Note
# we cannot rely upon proc process_multilib_options to do this
# for us because for some targets the compiler does not support
# -EB/-EL but it does support -mbig-endian/-mlittle-endian, and
# the site.exp file will include the switch "-mbig-endian"
# (rather than "big-endian") which is not detected by proc
# process_multilib_options.
#
proc big_or_little_endian {} {

    if [board_info [target_info name] exists multilib_flags] {
	set tmp_flags " [board_info [target_info name] multilib_flags]"

	foreach x $tmp_flags {
	    switch -glob $x {
		*big*endian -
		eb -
		EB -
		-eb -
		-EB -
		-mb -
		-meb {
		    set flags " -EB"
		    return $flags
		}
		*little*endian -
		el -
		EL -
		-el -
		-EL -
		-ml -
		-mel {
		    set flags " -EL"
		    return $flags
		}
	    }
	}
    }

    set flags ""
    return $flags
}

# Internal procedure: return the names of the standard sections
#
proc get_standard_section_names {} {
    if [istarget "rx-*-elf"] {
	return { "P" "D_1" "B_1" }
    }
    if { [istarget "alpha*-*-*vms*"] || [is_som_format] } {
	return { {\$CODE\$} {\$DATA\$} {\$BSS\$} }
    }
    return
}