gcc/testsuite/lib/asan-dg.exp

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