[deliverable/binutils-gdb.git] / binutils / testsuite / lib / binutils-common.exp

# Copyright 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2007,
# 2009, 2010, 2011, 2012 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 {} {
    if { ![istarget *-*-sysv4*]
	 && ![istarget *-*-unixware*]
	 && ![istarget *-*-elf*]
	 && ![istarget *-*-eabi*]
	 && ![istarget *-*-rtems*]
	 && ![istarget hppa*64*-*-hpux*]
	 && ![istarget ia64-*-hpux*]
	 && ![istarget *-*-linux*]
	 && ![istarget *-*-gnu*]
	 && ![istarget *-*-nacl*]
	 && ![istarget frv-*-uclinux*]
	 && ![istarget bfin-*-uclinux]
	 && ![istarget sh*-*-uclinux*]
	 && ![istarget tic6x*-*-uclinux*]
	 && ![istarget *-*-irix5*]
	 && ![istarget *-*-irix6*]
	 && ![istarget *-*-netbsd*]
	 && ![istarget *-*-openbsd*]
	 && ![istarget *-*-solaris2*] } {
	return 0
    }

    if { [istarget *-*-linux*aout*]
	 || [istarget *-*-linux*oldld*]
	 || [istarget h8500-*-rtems*]
	 || [istarget i960-*-rtems*]
	 || [istarget *-*-rtemscoff*] } {
	return 0
    }

    if { ![istarget *-*-netbsdelf*]
	 && ([istarget *-*-netbsd*aout*]
	     || [istarget *-*-netbsdpe*]
	     || [istarget arm*-*-netbsd*]
	     || [istarget sparc-*-netbsd*]
	     || [istarget i*86-*-netbsd*]
	     || [istarget m68*-*-netbsd*]
	     || [istarget vax-*-netbsd*]
	     || [istarget ns32k-*-netbsd*]) } {
    	return 0
    }

    if { [istarget arm-*-openbsd*]
	 || [istarget i386-*-openbsd\[0-2\].*]
	 || [istarget i386-*-openbsd3.\[0-2\]]
	 || [istarget m68*-*-openbsd*]
	 || [istarget ns32k-*-openbsd*]
	 || [istarget sparc-*-openbsd\[0-2\].*]
	 || [istarget sparc-*-openbsd3.\[0-1\]]
	 || [istarget vax-*-openbsd*] } {
	return 0
    }

    return 1
}

# True if the object format is known to be a.out.
#
proc is_aout_format {} {
    if { [istarget *-*-netbsdelf]
	 || [istarget sparc64-*-netbsd*]
	 || [istarget sparc64-*-openbsd*] } {
	return 0
    }
    if { [istarget *-*-*\[ab\]out*]
	 || [istarget *-*-linux*oldld*]
	 || [istarget *-*-bsd*]
	 || [istarget *-*-msdos*]
	 || [istarget arm-*-netbsd*]
	 || [istarget arm-*-openbsd*]
	 || [istarget arm-*-riscix*]
	 || [istarget i?86-*-freebsd\[12\]*]
	 || [istarget i?86-*-netbsd*]
	 || [istarget i?86-*-openbsd\[0-2\]*]
	 || [istarget i?86-*-openbsd3.\[0-2\]*]
	 || [istarget i?86-*-vsta]
	 || [istarget i?86-*-mach*]
	 || [istarget m68*-*-netbsd*]
	 || [istarget m68*-*-openbsd*]
	 || [istarget ns32k-*-*]
	 || [istarget pdp11-*-*]
	 || [istarget sparc*-*-sunos4*]
	 || [istarget sparc*-*-netbsd*]
	 || [istarget sparc*-*-openbsd\[0-2\]*]
	 || [istarget sparc*-*-openbsd3.\[0-1\]*]
	 || [istarget sparc*-fujitsu-none]
	 || [istarget vax-dec-ultrix*]
	 || [istarget vax-*-netbsd] } {
	return 1
    }
    return 0
}

# True if the object format is known to be PE COFF.
#
proc is_pecoff_format {} {
    if { ![istarget *-*-mingw*]
	 && ![istarget *-*-cygwin*]
	 && ![istarget *-*-cegcc*]
	 && ![istarget *-*-pe*] } {
	return 0
    }

    return 1
}

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

    set readelf_size ""
    catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got

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

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

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

    return 0
}

