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

# Copyright (C) 1993-2018 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 xgate-*] } {
	return 1;
    }

    if {    ![istarget *-*-eabi*]
	 && ![istarget *-*-elf*]
	 && ![istarget *-*-freebsd*]
	 && ![istarget *-*-gnu*]
	 && ![istarget *-*-irix5*]
	 && ![istarget *-*-irix6*]
	 && ![istarget *-*-linux*]
	 && ![istarget *-*-lynxos*]
	 && ![istarget *-*-nacl*]
	 && ![istarget *-*-netbsd*]
	 && ![istarget *-*-openbsd*]
	 && ![istarget *-*-rtems*]
	 && ![istarget *-*-solaris2*]
	 && ![istarget *-*-symbianelf*]
	 && ![istarget *-*-sysv4*]
	 && ![istarget *-*-unixware*]
	 && ![istarget *-*-wasm32*]
	 && ![istarget avr-*-*]
	 && ![istarget bfin-*-uclinux]
	 && ![istarget frv-*-uclinux*]
	 && ![istarget hppa*64*-*-hpux*]
	 && ![istarget ia64-*-hpux*]
	 && ![istarget sh*-*-uclinux*]
	 && ![istarget tic6x*-*-uclinux*] } {
	return 0
    }

    if {    [istarget *-*-linux*aout*]
	 || [istarget *-*-linux*ecoff*]
	 || [istarget *-*-linux*oldld*]
	 || [istarget *-*-rtemscoff*]
	 || [istarget i?86-*-freebsd\[12\].*] } {
	return 0
    }

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

    if {    [istarget arm-*-openbsd*]
	 || [istarget i386-*-openbsd\[0-2\].*]
	 || [istarget i386-*-openbsd3.\[0-2\]]
	 || [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 *-*-*\[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 ns32k-*-*]
	 || [istarget pdp11-*-*]
	 || [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 ELF target supports STB_GNU_UNIQUE with the ELF header's
# OSABI field set to ELFOSABI_GNU.
#
# 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 and cannot
# support STB_GNU_UNIQUE.  Likewise non-EABI ARM targets set OSABI to
# ELFOSABI_ARM, and TI C6X targets to ELFOSABI_C6000_*.  Finally
# rather than `bfd_elf_final_link' AM33/2.0, D30V, DLX, and
# picoJava targets use `_bfd_generic_final_link', which does not
# support STB_GNU_UNIQUE symbol binding causing assertion failures.
#
proc supports_gnu_unique {} {
    if { [istarget *-*-gnu*]
	 || [istarget *-*-linux*]
	 || [istarget *-*-nacl*] } {
	return 1
    }
    if { [istarget "arm*-*-*eabi*"] } {
	return 1
    }
    if { [istarget "wasm32*-*-*"] } {
        return 1
    }
    if { ![istarget "*-*-elf*"] } {
	return 0
    }
    if { [istarget "arm*-*-*"]
	 || [istarget "msp430-*-*"]
	 || [istarget "tic6x-*-*"]
	 || [istarget "visium-*-*"] } {
	return 0
    }
    if { [istarget "am33_2.0-*-*"]
	 || [istarget "d30v-*-*"]
	 || [istarget "dlx-*-*"]
	 || [istarget "pj*-*-*"] } {
	return 0
    }
    return 1
}

# 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;
}

# 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
219d1afa	1	# Copyright (C) 1993-2018 Free Software Foundation, Inc.
f3097f33 RS	2	#
	3	# This file is part of the GNU Binutils.
	4	#
	5	# This file is free software; you can redistribute it and/or modify
	6	# it under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# This program is distributed in the hope that it will be useful,
	11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with this program; if not, write to the Free Software
	17	# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
	18	# MA 02110-1301, USA.
	19
	20	# True if the object format is known to be ELF.
	21	#
	22	proc is_elf_format {} {
b3066ae8 AM	23	# config.sub for these targets curiously transforms a target doublet
	24	# ending in -elf to -none. eg. m68hc12-elf to m68hc12-unknown-none
	25	# They are always elf.
	26	if { [istarget m68hc1-] \|\| [istarget xgate-*] } {
	27	return 1;
	28	}
	29
4a85cc09	30	if { ![istarget --eabi*]
f3097f33	31	&& ![istarget --elf*]
4a85cc09	32	&& ![istarget --freebsd*]
f3097f33	33	&& ![istarget --gnu*]
f3097f33 RS	34	&& ![istarget --irix5*]
f3097f33 RS	35	&& ![istarget --irix6*]
4a85cc09	36	&& ![istarget --linux*]
c43b2c54	37	&& ![istarget --lynxos*]
4a85cc09	38	&& ![istarget --nacl*]
f3097f33 RS	39	&& ![istarget --netbsd*]
f3097f33 RS	40	&& ![istarget --openbsd*]
4a85cc09 SKS	41	&& ![istarget --rtems*]
4a85cc09 SKS	42	&& ![istarget --solaris2*]
c43b2c54	43	&& ![istarget --symbianelf*]
4a85cc09 SKS	44	&& ![istarget --sysv4*]
4a85cc09 SKS	45	&& ![istarget --unixware*]
f96bd6c2	46	&& ![istarget --wasm32*]
4a85cc09 SKS	47	&& ![istarget avr--]
	48	&& ![istarget bfin-*-uclinux]
	49	&& ![istarget frv--uclinux]
	50	&& ![istarget hppa64--hpux]
	51	&& ![istarget ia64--hpux]
	52	&& ![istarget sh--uclinux*]
	53	&& ![istarget tic6x--uclinux*] } {
f3097f33 RS	54	return 0
	55	}
	56
4a85cc09	57	if { [istarget --linuxaout]
df26367c	58	\|\| [istarget --linuxecoff]
f3097f33	59	\|\| [istarget --linuxoldld]
4a85cc09	60	\|\| [istarget --rtemscoff*]
a8eb42a8	61	\|\| [istarget i?86--freebsd\[12\].] } {
f3097f33 RS	62	return 0
	63	}
	64
	65	if { ![istarget --netbsdelf*]
4a85cc09	66	&& ( [istarget --netbsdaout]
f3097f33 RS	67	\|\| [istarget --netbsdpe*]
f3097f33 RS	68	\|\| [istarget arm--netbsd*]
f3097f33	69	\|\| [istarget i86--netbsd*]
f3097f33 RS	70	\|\| [istarget vax--netbsd]
	71	\|\| [istarget ns32k--netbsd]) } {
	72	return 0
	73	}
	74
4a85cc09	75	if { [istarget arm--openbsd]
f3097f33 RS	76	\|\| [istarget i386--openbsd\[0-2\].]
f3097f33 RS	77	\|\| [istarget i386-*-openbsd3.\[0-2\]]
f3097f33	78	\|\| [istarget ns32k--openbsd]
f3097f33 RS	79	\|\| [istarget vax--openbsd] } {
	80	return 0
	81	}
	82
	83	return 1
	84	}
	85
	86	# True if the object format is known to be a.out.
	87	#
	88	proc is_aout_format {} {
f3097f33 RS	89	if { [istarget --\[ab\]out]
	90	\|\| [istarget --linuxoldld]
	91	\|\| [istarget --bsd*]
	92	\|\| [istarget --msdos*]
	93	\|\| [istarget arm--netbsd]
	94	\|\| [istarget arm--openbsd]
	95	\|\| [istarget arm--riscix]
7e16ef34	96	\|\| [istarget i?86--freebsd\[12\].]
f3097f33 RS	97	\|\| [istarget i?86--netbsd]
	98	\|\| [istarget i?86--openbsd\[0-2\]]
	99	\|\| [istarget i?86--openbsd3.\[0-2\]]
	100	\|\| [istarget i?86-*-vsta]
	101	\|\| [istarget i?86--mach]
f3097f33 RS	102	\|\| [istarget ns32k--]
f3097f33 RS	103	\|\| [istarget pdp11--]
f3097f33 RS	104	\|\| [istarget vax-dec-ultrix*]
	105	\|\| [istarget vax-*-netbsd] } {
	106	return 1
	107	}
	108	return 0
	109	}
	110
	111	# True if the object format is known to be PE COFF.
	112	#
	113	proc is_pecoff_format {} {
	114	if { ![istarget --mingw*]
	115	&& ![istarget --cygwin*]
	116	&& ![istarget --cegcc*]
	117	&& ![istarget --pe*] } {
	118	return 0
	119	}
	120
	121	return 1
	122	}
	123
	124	# True if the object format is known to be 64-bit ELF.
	125	#
	126	proc is_elf64 { binary_file } {
	127	global READELF
	128	global READELFFLAGS
	129
	130	set readelf_size ""
	131	catch "exec $READELF $READELFFLAGS -h $binary_file > readelf.out" got
	132
	133	if ![string match "" $got] then {
	134	return 0
	135	}
	136
	137	if { ![regexp "\n\[ \]Class:\[ \]ELF(\[0-9\]+)\n" \
	138	[file_contents readelf.out] nil readelf_size] } {
	139	return 0
	140	}
	141
	142	if { $readelf_size == "64" } {
	143	return 1
	144	}
	145
	146	return 0
	147	}
eb22018c	148
a43942db MR	149	# True if the ELF target supports STB_GNU_UNIQUE with the ELF header's
	150	# OSABI field set to ELFOSABI_GNU.
	151	#
	152	# This generally depends on the target OS only, however there are a
	153	# number of exceptions for bare metal targets as follows. The MSP430
	154	# and Visium targets set OSABI to ELFOSABI_STANDALONE and cannot
	155	# support STB_GNU_UNIQUE. Likewise non-EABI ARM targets set OSABI to
	156	# ELFOSABI_ARM, and TI C6X targets to ELFOSABI_C6000_*. Finally
a8eb42a8	157	# rather than `bfd_elf_final_link' AM33/2.0, D30V, DLX, and
a43942db MR	158	# picoJava targets use `_bfd_generic_final_link', which does not
	159	# support STB_GNU_UNIQUE symbol binding causing assertion failures.
	160	#
	161	proc supports_gnu_unique {} {
	162	if { [istarget --gnu*]
	163	\|\| [istarget --linux*]
	164	\|\| [istarget --nacl*] } {
	165	return 1
	166	}
	167	if { [istarget "arm--eabi"] } {
	168	return 1
	169	}
f96bd6c2 PC	170	if { [istarget "wasm32--*"] } {
	171	return 1
	172	}
a43942db MR	173	if { ![istarget "--elf*"] } {
	174	return 0
	175	}
	176	if { [istarget "arm--*"]
	177	\|\| [istarget "msp430--"]
	178	\|\| [istarget "tic6x--"]
	179	\|\| [istarget "visium--"] } {
	180	return 0
	181	}
	182	if { [istarget "am33_2.0--"]
	183	\|\| [istarget "d30v--"]
	184	\|\| [istarget "dlx--"]
a43942db MR	185	\|\| [istarget "pj--*"] } {
	186	return 0
	187	}
	188	return 1
	189	}
	190
9cc0123f AM	191	# True for targets that do not sort .symtab as per the ELF standard.
	192	# ie. any that have mips_elf32_be_vec, mips_elf32_le_vec,
	193	# mips_elf32_n_be_vec or mips_elf32_n_le_vec as the primary bfd target
	194	# vector in config.bfd. When syncing with config.bfd, don't forget that
	195	# earlier case-matches trump later ones.
	196	proc is_bad_symtab {} {
	197	if { ![istarget "mips--*"] } {
	198	return 0;
	199	}
	200	if { [istarget "--chorus*"]
	201	\|\| [istarget "--irix5*"]
	202	\|\| [istarget "--irix6*"]
	203	\|\| [istarget "--none"]
	204	\|\| [istarget "--rtems*"]
	205	\|\| [istarget "--windiss"] } {
	206	return 1;
	207	}
	208	if { [istarget "--elf*"]
	209	&& ![istarget "-sde-"]
	210	&& ![istarget "-mti-"]
	211	&& ![istarget "-img-"] } {
	212	return 1;
	213	}
	214	if { [istarget "--openbsd*"]
	215	&& ![istarget "mips64--*"] } {
	216	return 1;
	217	}
	218	return 0;
	219	}
	220
eb22018c RS	221	# Compare two files line-by-line. FILE_1 is the actual output and FILE_2
	222	# is the expected output. Ignore blank lines in either file.
	223	#
	224	# FILE_2 is a series of regexps, comments and # directives. The directives
	225	# are:
	226	#
	227	# #pass
	228	# Treat the test as a PASS if everything up till this point has
	229	# matched. Ignore any remaining lines in either FILE_1 or FILE_2.
	230	#
	231	# #failif
	232	# Reverse the sense of the test: expect differences to exist.
	233	#
	234	# #...
	235	# REGEXP
	236	# Skip all lines in FILE_1 until the first that matches REGEXP.
	237	#
738f4d98 MR	238	# Other # lines are comments. Regexp lines starting with the `!' character
	239	# specify inverse matching (use `\!' for literal matching against a leading
	240	# `!'). Skip empty lines in both files.
eb22018c RS	241	#
	242	# The first optional argument is a list of regexp substitutions of the form:
	243	#
	244	# EXP1 SUBSPEC1 EXP2 SUBSPEC2 ...
	245	#
	246	# This tells the function to apply each regexp substitution EXPi->SUBSPECi
	247	# in order to every line of FILE_2.
	248	#
	249	# Return nonzero if differences exist.
	250	proc regexp_diff { file_1 file_2 args } {
	251	set eof -1
	252	set end_1 0
	253	set end_2 0
	254	set differences 0
	255	set diff_pass 0
	256	set fail_if_match 0
	257	set ref_subst ""
	258	if { [llength $args] > 0 } {
	259	set ref_subst [lindex $args 0]
	260	}
	261	if { [llength $args] > 1 } {
	262	perror "Too many arguments to regexp_diff"
	263	return 1
	264	}
	265
	266	if [file exists $file_1] then {
	267	set file_a [open $file_1 r]
	268	} else {
	269	perror "$file_1 doesn't exist"
	270	return 1
	271	}
	272
	273	if [file exists $file_2] then {
	274	set file_b [open $file_2 r]
	275	} else {
	276	perror "$file_2 doesn't exist"
	277	close $file_a
	278	return 1
	279	}
	280
	281	verbose " Regexp-diff'ing: $file_1 $file_2" 2
	282
	283	while { 1 } {
	284	set line_a ""
	285	set line_b ""
	286	while { [string length $line_a] == 0 } {
	287	# Ignore blank line in FILE_1.
	288	if { [gets $file_a line_a] == $eof } {
	289	set end_1 1
	290	break
	291	}
	292	}
	293	while { [string length $line_b] == 0 \|\| [string match "#*" $line_b] } {
	294	if { [string match "#pass" $line_b] } {
	295	set end_2 1
	296	set diff_pass 1
	297	break
	298	} elseif { [string match "#failif" $line_b] } {
	299	send_log "fail if no difference\n"
	300	verbose "fail if no difference" 3
	301	set fail_if_match 1
	302	} elseif { [string match "#..." $line_b] } {
	303	if { [gets $file_b line_b] == $eof } {
	304	set end_2 1
305	set diff_pass 1
306	break
307	}
47a50e5b	308	set negated [expr { [string index $line_b 0] == "!" }]
738f4d98 MR	309	set line_bx [string range $line_b $negated end]
738f4d98 MR	310	set n [expr { $negated ? "! " : "" }]
eb22018c RS	311	# Substitute on the reference.
eb22018c RS	312	foreach {name value} $ref_subst {
738f4d98	313	regsub -- $name $line_bx $value line_bx
eb22018c	314	}
738f4d98 MR	315	verbose "looking for $n\"^$line_bx$\"" 3
738f4d98 MR	316	while { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
eb22018c RS	317	verbose "skipping \"$line_a\"" 3
	318	if { [gets $file_a line_a] == $eof } {
	319	set end_1 1
	320	break
	321	}
	322	}
	323	break
	324	}
	325	if { [gets $file_b line_b] == $eof } {
	326	set end_2 1
	327	break
	328	}
	329	}
	330
	331	if { $diff_pass } {
	332	break
	333	} elseif { $end_1 && $end_2 } {
	334	break
	335	} elseif { $end_1 } {
	336	send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
	337	verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
	338	set differences 1
	339	break
	340	} elseif { $end_2 } {
	341	send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
	342	verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
	343	set differences 1
	344	break
	345	} else {
47a50e5b	346	set negated [expr { [string index $line_b 0] == "!" }]
738f4d98 MR	347	set line_bx [string range $line_b $negated end]
	348	set n [expr { $negated ? "! " : "" }]
	349	set s [expr { $negated ? " " : "" }]
eb22018c RS	350	# Substitute on the reference.
eb22018c RS	351	foreach {name value} $ref_subst {
738f4d98	352	regsub -- $name $line_bx $value line_bx
eb22018c	353	}
738f4d98 MR	354	verbose "regexp $n\"^$line_bx$\"\nline \"$line_a\"" 3
738f4d98 MR	355	if { [expr [regexp "^$line_bx$" "$line_a"] == $negated] } {
eb22018c	356	send_log "regexp_diff match failure\n"
738f4d98	357	send_log "regexp $n\"^$line_bx$\"\nline $s\"$line_a\"\n"
eb22018c RS	358	verbose "regexp_diff match failure\n" 3
	359	set differences 1
	360	}
	361	}
	362	}
	363
	364	if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
	365	send_log "$file_1 and $file_2 are different lengths\n"
	366	verbose "$file_1 and $file_2 are different lengths" 3
	367	set differences 1
	368	}
	369
	370	if { $fail_if_match } {
	371	if { $differences == 0 } {
	372	set differences 1
	373	} else {
	374	set differences 0
	375	}
	376	}
	377
	378	close $file_a
	379	close $file_b
	380
	381	return $differences
	382	}