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