gcc/testsuite/lib/gcov.exp

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