# True if the build supports zlib compression.
proc is_zlib_supported {} {

    # This replicates the AS selection logic of dejagnu's target_assemble.
    global AS_FOR_TARGET
    if [info exists AS_FOR_TARGET] {
	set AS $AS_FOR_TARGET
    } else {
	if {![board_info target exists assembler]} {
	    set AS [find_gas]
	} else {
	    set AS [board_info target assembler]
	}
    }

    set as_output [remote_exec host "$AS --help"]

    set have_zlib 0
    if {[string first "--compress-debug-sections" $as_output] >= 0} {
	set have_zlib 1
    }

    return $have_zlib
}

# 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.
#
# 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
	    }
	    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
}
Commit	Line	Data
f3097f33	1	# Copyright 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2007,
5a68afcf	2	# 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
f3097f33 RS	3	#
	4	# This file is part of the GNU Binutils.
	5	#
	6	# This file is free software; you can redistribute it and/or modify
	7	# it under the terms of the GNU General Public License as published by
	8	# the Free Software Foundation; either version 3 of the License, or
	9	# (at your option) any later version.
	10	#
	11	# This program is distributed in the hope that it will be useful,
	12	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	# GNU General Public License for more details.
	15	#
	16	# You should have received a copy of the GNU General Public License
	17	# along with this program; if not, write to the Free Software
	18	# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
	19	# MA 02110-1301, USA.
	20
	21	# True if the object format is known to be ELF.
	22	#
	23	proc is_elf_format {} {
	24	if { ![istarget --sysv4*]
	25	&& ![istarget --unixware*]
	26	&& ![istarget --elf*]
	27	&& ![istarget --eabi*]
	28	&& ![istarget --rtems*]
	29	&& ![istarget hppa64--hpux]
	30	&& ![istarget ia64--hpux]
	31	&& ![istarget --linux*]
	32	&& ![istarget --gnu*]
5a68afcf	33	&& ![istarget --nacl*]
f3097f33 RS	34	&& ![istarget frv--uclinux]
	35	&& ![istarget bfin-*-uclinux]
	36	&& ![istarget sh--uclinux*]
ac145307	37	&& ![istarget tic6x--uclinux*]
f3097f33 RS	38	&& ![istarget --irix5*]
	39	&& ![istarget --irix6*]
	40	&& ![istarget --netbsd*]
	41	&& ![istarget --openbsd*]
	42	&& ![istarget --solaris2*] } {
	43	return 0
	44	}
	45
	46	if { [istarget --linuxaout]
	47	\|\| [istarget --linuxoldld]
	48	\|\| [istarget h8500--rtems]
	49	\|\| [istarget i960--rtems]
	50	\|\| [istarget --rtemscoff*] } {
	51	return 0
	52	}
	53
	54	if { ![istarget --netbsdelf*]
	55	&& ([istarget --netbsdaout]
	56	\|\| [istarget --netbsdpe*]
	57	\|\| [istarget arm--netbsd*]
	58	\|\| [istarget sparc--netbsd]
	59	\|\| [istarget i86--netbsd*]
	60	\|\| [istarget m68--netbsd*]
	61	\|\| [istarget vax--netbsd]
	62	\|\| [istarget ns32k--netbsd]) } {
	63	return 0
	64	}
	65
	66	if { [istarget arm--openbsd]
	67	\|\| [istarget i386--openbsd\[0-2\].]
	68	\|\| [istarget i386-*-openbsd3.\[0-2\]]
	69	\|\| [istarget m68--openbsd*]
	70	\|\| [istarget ns32k--openbsd]
	71	\|\| [istarget sparc--openbsd\[0-2\].]
	72	\|\| [istarget sparc-*-openbsd3.\[0-1\]]
	73	\|\| [istarget vax--openbsd] } {
	74	return 0
	75	}
	76
	77	return 1
	78	}
	79
	80	# True if the object format is known to be a.out.
	81	#
	82	proc is_aout_format {} {
	83	if { [istarget --netbsdelf]
	84	\|\| [istarget sparc64--netbsd]
	85	\|\| [istarget sparc64--openbsd] } {
	86	return 0
	87	}
	88	if { [istarget --\[ab\]out]
	89	\|\| [istarget --linuxoldld]
	90	\|\| [istarget --bsd*]
	91	\|\| [istarget --msdos*]
	92	\|\| [istarget arm--netbsd]
	93	\|\| [istarget arm--openbsd]
	94	\|\| [istarget arm--riscix]
	95	\|\| [istarget i?86--freebsd\[12\]]
	96	\|\| [istarget i?86--netbsd]
	97	\|\| [istarget i?86--openbsd\[0-2\]]
	98	\|\| [istarget i?86--openbsd3.\[0-2\]]
	99	\|\| [istarget i?86-*-vsta]
	100	\|\| [istarget i?86--mach]
	101	\|\| [istarget m68--netbsd*]
102	\|\| [istarget m68--openbsd*]
103	\|\| [istarget ns32k--]
104	\|\| [istarget pdp11--]
105	\|\| [istarget sparc--sunos4*]
106	\|\| [istarget sparc--netbsd*]
107	\|\| [istarget sparc--openbsd\[0-2\]*]
108	\|\| [istarget sparc--openbsd3.\[0-1\]*]
109	\|\| [istarget sparc*-fujitsu-none]
110	\|\| [istarget vax-dec-ultrix*]
111	\|\| [istarget vax-*-netbsd] } {
112	return 1
113	}
114	return 0
115	}
116
117	# True if the object format is known to be PE COFF.
118	#
119	proc is_pecoff_format {} {
120	if { ![istarget --mingw*]
121	&& ![istarget --cygwin*]
122	&& ![istarget --cegcc*]
123	&& ![istarget --pe*] } {
124	return 0
125	}
126
127	return 1
128	}
129
130	# True if the object format is known to be 64-bit ELF.
131	#
132	proc is_elf64 { binary_file } {
133	global READELF
134	global READELFFLAGS
135
136	set readelf_size ""
137	catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got
138
139	if ![string match "" $got] then {
140	return 0
141	}
142
143	if { ![regexp "\n\[ \]Class:\[ \]ELF(\[0-9\]+)\n" \
144	[file_contents readelf.out] nil readelf_size] } {
145	return 0
146	}
147
148	if { $readelf_size == "64" } {
149	return 1
150	}
151
152	return 0
153	}
eb22018c	154
65951855 RM	155	# True if the build supports zlib compression.
	156	proc is_zlib_supported {} {
	157
	158	# This replicates the AS selection logic of dejagnu's target_assemble.
	159	global AS_FOR_TARGET
	160	if [info exists AS_FOR_TARGET] {
	161	set AS $AS_FOR_TARGET
	162	} else {
	163	if {![board_info target exists assembler]} {
	164	set AS [find_gas]
	165	} else {
	166	set AS [board_info target assembler]
	167	}
	168	}
	169
	170	set as_output [remote_exec host "$AS --help"]
	171
	172	set have_zlib 0
	173	if {[string first "--compress-debug-sections" $as_output] >= 0} {
	174	set have_zlib 1
	175	}
	176
	177	return $have_zlib
	178	}
	179
