[thirdparty/gcc.git] / gcc / testsuite / lib / asan-dg.exp

# Copyright (C) 2012-2020 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3.  If not see
# <http://www.gnu.org/licenses/>.

# Return 1 if compilation with -fsanitize=address is error-free for trivial
# code, 0 otherwise.

proc check_effective_target_fsanitize_address {} {
    if ![check_no_compiler_messages fsanitize_address executable {
	int main (void) { return 0; }
    }] {
	return 0;
    }

    # asan doesn't work if there's a ulimit on virtual memory.
    if ![is_remote target] {
	if [catch {exec sh -c "ulimit -v"} ulimit_v] {
	    # failed to get ulimit
	} elseif [regexp {^[0-9]+$} $ulimit_v] {
	    # ulimit -v gave a numeric limit
	    warning "skipping asan tests due to ulimit -v"
	    return 0;
	}
    }

    return 1;
}

proc asan_include_flags {} {
    global srcdir
    global TESTING_IN_BUILD_TREE

    set flags ""

    if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } {
      return "${flags}"
    }

    set flags "-I$srcdir/../../libsanitizer/include"

    return "$flags"
}

#
# asan_link_flags -- compute library path and flags to find libasan.
# (originally from g++.exp)
#

proc asan_link_flags { paths } {
    global srcdir
    global ld_library_path
    global shlib_ext
    global asan_saved_library_path

    set gccpath ${paths}
    set flags ""

    set shlib_ext [get_shlib_extension]
    set asan_saved_library_path $ld_library_path

    if { $gccpath != "" } {
      if { [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.a"]
	   || [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.${shlib_ext}"] } {
	  append flags " -B${gccpath}/libsanitizer/ "
	  append flags " -B${gccpath}/libsanitizer/asan/ "
	  append flags " -L${gccpath}/libsanitizer/asan/.libs "
	  append ld_library_path ":${gccpath}/libsanitizer/asan/.libs"
      }
    } else {
      global tool_root_dir

      set libasan [lookfor_file ${tool_root_dir} libasan]
      if { $libasan != "" } {
	  append flags "-L${libasan} "
	  append ld_library_path ":${libasan}"
      }
    }

    set_ld_library_path_env_vars

    return "$flags"
}

#
# asan_init -- called at the start of each subdir of tests
#

proc asan_init { args } {
    global TEST_ALWAYS_FLAGS
    global ALWAYS_CXXFLAGS
    global TOOL_OPTIONS
    global asan_saved_TEST_ALWAYS_FLAGS
    global asan_saved_ALWAYS_CXXFLAGS

    set link_flags ""
    if ![is_remote host] {
	if [info exists TOOL_OPTIONS] {
	    set link_flags "[asan_link_flags [get_multilibs ${TOOL_OPTIONS}]]"
	} else {
	    set link_flags "[asan_link_flags [get_multilibs]]"
	}
    }

    set include_flags "[asan_include_flags]"

    if [info exists TEST_ALWAYS_FLAGS] {
	set asan_saved_TEST_ALWAYS_FLAGS $TEST_ALWAYS_FLAGS
    }
    if [info exists ALWAYS_CXXFLAGS] {
	set asan_saved_ALWAYS_CXXFLAGS $ALWAYS_CXXFLAGS
	set ALWAYS_CXXFLAGS [concat "{ldflags=$link_flags}" $ALWAYS_CXXFLAGS]
	set ALWAYS_CXXFLAGS [concat "{additional_flags=-fsanitize=address -g $include_flags}" $ALWAYS_CXXFLAGS]
    } else {
	if [info exists TEST_ALWAYS_FLAGS] {
	    set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags $TEST_ALWAYS_FLAGS"
	} else {
	    set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags"
	}
    }
}

#
# asan_finish -- called at the start of each subdir of tests
#

proc asan_finish { args } {
    global TEST_ALWAYS_FLAGS
    global asan_saved_TEST_ALWAYS_FLAGS
    global asan_saved_ALWAYS_CXXFLAGS
    global asan_saved_library_path
    global ld_library_path

    if [info exists asan_saved_ALWAYS_CXXFLAGS ] {
	set ALWAYS_CXXFLAGS $asan_saved_ALWAYS_CXXFLAGS
    } else {
	if [info exists asan_saved_TEST_ALWAYS_FLAGS] {
	    set TEST_ALWAYS_FLAGS $asan_saved_TEST_ALWAYS_FLAGS
	} else {
	    unset TEST_ALWAYS_FLAGS
	}
    }
    set ld_library_path $asan_saved_library_path
    set_ld_library_path_env_vars
    clear_effective_target_cache
}

# Symbolize lines like
#   #2 0xdeadbeef (/some/path/libsanitizer.so.0.0.0+0xbeef)
# in $output using addr2line to
#   #2 0xdeadbeef in foobar file:123
proc asan_symbolize { output } {
    set addresses [regexp -inline -all -line "^ *#\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+)\[+\](0x\[0-9a-f\]+)\[)\]$" "$output"]
    if { [llength $addresses] > 0 } {
	set addr2line_name [find_binutils_prog addr2line]
	set idx 1
	while { $idx < [llength $addresses] } {
	    set key [regsub -all "\[\]\[\]" [lindex $addresses $idx] "\\\\&"]
	    set val [lindex $addresses [expr $idx + 1]]
	    lappend arr($key) $val
	    set idx [expr $idx + 3]
	}
	foreach key [array names arr] {
	    set args "-f -e $key $arr($key)"
	    set status [remote_exec host "$addr2line_name" "$args"]
	    if { [lindex $status 0] > 0 } continue
	    regsub -all "\r\n" [lindex $status 1] "\n" addr2line_output
	    regsub -all "\[\n\r\]BFD: \[^\n\r\]*" $addr2line_output "" addr2line_output
	    regsub -all "^BFD: \[^\n\r\]*\[\n\r\]" $addr2line_output "" addr2line_output
	    set addr2line_output [regexp -inline -all -line "^\[^\n\r]*" $addr2line_output]
	    set idx 0
	    foreach val $arr($key) {
		if { [expr $idx + 1] < [llength $addr2line_output] } {
		    set fnname [lindex $addr2line_output $idx]
		    set fileline [lindex $addr2line_output [expr $idx + 1]]
		    if { "$fnname" != "??" } {
			set newkey "$key+$val"
			set repl($newkey) "$fnname $fileline"
		    }
		    set idx [expr $idx + 2]
		}
	    }
	}
	set idx 0
	set new_output ""
	while {[regexp -start $idx -indices " #\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+\[+\]0x\[0-9a-f\]+)\[)\]" "$output" -> addr] > 0} {
	    set low [lindex $addr 0]
	    set high [lindex $addr 1]
	    set val [string range "$output" $low $high]
	    append new_output [string range "$output" $idx [expr $low - 2]]
	    if [info exists repl($val)] {
		append new_output "in $repl($val)"
	    } else {
		append new_output "($val)"
	    }
	    set idx [expr $high + 2]
	}
	append new_output [string range "$output" $idx [string length "$output"]]
	return "$new_output"
    }
    return "$output"
}

# Return a list of gtest tests, printed in the form
# DEJAGNU_GTEST_TEST AddressSanitizer_SimpleDeathTest
# DEJAGNU_GTEST_TEST AddressSanitizer_VariousMallocsTest
proc asan_get_gtest_test_list { output } {
    set idx 0
    set ret ""
    while {[regexp -start $idx -indices "DEJAGNU_GTEST_TEST (\[^\n\r\]*)(\r\n|\n|\r)" "$output" -> testname] > 0} {
	set low [lindex $testname 0]
	set high [lindex $testname 1]
	set val [string range "$output" $low $high]
	lappend ret $val
	set idx [expr $high + 1]
    }
    return $ret
}

# Return a list of gtest EXPECT_DEATH tests, printed in the form
# DEJAGNU_GTEST_EXPECT_DEATH1 statement DEJAGNU_GTEST_EXPECT_DEATH1 regexp DEJAGNU_GTEST_EXPECT_DEATH1
# DEJAGNU_GTEST_EXPECT_DEATH2 other statement DEJAGNU_GTEST_EXPECT_DEATH2 other regexp DEJAGNU_GTEST_EXPECT_DEATH2
proc asan_get_gtest_expect_death_list { output } {
    set idx 0
    set ret ""
    while {[regexp -start $idx -indices "DEJAGNU_GTEST_EXPECT_DEATH(\[0-9\]*)" "$output" -> id ] > 0} {
	set low [lindex $id 0]
	set high [lindex $id 1]
	set val_id [string range "$output" $low $high]
	if {[regexp -start $low -indices "$val_id (.*) DEJAGNU_GTEST_EXPECT_DEATH$val_id (.*) DEJAGNU_GTEST_EXPECT_DEATH$val_id\[\n\r\]" "$output" whole statement regexpr ] == 0} { break }
	set low [lindex $statement 0]
	set high [lindex $statement 1]
	set val_statement [string range "$output" $low $high]
	set low [lindex $regexpr 0]
	set high [lindex $regexpr 1]
	set val_regexpr [string range "$output" $low $high]
	lappend ret [list "$val_id" "$val_statement" "$val_regexpr"]
	set idx [lindex $whole 1]
    }
    return $ret
}

# Replace ${tool}_load with a wrapper so that we can symbolize the output.
if { [info procs ${tool}_load] != [list] \
      && [info procs saved_asan_${tool}_load] == [list] } {
    rename ${tool}_load saved_asan_${tool}_load

    proc ${tool}_load { program args } {
	global tool
	global asan_last_gtest_test_list
	global asan_last_gtest_expect_death_list
	set result [eval [list saved_asan_${tool}_load $program] $args]
	set output [lindex $result 1]
	set symbolized_output [asan_symbolize "$output"]
	set asan_last_gtest_test_list [asan_get_gtest_test_list "$output"]
	set asan_last_gtest_expect_death_list [asan_get_gtest_expect_death_list "$output"]
	set result [list [lindex $result 0] $symbolized_output]
	return $result
    }
}

# Utility for running gtest asan emulation under dejagnu, invoked via dg-final.
# Call pass if variable has the desired value, otherwise fail.
#
# Argument 0 handles expected failures and the like
proc asan-gtest { args } {
    global tool
    global asan_last_gtest_test_list
    global asan_last_gtest_expect_death_list

    if { ![info exists asan_last_gtest_test_list] } { return }
    if { [llength $asan_last_gtest_test_list] == 0 } { return }
    if { ![isnative] || [is_remote target] } { return }

    set gtest_test_list $asan_last_gtest_test_list
    unset asan_last_gtest_test_list

    if { [llength $args] >= 1 } {
	switch [dg-process-target [lindex $args 0]] {
	    "S" { }
	    "N" { return }
	    "F" { setup_xfail "*-*-*" }
	    "P" { }
	}
    }

    # This assumes that we are three frames down from dg-test, and that
    # it still stores the filename of the testcase in a local variable "name".
    # A cleaner solution would require a new DejaGnu release.
    upvar 2 name testcase
    upvar 2 prog prog

    set output_file "[file rootname [file tail $prog]].exe"

    foreach gtest $gtest_test_list {
	set testname "$testcase $gtest"
	set status -1

	setenv DEJAGNU_GTEST_ARG "$gtest"
	set result [${tool}_load ./$output_file $gtest]
	unsetenv DEJAGNU_GTEST_ARG
	set status [lindex $result 0]
	set output [lindex $result 1]
	if { "$status" == "pass" } {
	    pass "$testname execution test"
	    if { [info exists asan_last_gtest_expect_death_list] } {
		set gtest_expect_death_list $asan_last_gtest_expect_death_list
		foreach gtest_death $gtest_expect_death_list {
		    set id [lindex $gtest_death 0]
		    set testname "$testcase $gtest [lindex $gtest_death 1]"
		    set regexpr [lindex $gtest_death 2]
		    set status -1

		    setenv DEJAGNU_GTEST_ARG "$gtest:$id"
		    set result [${tool}_load ./$output_file "$gtest:$id"]
		    unsetenv DEJAGNU_GTEST_ARG
		    set status [lindex $result 0]
		    set output [lindex $result 1]
		    if { "$status" == "fail" } {
			pass "$testname execution test"
			if { ![regexp $regexpr ${output}] } {
			    fail "$testname output pattern test"
			    send_log "Output should match: $regexpr\n"
			} else {
			    pass "$testname output pattern test"
			}
		    } elseif { "$status" == "pass" } {
			fail "$testname execution test"
		    } else {
			$status "$testname execution test"
		    }
		}
	    }
	} else {
	    $status "$testname execution test"
	}
	unset asan_last_gtest_expect_death_list
    }

    return
}
Commit	Line	Data
8d9254fc	1	# Copyright (C) 2012-2020 Free Software Foundation, Inc.
8335a643 JJ	2
	3	# This program is free software; you can redistribute it and/or modify
	4	# it under the terms of the GNU General Public License as published by
	5	# the Free Software Foundation; either version 3 of the License, or
	6	# (at your option) any later version.
	7	#
	8	# This program is distributed in the hope that it will be useful,
	9	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	# GNU General Public License for more details.
	12	#
	13	# You should have received a copy of the GNU General Public License
	14	# along with GCC; see the file COPYING3. If not see
	15	# <http://www.gnu.org/licenses/>.
	16
dde19676	17	# Return 1 if compilation with -fsanitize=address is error-free for trivial
8335a643 JJ	18	# code, 0 otherwise.
8335a643 JJ	19
9fbbb20d	20	proc check_effective_target_fsanitize_address {} {
34ffaf66	21	if ![check_no_compiler_messages fsanitize_address executable {
9fbbb20d	22	int main (void) { return 0; }
34ffaf66 JM	23	}] {
	24	return 0;
	25	}
	26
	27	# asan doesn't work if there's a ulimit on virtual memory.
	28	if ![is_remote target] {
	29	if [catch {exec sh -c "ulimit -v"} ulimit_v] {
	30	# failed to get ulimit
	31	} elseif [regexp {^[0-9]+$} $ulimit_v] {
	32	# ulimit -v gave a numeric limit
	33	warning "skipping asan tests due to ulimit -v"
	34	return 0;
	35	}
	36	}
	37
	38	return 1;
8335a643 JJ	39	}
8335a643 JJ	40
2675305b YG	41	proc asan_include_flags {} {
	42	global srcdir
	43	global TESTING_IN_BUILD_TREE
	44
	45	set flags ""
	46
	47	if { [is_remote host] \|\| ! [info exists TESTING_IN_BUILD_TREE] } {
	48	return "${flags}"
	49	}
	50
	51	set flags "-I$srcdir/../../libsanitizer/include"
	52
	53	return "$flags"
	54	}
	55
8335a643 JJ	56	#
	57	# asan_link_flags -- compute library path and flags to find libasan.
	58	# (originally from g++.exp)
	59	#
	60
	61	proc asan_link_flags { paths } {
	62	global srcdir
	63	global ld_library_path
	64	global shlib_ext
06a04ce7	65	global asan_saved_library_path
8335a643 JJ	66
	67	set gccpath ${paths}
	68	set flags ""
	69
	70	set shlib_ext [get_shlib_extension]
06a04ce7	71	set asan_saved_library_path $ld_library_path
8335a643 JJ	72
	73	if { $gccpath != "" } {
	74	if { [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.a"]
	75	\|\| [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.${shlib_ext}"] } {
cc41e336	76	append flags " -B${gccpath}/libsanitizer/ "
b33593ab	77	append flags " -B${gccpath}/libsanitizer/asan/ "
8335a643 JJ	78	append flags " -L${gccpath}/libsanitizer/asan/.libs "
	79	append ld_library_path ":${gccpath}/libsanitizer/asan/.libs"
	80	}
	81	} else {
	82	global tool_root_dir
	83
	84	set libasan [lookfor_file ${tool_root_dir} libasan]
	85	if { $libasan != "" } {
	86	append flags "-L${libasan} "
	87	append ld_library_path ":${libasan}"
	88	}
	89	}
	90
	91	set_ld_library_path_env_vars
	92
	93	return "$flags"
	94	}
	95
	96	#
	97	# asan_init -- called at the start of each subdir of tests
	98	#
	99
	100	proc asan_init { args } {
	101	global TEST_ALWAYS_FLAGS
	102	global ALWAYS_CXXFLAGS
	103	global TOOL_OPTIONS
	104	global asan_saved_TEST_ALWAYS_FLAGS
9fbbb20d	105	global asan_saved_ALWAYS_CXXFLAGS
8335a643 JJ	106
	107	set link_flags ""
	108	if ![is_remote host] {
	109	if [info exists TOOL_OPTIONS] {
	110	set link_flags "[asan_link_flags [get_multilibs ${TOOL_OPTIONS}]]"
	111	} else {
	112	set link_flags "[asan_link_flags [get_multilibs]]"
	113	}
	114	}
	115
2675305b YG	116	set include_flags "[asan_include_flags]"
2675305b YG	117
8335a643 JJ	118	if [info exists TEST_ALWAYS_FLAGS] {
	119	set asan_saved_TEST_ALWAYS_FLAGS $TEST_ALWAYS_FLAGS
	120	}
	121	if [info exists ALWAYS_CXXFLAGS] {
9fbbb20d	122	set asan_saved_ALWAYS_CXXFLAGS $ALWAYS_CXXFLAGS
8335a643	123	set ALWAYS_CXXFLAGS [concat "{ldflags=$link_flags}" $ALWAYS_CXXFLAGS]
2675305b	124	set ALWAYS_CXXFLAGS [concat "{additional_flags=-fsanitize=address -g $include_flags}" $ALWAYS_CXXFLAGS]
8335a643 JJ	125	} else {
8335a643 JJ	126	if [info exists TEST_ALWAYS_FLAGS] {
2675305b	127	set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags $TEST_ALWAYS_FLAGS"
8335a643	128	} else {
2675305b	129	set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags"
8335a643 JJ	130	}
	131	}
	132	}
	133
	134	#
	135	# asan_finish -- called at the start of each subdir of tests
	136	#
	137
	138	proc asan_finish { args } {
	139	global TEST_ALWAYS_FLAGS
	140	global asan_saved_TEST_ALWAYS_FLAGS
9fbbb20d	141	global asan_saved_ALWAYS_CXXFLAGS
06a04ce7 MO	142	global asan_saved_library_path
06a04ce7 MO	143	global ld_library_path
8335a643	144
9fbbb20d AP	145	if [info exists asan_saved_ALWAYS_CXXFLAGS ] {
9fbbb20d AP	146	set ALWAYS_CXXFLAGS $asan_saved_ALWAYS_CXXFLAGS
8335a643	147	} else {
9fbbb20d AP	148	if [info exists asan_saved_TEST_ALWAYS_FLAGS] {
	149	set TEST_ALWAYS_FLAGS $asan_saved_TEST_ALWAYS_FLAGS
	150	} else {
	151	unset TEST_ALWAYS_FLAGS
	152	}
8335a643	153	}
06a04ce7 MO	154	set ld_library_path $asan_saved_library_path
06a04ce7 MO	155	set_ld_library_path_env_vars
dfda198c	156	clear_effective_target_cache
8335a643 JJ	157	}
	158
	159	# Symbolize lines like
	160	# #2 0xdeadbeef (/some/path/libsanitizer.so.0.0.0+0xbeef)
	161	# in $output using addr2line to
	162	# #2 0xdeadbeef in foobar file:123
	163	proc asan_symbolize { output } {
	164	set addresses [regexp -inline -all -line "^ *#\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+)\[+\](0x\[0-9a-f\]+)\[)\]$" "$output"]
	165	if { [llength $addresses] > 0 } {
	166	set addr2line_name [find_binutils_prog addr2line]
	167	set idx 1
	168	while { $idx < [llength $addresses] } {
5c31da80	169	set key [regsub -all "\[\]\[\]" [lindex $addresses $idx] "\\\\&"]
8335a643 JJ	170	set val [lindex $addresses [expr $idx + 1]]
	171	lappend arr($key) $val
	172	set idx [expr $idx + 3]
	173	}
	174	foreach key [array names arr] {
	175	set args "-f -e $key $arr($key)"
5c31da80	176	set status [remote_exec host "$addr2line_name" "$args"]
8335a643	177	if { [lindex $status 0] > 0 } continue
0d4f214e	178	regsub -all "\r\n" [lindex $status 1] "\n" addr2line_output
644525ff JJ	179	regsub -all "\[\n\r\]BFD: \[^\n\r\]*" $addr2line_output "" addr2line_output
644525ff JJ	180	regsub -all "^BFD: \[^\n\r\]*\[\n\r\]" $addr2line_output "" addr2line_output
0d4f214e	181	set addr2line_output [regexp -inline -all -line "^\[^\n\r]*" $addr2line_output]
8335a643 JJ	182	set idx 0
	183	foreach val $arr($key) {
	184	if { [expr $idx + 1] < [llength $addr2line_output] } {
	185	set fnname [lindex $addr2line_output $idx]
	186	set fileline [lindex $addr2line_output [expr $idx + 1]]
	187	if { "$fnname" != "??" } {
	188	set newkey "$key+$val"
	189	set repl($newkey) "$fnname $fileline"
	190	}
0d4f214e	191	set idx [expr $idx + 2]
8335a643 JJ	192	}
	193	}
	194	}
	195	set idx 0
	196	set new_output ""
	197	while {[regexp -start $idx -indices " #\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+\[+\]0x\[0-9a-f\]+)\[)\]" "$output" -> addr] > 0} {
	198	set low [lindex $addr 0]
	199	set high [lindex $addr 1]
	200	set val [string range "$output" $low $high]
	201	append new_output [string range "$output" $idx [expr $low - 2]]
	202	if [info exists repl($val)] {
	203	append new_output "in $repl($val)"
	204	} else {
	205	append new_output "($val)"
	206	}
	207	set idx [expr $high + 2]
	208	}
	209	append new_output [string range "$output" $idx [string length "$output"]]
	210	return "$new_output"
	211	}
	212	return "$output"
	213	}
	214
5c31da80 JJ	215	# Return a list of gtest tests, printed in the form
	216	# DEJAGNU_GTEST_TEST AddressSanitizer_SimpleDeathTest
	217	# DEJAGNU_GTEST_TEST AddressSanitizer_VariousMallocsTest
	218	proc asan_get_gtest_test_list { output } {
	219	set idx 0
	220	set ret ""
	221	while {[regexp -start $idx -indices "DEJAGNU_GTEST_TEST (\[^\n\r\]*)(\r\n\|\n\|\r)" "$output" -> testname] > 0} {
	222	set low [lindex $testname 0]
	223	set high [lindex $testname 1]
	224	set val [string range "$output" $low $high]
	225	lappend ret $val
	226	set idx [expr $high + 1]
	227	}
	228	return $ret
	229	}
	230
	231	# Return a list of gtest EXPECT_DEATH tests, printed in the form
	232	# DEJAGNU_GTEST_EXPECT_DEATH1 statement DEJAGNU_GTEST_EXPECT_DEATH1 regexp DEJAGNU_GTEST_EXPECT_DEATH1
	233	# DEJAGNU_GTEST_EXPECT_DEATH2 other statement DEJAGNU_GTEST_EXPECT_DEATH2 other regexp DEJAGNU_GTEST_EXPECT_DEATH2
	234	proc asan_get_gtest_expect_death_list { output } {
	235	set idx 0
	236	set ret ""
	237	while {[regexp -start $idx -indices "DEJAGNU_GTEST_EXPECT_DEATH(\[0-9\]*)" "$output" -> id ] > 0} {
	238	set low [lindex $id 0]
	239	set high [lindex $id 1]
	240	set val_id [string range "$output" $low $high]
	241	if {[regexp -start $low -indices "$val_id (.) DEJAGNU_GTEST_EXPECT_DEATH$val_id (.) DEJAGNU_GTEST_EXPECT_DEATH$val_id\[\n\r\]" "$output" whole statement regexpr ] == 0} { break }
	242	set low [lindex $statement 0]
	243	set high [lindex $statement 1]
	244	set val_statement [string range "$output" $low $high]
	245	set low [lindex $regexpr 0]
	246	set high [lindex $regexpr 1]
	247	set val_regexpr [string range "$output" $low $high]
	248	lappend ret [list "$val_id" "$val_statement" "$val_regexpr"]
	249	set idx [lindex $whole 1]
	250	}
	251	return $ret
	252	}
	253
8335a643 JJ	254	# Replace ${tool}_load with a wrapper so that we can symbolize the output.
	255	if { [info procs ${tool}_load] != [list] \
	256	&& [info procs saved_asan_${tool}_load] == [list] } {
	257	rename ${tool}_load saved_asan_${tool}_load
	258
	259	proc ${tool}_load { program args } {
	260	global tool
5c31da80 JJ	261	global asan_last_gtest_test_list
5c31da80 JJ	262	global asan_last_gtest_expect_death_list
8335a643 JJ	263	set result [eval [list saved_asan_${tool}_load $program] $args]
	264	set output [lindex $result 1]
	265	set symbolized_output [asan_symbolize "$output"]
5c31da80 JJ	266	set asan_last_gtest_test_list [asan_get_gtest_test_list "$output"]
5c31da80 JJ	267	set asan_last_gtest_expect_death_list [asan_get_gtest_expect_death_list "$output"]
8335a643 JJ	268	set result [list [lindex $result 0] $symbolized_output]
	269	return $result
	270	}
	271	}
5c31da80 JJ	272
	273	# Utility for running gtest asan emulation under dejagnu, invoked via dg-final.
	274	# Call pass if variable has the desired value, otherwise fail.
	275	#
	276	# Argument 0 handles expected failures and the like
	277	proc asan-gtest { args } {
	278	global tool
	279	global asan_last_gtest_test_list
	280	global asan_last_gtest_expect_death_list
	281
	282	if { ![info exists asan_last_gtest_test_list] } { return }
	283	if { [llength $asan_last_gtest_test_list] == 0 } { return }
	284	if { ![isnative] \|\| [is_remote target] } { return }
	285
	286	set gtest_test_list $asan_last_gtest_test_list
	287	unset asan_last_gtest_test_list
	288
	289	if { [llength $args] >= 1 } {
	290	switch [dg-process-target [lindex $args 0]] {
	291	"S" { }
	292	"N" { return }
	293	"F" { setup_xfail "--*" }
	294	"P" { }
	295	}
	296	}
	297
	298	# This assumes that we are three frames down from dg-test, and that
	299	# it still stores the filename of the testcase in a local variable "name".
	300	# A cleaner solution would require a new DejaGnu release.
	301	upvar 2 name testcase
	302	upvar 2 prog prog
	303
	304	set output_file "[file rootname [file tail $prog]].exe"
	305
	306	foreach gtest $gtest_test_list {
	307	set testname "$testcase $gtest"
	308	set status -1
	309
	310	setenv DEJAGNU_GTEST_ARG "$gtest"
	311	set result [${tool}_load ./$output_file $gtest]
	312	unsetenv DEJAGNU_GTEST_ARG
	313	set status [lindex $result 0]
	314	set output [lindex $result 1]
	315	if { "$status" == "pass" } {
	316	pass "$testname execution test"
	317	if { [info exists asan_last_gtest_expect_death_list] } {
	318	set gtest_expect_death_list $asan_last_gtest_expect_death_list
	319	foreach gtest_death $gtest_expect_death_list {
	320	set id [lindex $gtest_death 0]
	321	set testname "$testcase $gtest [lindex $gtest_death 1]"
	322	set regexpr [lindex $gtest_death 2]
	323	set status -1
	324
	325	setenv DEJAGNU_GTEST_ARG "$gtest:$id"
	326	set result [${tool}_load ./$output_file "$gtest:$id"]
	327	unsetenv DEJAGNU_GTEST_ARG
	328	set status [lindex $result 0]
	329	set output [lindex $result 1]
	330	if { "$status" == "fail" } {
	331	pass "$testname execution test"
	332	if { ![regexp $regexpr ${output}] } {
0f70486e RS	333	fail "$testname output pattern test"
0f70486e RS	334	send_log "Output should match: $regexpr\n"
5c31da80	335	} else {
0f70486e	336	pass "$testname output pattern test"
5c31da80 JJ	337	}
	338	} elseif { "$status" == "pass" } {
	339	fail "$testname execution test"
	340	} else {
	341	$status "$testname execution test"
	342	}
	343	}
	344	}
	345	} else {
	346	$status "$testname execution test"
	347	}
	348	unset asan_last_gtest_expect_death_list
	349	}
	350
	351	return
	352	}