gcc/testsuite/lib/asan-dg.exp

   1 # Copyright (C) 2012-2024 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
  23 proc 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
  44 proc 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
  64 proc 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 " -B${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
  99 proc 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
 107 proc 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     setenv ASAN_OPTIONS "color=never"
 115
 116     set link_flags ""
 117     if ![is_remote host] {
 118         if [info exists TOOL_OPTIONS] {
 119             set link_flags "[asan_link_flags [get_multilibs ${TOOL_OPTIONS}]]"
 120         } else {
 121             set link_flags "[asan_link_flags [get_multilibs]]"
 122         }
 123     }
 124
 125     set include_flags "[asan_include_flags]"
 126
 127     if [info exists TEST_ALWAYS_FLAGS] {
 128         set asan_saved_TEST_ALWAYS_FLAGS $TEST_ALWAYS_FLAGS
 129     }
 130     if [info exists ALWAYS_CXXFLAGS] {
 131         set asan_saved_ALWAYS_CXXFLAGS $ALWAYS_CXXFLAGS
 132         set ALWAYS_CXXFLAGS [concat "{ldflags=$link_flags}" $ALWAYS_CXXFLAGS]
 133         set ALWAYS_CXXFLAGS [concat "{additional_flags=-fsanitize=address -g $include_flags}" $ALWAYS_CXXFLAGS]
 134     } else {
 135         if [info exists TEST_ALWAYS_FLAGS] {
 136             set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags $TEST_ALWAYS_FLAGS"
 137         } else {
 138             set TEST_ALWAYS_FLAGS "$link_flags -fsanitize=address -g $include_flags"
 139         }
 140     }
 141 }
 142
 143 #
 144 # asan_finish -- called at the start of each subdir of tests
 145 #
 146
 147 proc asan_finish { args } {
 148     global TEST_ALWAYS_FLAGS
 149     global asan_saved_TEST_ALWAYS_FLAGS
 150     global asan_saved_ALWAYS_CXXFLAGS
 151     global asan_saved_library_path
 152     global ld_library_path
 153
 154     if [info exists asan_saved_ALWAYS_CXXFLAGS ] {
 155         set ALWAYS_CXXFLAGS $asan_saved_ALWAYS_CXXFLAGS
 156     } else {
 157         if [info exists asan_saved_TEST_ALWAYS_FLAGS] {
 158             set TEST_ALWAYS_FLAGS $asan_saved_TEST_ALWAYS_FLAGS
 159         } else {
 160             unset TEST_ALWAYS_FLAGS
 161         }
 162     }
 163     if [info exists asan_saved_library_path ] {
 164         set ld_library_path $asan_saved_library_path
 165         set_ld_library_path_env_vars
 166     }
 167     clear_effective_target_cache
 168 }
 169
 170 # Symbolize lines like
 171 #   #2 0xdeadbeef (/some/path/libsanitizer.so.0.0.0+0xbeef)
 172 # in $output using addr2line to
 173 #   #2 0xdeadbeef in foobar file:123
 174 proc asan_symbolize { output } {
 175     set addresses [regexp -inline -all -line "^ *#\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+)\[+\](0x\[0-9a-f\]+)\[)\]$" "$output"]
 176     if { [llength $addresses] > 0 } {
 177         set addr2line_name [find_binutils_prog addr2line]
 178         set idx 1
 179         while { $idx < [llength $addresses] } {
 180             set key [regsub -all "\[\]\[\]" [lindex $addresses $idx] "\\\\&"]
 181             set val [lindex $addresses [expr $idx + 1]]
 182             lappend arr($key) $val
 183             set idx [expr $idx + 3]
 184         }
 185         foreach key [array names arr] {
 186             set args "-f -e $key $arr($key)"
 187             set status [remote_exec host "$addr2line_name" "$args"]
 188             if { [lindex $status 0] > 0 } continue
 189             regsub -all "\r\n" [lindex $status 1] "\n" addr2line_output
 190             regsub -all "\[\n\r\]BFD: \[^\n\r\]*" $addr2line_output "" addr2line_output
 191             regsub -all "^BFD: \[^\n\r\]*\[\n\r\]" $addr2line_output "" addr2line_output
 192             set addr2line_output [regexp -inline -all -line "^\[^\n\r]*" $addr2line_output]
 193             set idx 0
 194             foreach val $arr($key) {
 195                 if { [expr $idx + 1] < [llength $addr2line_output] } {
 196                     set fnname [lindex $addr2line_output $idx]
 197                     set fileline [lindex $addr2line_output [expr $idx + 1]]
 198                     if { "$fnname" != "??" } {
 199                         set newkey "$key+$val"
 200                         set repl($newkey) "$fnname $fileline"
 201                     }
 202                     set idx [expr $idx + 2]
 203                 }
 204             }
 205         }
 206         set idx 0
 207         set new_output ""
 208         while {[regexp -start $idx -indices " #\[0-9\]+ 0x\[0-9a-f\]+ \[(\](\[^)\]+\[+\]0x\[0-9a-f\]+)\[)\]" "$output" -> addr] > 0} {
 209             set low [lindex $addr 0]
 210             set high [lindex $addr 1]
 211             set val [string range "$output" $low $high]
 212             append new_output [string range "$output" $idx [expr $low - 2]]
 213             if [info exists repl($val)] {
 214                 append new_output "in $repl($val)"
 215             } else {
 216                 append new_output "($val)"
 217             }
 218             set idx [expr $high + 2]
 219         }
 220         append new_output [string range "$output" $idx [string length "$output"]]
 221         return "$new_output"
 222     }
 223     return "$output"
 224 }
 225
 226 # Return a list of gtest tests, printed in the form
 227 # DEJAGNU_GTEST_TEST AddressSanitizer_SimpleDeathTest
 228 # DEJAGNU_GTEST_TEST AddressSanitizer_VariousMallocsTest
 229 proc asan_get_gtest_test_list { output } {
 230     set idx 0
 231     set ret ""
 232     while {[regexp -start $idx -indices "DEJAGNU_GTEST_TEST (\[^\n\r\]*)(\r\n|\n|\r)" "$output" -> testname] > 0} {
 233         set low [lindex $testname 0]
 234         set high [lindex $testname 1]
 235         set val [string range "$output" $low $high]
 236         lappend ret $val
 237         set idx [expr $high + 1]
 238     }
 239     return $ret
 240 }
 241
 242 # Return a list of gtest EXPECT_DEATH tests, printed in the form
 243 # DEJAGNU_GTEST_EXPECT_DEATH1 statement DEJAGNU_GTEST_EXPECT_DEATH1 regexp DEJAGNU_GTEST_EXPECT_DEATH1
 244 # DEJAGNU_GTEST_EXPECT_DEATH2 other statement DEJAGNU_GTEST_EXPECT_DEATH2 other regexp DEJAGNU_GTEST_EXPECT_DEATH2
 245 proc asan_get_gtest_expect_death_list { output } {
 246     set idx 0
 247     set ret ""
 248     while {[regexp -start $idx -indices "DEJAGNU_GTEST_EXPECT_DEATH(\[0-9\]*)" "$output" -> id ] > 0} {
 249         set low [lindex $id 0]
 250         set high [lindex $id 1]
 251         set val_id [string range "$output" $low $high]
 252         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 }
 253         set low [lindex $statement 0]
 254         set high [lindex $statement 1]
 255         set val_statement [string range "$output" $low $high]
 256         set low [lindex $regexpr 0]
 257         set high [lindex $regexpr 1]
 258         set val_regexpr [string range "$output" $low $high]
 259         lappend ret [list "$val_id" "$val_statement" "$val_regexpr"]
 260         set idx [lindex $whole 1]
 261     }
 262     return $ret
 263 }
 264
 265 # Replace ${tool}_load with a wrapper so that we can symbolize the output.
 266 if { [info procs ${tool}_load] != [list] \
 267       && [info procs saved_asan_${tool}_load] == [list] } {
 268     rename ${tool}_load saved_asan_${tool}_load
 269
 270     proc ${tool}_load { program args } {
 271         global tool
 272         global asan_last_gtest_test_list
 273         global asan_last_gtest_expect_death_list
 274         set result [eval [list saved_asan_${tool}_load $program] $args]
 275         set output [lindex $result 1]
 276         set symbolized_output [asan_symbolize "$output"]
 277         set asan_last_gtest_test_list [asan_get_gtest_test_list "$output"]
 278         set asan_last_gtest_expect_death_list [asan_get_gtest_expect_death_list "$output"]
 279         set result [list [lindex $result 0] $symbolized_output]
 280         return $result
 281     }
 282 }
 283
 284 # Utility for running gtest asan emulation under dejagnu, invoked via dg-final.
 285 # Call pass if variable has the desired value, otherwise fail.
 286 #
 287 # Argument 0 handles expected failures and the like
 288 proc asan-gtest { args } {
 289     global tool
 290     global asan_last_gtest_test_list
 291     global asan_last_gtest_expect_death_list
 292
 293     if { ![info exists asan_last_gtest_test_list] } { return }
 294     if { [llength $asan_last_gtest_test_list] == 0 } { return }
 295     if { ![isnative] || [is_remote target] } { return }
 296
 297     set gtest_test_list $asan_last_gtest_test_list
 298     unset asan_last_gtest_test_list
 299
 300     if { [llength $args] >= 1 } {
 301         switch [dg-process-target [lindex $args 0]] {
 302             "S" { }
 303             "N" { return }
 304             "F" { setup_xfail "*-*-*" }
 305             "P" { }
 306         }
 307     }
 308
 309     # This assumes that we are three frames down from dg-test, and that
 310     # it still stores the filename of the testcase in a local variable "name".
 311     # A cleaner solution would require a new DejaGnu release.
 312     upvar 2 name testcase
 313     upvar 2 prog prog
 314
 315     set output_file "[file rootname [file tail $prog]].exe"
 316
 317     foreach gtest $gtest_test_list {
 318         set testname "$testcase $gtest"
 319         set status -1
 320
 321         setenv DEJAGNU_GTEST_ARG "$gtest"
 322         set result [${tool}_load ./$output_file $gtest]
 323         unsetenv DEJAGNU_GTEST_ARG
 324         set status [lindex $result 0]
 325         set output [lindex $result 1]
 326         if { "$status" == "pass" } {
 327             pass "$testname execution test"
 328             if { [info exists asan_last_gtest_expect_death_list] } {
 329                 set gtest_expect_death_list $asan_last_gtest_expect_death_list
 330                 foreach gtest_death $gtest_expect_death_list {
 331                     set id [lindex $gtest_death 0]
 332                     set testname "$testcase $gtest [lindex $gtest_death 1]"
 333                     set regexpr [lindex $gtest_death 2]
 334                     set status -1
 335
 336                     setenv DEJAGNU_GTEST_ARG "$gtest:$id"
 337                     set result [${tool}_load ./$output_file "$gtest:$id"]
 338                     unsetenv DEJAGNU_GTEST_ARG
 339                     set status [lindex $result 0]
 340                     set output [lindex $result 1]
 341                     if { "$status" == "fail" } {
 342                         pass "$testname execution test"
 343                         if { ![regexp $regexpr ${output}] } {
 344                             fail "$testname output pattern test"
 345                             send_log "Output should match: $regexpr\n"
 346                         } else {
 347                             pass "$testname output pattern test"
 348                         }
 349                     } elseif { "$status" == "pass" } {
 350                         fail "$testname execution test"
 351                     } else {
 352                         $status "$testname execution test"
 353                     }
 354                 }
 355             }
 356         } else {
 357             $status "$testname execution test"
 358         }
 359         unset asan_last_gtest_expect_death_list
 360     }
 361
 362     return
 363 }