gcc/testsuite/lib/gcov.exp

   1 #   Copyright (C) 1997-2013 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 # Verify various kinds of gcov output: line counts, branch percentages,
  18 # and call return percentages.  None of this is language-specific.
  19
  20 global GCOV
  21
  22 #
  23 # clean-gcov -- delete the working files the compiler creates for gcov
  24 #
  25 # TESTCASE is the name of the test.
  26 #
  27 proc clean-gcov { testcase } {
  28     set basename [file tail $testcase]
  29     set base [file rootname $basename]
  30     remote_file host delete $base.gcno $base.gcda \
  31         $basename.gcov $base.h.gcov
  32 }
  33
  34 #
  35 # verify-lines -- check that line counts are as expected
  36 #
  37 # TESTNAME is the name of the test, including unique flags.
  38 # TESTCASE is the name of the test file.
  39 # FILE is the name of the gcov output file.
  40 #
  41 proc verify-lines { testname testcase file } {
  42     #send_user "verify-lines\n"
  43     global subdir
  44
  45     set failed 0
  46     set fd [open $file r]
  47     while { [gets $fd line] >= 0 } {
  48         # We want to match both "-" and "#####" as count as well as numbers,
  49         # since we want to detect lines that shouldn't be marked as covered.
  50         if [regexp "^ *(\[^:]*): *(\[0-9\\-#]+):.*count\\((\[0-9\\-#=]+)\\)(.*)" \
  51                 "$line" all is n shouldbe rest] {
  52             if [regexp "^ *{(.*)}" $rest all xfailed] {
  53                 switch [dg-process-target $xfailed] {
  54                     "N" { continue }
  55                     "F" { setup_xfail "*-*-*" }
  56                 }
  57             }
  58             if { $is == "" } {
  59                 fail "$testname line $n: no data available"
  60                 incr failed
  61             } elseif { $is != $shouldbe } {
  62                 fail "$testname line $n: is $is:should be $shouldbe"
  63                 incr failed
  64             } else {
  65                 pass "$testname count for line $n"
  66             }
  67         }
  68     }
  69     close $fd
  70     return $failed
  71 }
  72
  73 #
  74 # verify-branches -- check that branch percentages are as expected
  75 #
  76 # TESTNAME is the name of the test, including unique flags.
  77 # TESTCASE is the name of the test file.
  78 # FILE is the name of the gcov output file.
  79 #
  80 # Checks are based on comments in the source file.  This means to look for
  81 # branch percentages 10 or 90, 20 or 80, and # 70 or 30:
  82 #     /* branch(10, 20, 70) */
  83 # This means that all specified percentages should have been seen by now:
  84 #     /* branch(end) */
  85 # All specified percentages must also be seen by the next branch(n) or
  86 # by the end of the file.
  87 #
  88 # Each check depends on the compiler having generated the expected
  89 # branch instructions.  Don't check for branches that might be
  90 # optimized away or replaced with predicated instructions.
  91 #
  92 proc verify-branches { testname testcase file } {
  93     #send_user "verify-branches\n"
  94
  95     set failed 0
  96     set shouldbe ""
  97     set fd [open $file r]
  98     set n 0
  99     while { [gets $fd line] >= 0 } {
 100         regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
 101         if [regexp "branch" $line] {
 102             verbose "Processing branch line $n: $line" 3
 103             if [regexp "branch\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
 104                 # All percentages in the current list should have been seen.
 105                 if {[llength $shouldbe] != 0} {
 106                     fail "$testname line $n: expected branch percentages not found: $shouldbe"
 107                     incr failed
 108                     set shouldbe ""
 109                 }
 110                 set shouldbe $new_shouldbe
 111                 #send_user "$n: looking for: $shouldbe\n"
 112                 # Record the percentages to check for. Replace percentage
 113                 # n > 50 with 100-n, since block ordering affects the
 114                 # direction of a branch.
 115                 for {set i 0} {$i < [llength $shouldbe]} {incr i} {
 116                     set num [lindex $shouldbe $i]
 117                     if {$num > 50} {
 118                         set shouldbe [lreplace $shouldbe $i $i [expr 100 - $num]]
 119                     }
 120                 }
 121             } elseif [regexp "branch +\[0-9\]+ taken (-\[0-9\]+)%" "$line" \
 122                         all taken] {
 123                 # Percentages should never be negative.
 124                 fail "$testname line $n: negative percentage: $taken"
 125                 incr failed
 126             } elseif [regexp "branch +\[0-9\]+ taken (\[0-9\]+)%" "$line" \
 127                         all taken] {
 128                 #send_user "$n: taken = $taken\n"
 129                 # Percentages should never be greater than 100.
 130                 if {$taken > 100} {
 131                     fail "$testname line $n: branch percentage greater than 100: $taken"
 132                     incr failed
 133                 }
 134                 if {$taken > 50} {
 135                     set taken [expr 100 - $taken]
 136                 }
 137                 # If this percentage is one to check for then remove it
 138                 # from the list.  It's normal to ignore some reports.
 139                 set i [lsearch $shouldbe $taken]
 140                 if {$i != -1} {
 141                     set shouldbe [lreplace $shouldbe $i $i]
 142                 }
 143             } elseif [regexp "branch\\(end\\)" "$line"] {
 144                 # All percentages in the list should have been seen by now.
 145                 if {[llength $shouldbe] != 0} {
 146                     fail "$testname line n: expected branch percentages not found: $shouldbe"
 147                     incr failed
 148                 }
 149                 set shouldbe ""
 150             }
 151         }
 152     }
 153     # All percentages in the list should have been seen.
 154     if {[llength $shouldbe] != 0} {
 155         fail "$testname line $n: expected branch percentages not found: $shouldbe"
 156         incr failed
 157     }
 158     close $fd
 159     return $failed
 160 }
 161
 162 #
 163 # verify-calls -- check that call return percentages are as expected
 164 #
 165 # TESTNAME is the name of the test, including unique flags.
 166 # TESTCASE is the name of the test file.
 167 # FILE is the name of the gcov output file.
 168 #
 169 # Checks are based on comments in the source file.  This means to look for
 170 # call return percentages 50, 20, 33:
 171 #     /* returns(50, 20, 33) */
 172 # This means that all specified percentages should have been seen by now:
 173 #     /* returns(end) */
 174 # All specified percentages must also be seen by the next returns(n) or
 175 # by the end of the file.
 176 #
 177 # Each check depends on the compiler having generated the expected
 178 # call instructions.  Don't check for calls that are inserted by the
 179 # compiler or that might be inlined.
 180 #
 181 proc verify-calls { testname testcase file } {
 182     #send_user "verify-calls\n"
 183
 184     set failed 0
 185     set shouldbe ""
 186     set fd [open $file r]
 187     set n 0
 188     while { [gets $fd line] >= 0 } {
 189         regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
 190         if [regexp "return" $line] {
 191             verbose "Processing returns line $n: $line" 3
 192             if [regexp "returns\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
 193                 # All percentages in the current list should have been seen.
 194                 if {[llength $shouldbe] != 0} {
 195                     fail "$testname line $n: expected return percentages not found: $shouldbe"
 196                     incr failed
 197                     set shouldbe ""
 198                 }
 199                 # Record the percentages to check for.
 200                 set shouldbe $new_shouldbe
 201             } elseif [regexp "call +\[0-9\]+ returned (-\[0-9\]+)%" "$line" \
 202                         all returns] {
 203                 # Percentages should never be negative.
 204                 fail "$testname line $n: negative percentage: $returns"
 205                 incr failed
 206             } elseif [regexp "call +\[0-9\]+ returned (\[0-9\]+)%" "$line" \
 207                         all returns] {
 208                 # For branches we check that percentages are not greater than
 209                 # 100 but call return percentages can be, as for setjmp(), so
 210                 # don't count that as an error.
 211                 #
 212                 # If this percentage is one to check for then remove it
 213                 # from the list.  It's normal to ignore some reports.
 214                 set i [lsearch $shouldbe $returns]
 215                 if {$i != -1} {
 216                     set shouldbe [lreplace $shouldbe $i $i]
 217                 }
 218             } elseif [regexp "returns\\(end\\)" "$line"] {
 219                 # All percentages in the list should have been seen by now.
 220                 if {[llength $shouldbe] != 0} {
 221                     fail "$testname line $n: expected return percentages not found: $shouldbe"
 222                     incr failed
 223                 }
 224                 set shouldbe ""
 225             }
 226         }
 227     }
 228     # All percentages in the list should have been seen.
 229     if {[llength $shouldbe] != 0} {
 230         fail "$testname line $n: expected return percentages not found: $shouldbe"
 231         incr failed
 232     }
 233     close $fd
 234     return $failed
 235 }
 236
 237 # Called by dg-final to run gcov and analyze the results.
 238 #
 239 # ARGS consists of the optional strings "branches" and/or "calls",
 240 # (indicating that these things should be verified) followed by a
 241 # list of arguments to provide to gcov, including the name of the
 242 # source file.
 243
 244 proc run-gcov { args } {
 245     global GCOV
 246     global srcdir subdir
 247
 248     set gcov_args ""
 249     set gcov_verify_calls 0
 250     set gcov_verify_branches 0
 251     set xfailed 0
 252
 253     foreach a $args {
 254         if { $a == "calls" } {
 255           set gcov_verify_calls 1
 256         } elseif { $a == "branches" } {
 257           set gcov_verify_branches 1
 258         } elseif { $gcov_args == "" } {
 259             set gcov_args $a
 260         } else {
 261             switch [dg-process-target $a] {
 262                 "N" { return }
 263                 "F" { set xfailed 1 }
 264             }
 265         }
 266     }
 267
 268     set testname [testname-for-summary]
 269
 270     # Extract the test file name from the arguments.
 271     set testcase [lindex $gcov_args end]
 272
 273     verbose "Running $GCOV $testcase" 2
 274     set testcase [remote_download host $testcase]
 275     set result [remote_exec host $GCOV $gcov_args]
 276     if { [lindex $result 0] != 0 } {
 277         if { $xfailed } {
 278             setup_xfail "*-*-*"
 279         }
 280         fail "$testname gcov failed: [lindex $result 1]"
 281         clean-gcov $testcase
 282         return
 283     }
 284
 285     # Get the gcov output file after making sure it exists.
 286     set files [glob -nocomplain $testcase.gcov]
 287     if { $files == "" } {
 288         if { $xfailed } {
 289             setup_xfail "*-*-*"
 290         }
 291         fail "$testname gcov failed: $testcase.gov does not exist"
 292         clean-gcov $testcase
 293         return
 294     }
 295     remote_upload host $testcase.gcov $testcase.gcov
 296
 297     # Check that line execution counts are as expected.
 298     set lfailed [verify-lines $testname $testcase $testcase.gcov]
 299
 300     # If requested via the .x file, check that branch and call information
 301     # is correct.
 302     if { $gcov_verify_branches } {
 303         set bfailed [verify-branches $testname $testcase $testcase.gcov]
 304     } else {
 305         set bfailed 0
 306     }
 307     if { $gcov_verify_calls } {
 308         set cfailed [verify-calls $testname $testcase $testcase.gcov]
 309     } else {
 310         set cfailed 0
 311     }
 312
 313     # Report whether the gcov test passed or failed.  If there were
 314     # multiple failures then the message is a summary.
 315     set tfailed [expr $lfailed + $bfailed + $cfailed]
 316     if { $xfailed } {
 317         setup_xfail "*-*-*"
 318     }
 319     if { $tfailed > 0 } {
 320         fail "$testname gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages"
 321     } else {
 322         pass "$testname gcov"
 323         clean-gcov $testcase
 324     }
 325 }