gcc/testsuite/lib/asan-dg.exp

   1 # Copyright (C) 2012-2019 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 proc 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
  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
  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
  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
 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
 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
 138 proc 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
 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] } {
 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
 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
 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
 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
 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}] } {
 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 }