eb22018c RS	180	# Compare two files line-by-line. FILE_1 is the actual output and FILE_2
	181	# is the expected output. Ignore blank lines in either file.
	182	#
	183	# FILE_2 is a series of regexps, comments and # directives. The directives
	184	# are:
	185	#
	186	# #pass
	187	# Treat the test as a PASS if everything up till this point has
	188	# matched. Ignore any remaining lines in either FILE_1 or FILE_2.
	189	#
	190	# #failif
	191	# Reverse the sense of the test: expect differences to exist.
	192	#
	193	# #...
	194	# REGEXP
	195	# Skip all lines in FILE_1 until the first that matches REGEXP.
	196	#
738f4d98 MR	197	# Other # lines are comments. Regexp lines starting with the `!' character
	198	# specify inverse matching (use `\!' for literal matching against a leading
	199	# `!'). Skip empty lines in both files.
eb22018c RS	200	#
	201	# The first optional argument is a list of regexp substitutions of the form:
	202	#
	203	# EXP1 SUBSPEC1 EXP2 SUBSPEC2 ...
	204	#
	205	# This tells the function to apply each regexp substitution EXPi->SUBSPECi
	206	# in order to every line of FILE_2.
	207	#
	208	# Return nonzero if differences exist.
	209	proc regexp_diff { file_1 file_2 args } {
	210	set eof -1
	211	set end_1 0
	212	set end_2 0
	213	set differences 0
	214	set diff_pass 0
	215	set fail_if_match 0
	216	set ref_subst ""
	217	if { [llength $args] > 0 } {
	218	set ref_subst [lindex $args 0]
	219	}
	220	if { [llength $args] > 1 } {
	221	perror "Too many arguments to regexp_diff"
	222	return 1
	223	}
	224
	225	if [file exists $file_1] then {
	226	set file_a [open $file_1 r]
	227	} else {
	228	perror "$file_1 doesn't exist"
	229	return 1
	230	}
	231
	232	if [file exists $file_2] then {
	233	set file_b [open $file_2 r]
	234	} else {
	235	perror "$file_2 doesn't exist"
	236	close $file_a
	237	return 1
	238	}
	239
	240	verbose " Regexp-diff'ing: $file_1 $file_2" 2
	241
	242	while { 1 } {
	243	set line_a ""
	244	set line_b ""
	245	while { [string length $line_a] == 0 } {
	246	# Ignore blank line in FILE_1.
	247	if { [gets $file_a line_a] == $eof } {
	248	set end_1 1
	249	break
	250	}
	251	}
	252	while { [string length $line_b] == 0 \|\| [string match "#*" $line_b] } {
	253	if { [string match "#pass" $line_b] } {
	254	set end_2 1
	255	set diff_pass 1
	256	break
	257	} elseif { [string match "#failif" $line_b] } {
	258	send_log "fail if no difference\n"
	259	verbose "fail if no difference" 3
	260	set fail_if_match 1
	261	} elseif { [string match "#..." $line_b] } {
	262	if { [gets $file_b line_b] == $eof } {
	263	set end_2 1
264	set diff_pass 1
265	break
266	}
47a50e5b	267	set negated [expr { [string index $line_b 0] == "!" }]
738f4d98 MR	268	set line_bx [string range $line_b $negated end]
738f4d98 MR	269	set n [expr { $negated ? "! " : "" }]
eb22018c RS	270	# Substitute on the reference.
eb22018c RS	271	foreach {name value} $ref_subst {
738f4d98	272	regsub -- $name $line_bx $value line_bx
eb22018c	273	}
738f4d98 MR	274	verbose "looking for $n\"^$line_bx$\"" 3
738f4d98 MR	275	while { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
eb22018c RS	276	verbose "skipping \"$line_a\"" 3
	277	if { [gets $file_a line_a] == $eof } {
	278	set end_1 1
	279	break
	280	}
	281	}
	282	break
	283	}
	284	if { [gets $file_b line_b] == $eof } {
	285	set end_2 1
	286	break
	287	}
	288	}
	289
	290	if { $diff_pass } {
	291	break
	292	} elseif { $end_1 && $end_2 } {
	293	break
	294	} elseif { $end_1 } {
	295	send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
	296	verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
	297	set differences 1
	298	break
	299	} elseif { $end_2 } {
	300	send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
	301	verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
	302	set differences 1
	303	break
	304	} else {
47a50e5b	305	set negated [expr { [string index $line_b 0] == "!" }]
738f4d98 MR	306	set line_bx [string range $line_b $negated end]
	307	set n [expr { $negated ? "! " : "" }]
	308	set s [expr { $negated ? " " : "" }]
eb22018c RS	309	# Substitute on the reference.
eb22018c RS	310	foreach {name value} $ref_subst {
738f4d98	311	regsub -- $name $line_bx $value line_bx
eb22018c	312	}
738f4d98 MR	313	verbose "regexp $n\"^$line_bx$\"\nline \"$line_a\"" 3
738f4d98 MR	314	if { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
eb22018c	315	send_log "regexp_diff match failure\n"
738f4d98	316	send_log "regexp $n\"^$line_bx$\"\nline $s\"$line_a\"\n"
eb22018c RS	317	verbose "regexp_diff match failure\n" 3
	318	set differences 1
	319	}
	320	}
	321	}
	322
	323	if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
	324	send_log "$file_1 and $file_2 are different lengths\n"
	325	verbose "$file_1 and $file_2 are different lengths" 3
	326	set differences 1
	327	}
	328
	329	if { $fail_if_match } {
	330	if { $differences == 0 } {
	331	set differences 1
	332	} else {
	333	set differences 0
	334	}
	335	}
	336
	337	close $file_a
	338	close $file_b
	339
	340	return $differences
	341	}