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