1# Copyright (C) 2012-2020 Free Software Foundation, Inc.
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
17# Return 1 if compilation with -fsanitize=address is error-free for trivial
18# code, 0 otherwise.
19
20proc check_effective_target_fsanitize_address {} {
21    if ![check_no_compiler_messages fsanitize_address executable {
22	int main (void) { return 0; }
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;
39}
40
41proc 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
56#
57# asan_link_flags -- compute library path and flags to find libasan.
58# (originally from g++.exp)
59#
60
61proc asan_link_flags { paths } {
62    global srcdir
63    global ld_library_path
64    global shlib_ext
65    global asan_saved_library_path
66
67    set gccpath ${paths}
68    set flags ""
69
70    set shlib_ext [get_shlib_extension]
71    set asan_saved_library_path $ld_library_path
72
73    if { $gccpath != "" } {
74      if { [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.a"]
75	   || [file exists "${gccpath}/libsanitizer/asan/.libs/libasan.${shlib_ext}"] } {
76	  append flags " -B${gccpath}/libsanitizer/ "
77	  append flags " -B${gccpath}/libsanitizer/asan/ "
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
100proc asan_init { args } {
101    global TEST_ALWAYS_FLAGS
102    global ALWAYS_CXXFLAGS
103    global TOOL_OPTIONS
104    global asan_saved_TEST_ALWAYS_FLAGS
105    global asan_saved_ALWAYS_CXXFLAGS
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
116    set include_flags "[asan_include_flags]"
117
118    if [info exists TEST_ALWAYS_FLAGS] {
119	set asan_saved_TEST_ALWAYS_FLAGS $TEST_ALWAYS_FLAGS
120    }
121    if [info exists ALWAYS_CXXFLAGS] {
122	set asan_saved_ALWAYS_CXXFLAGS $ALWAYS_CXXFLAGS
123	set ALWAYS_CXXFLAGS [concat "{ldflags=$link_flags}" $ALWAYS_CXXFLAGS]
124	set ALWAYS_CXXFLAGS [concat "{additional_flags=-fsanitize=address -g $include_flags}" $ALWAYS_CXXFLAGS]
125    } else {
126	if [info exists TEST_ALWAYS_FLAGS] {
127	    set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags $TEST_ALWAYS_FLAGS"
128	} else {
129	    set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags"
130	}
131    }
132}
133
134#
135# asan_finish -- called at the start of each subdir of tests
136#
137
138proc asan_finish { args } {
139    global TEST_ALWAYS_FLAGS
140    global asan_saved_TEST_ALWAYS_FLAGS
141    global asan_saved_ALWAYS_CXXFLAGS
142    global asan_saved_library_path
143    global ld_library_path
144
145    if [info exists asan_saved_ALWAYS_CXXFLAGS ] {
146	set ALWAYS_CXXFLAGS $asan_saved_ALWAYS_CXXFLAGS
147    } else {
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	}
153    }
154    set ld_library_path $asan_saved_library_path
155    set_ld_library_path_env_vars
156    clear_effective_target_cache
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
163proc 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] } {
169	    set key [regsub -all "\[\]\[\]" [lindex $addresses $idx] "\\\\&"]
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)"
176	    set status [remote_exec host "$addr2line_name" "$args"]
177	    if { [lindex $status 0] > 0 } continue
178	    regsub -all "\r\n" [lindex $status 1] "\n" addr2line_output
179	    regsub -all "\[\n\r\]BFD: \[^\n\r\]*" $addr2line_output "" addr2line_output
180	    regsub -all "^BFD: \[^\n\r\]*\[\n\r\]" $addr2line_output "" addr2line_output
181	    set addr2line_output [regexp -inline -all -line "^\[^\n\r]*" $addr2line_output]
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		    }
191		    set idx [expr $idx + 2]
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
215# Return a list of gtest tests, printed in the form
216# DEJAGNU_GTEST_TEST AddressSanitizer_SimpleDeathTest
217# DEJAGNU_GTEST_TEST AddressSanitizer_VariousMallocsTest
218proc 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
234proc 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
254# Replace ${tool}_load with a wrapper so that we can symbolize the output.
255if { [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
261	global asan_last_gtest_test_list
262	global asan_last_gtest_expect_death_list
263	set result [eval [list saved_asan_${tool}_load $program] $args]
264	set output [lindex $result 1]
265	set symbolized_output [asan_symbolize "$output"]
266	set asan_last_gtest_test_list [asan_get_gtest_test_list "$output"]
267	set asan_last_gtest_expect_death_list [asan_get_gtest_expect_death_list "$output"]
268	set result [list [lindex $result 0] $symbolized_output]
269	return $result
270    }
271}
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
277proc 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}] } {
333			    fail "$testname output pattern test"
334			    send_log "Output should match: $regexpr\n"
335			} else {
336			    pass "$testname output pattern test"
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}
353