gcc/testsuite/lib/asan-dg.exp

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