gcc/testsuite/lib/gcov.exp

   1 #   Copyright (C) 1997-2016 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 #
  75 # verify-intermediate -- check that intermediate file has certain lines
  76 #
  77 # TESTNAME is the name of the test, including unique flags.
  78 # TESTCASE is the name of the test.
  79 # FILE is the name of the gcov output file.
  80 #
  81 # Checks are very loose, they are based on certain tags being present
  82 # in the output. They do not check for exact expected execution
  83 # counts. For that the regular gcov format should be checked.
  84 #
  85 proc verify-intermediate { testname testcase file } {
  86     set failed 0
  87     set srcfile 0
  88     set function 0
  89     set lcount 0
  90     set branch 0
  91     set fd [open $file r]
  92     while { [gets $fd line] >= 0 } {
  93         if [regexp "^file:" $line] {
  94             incr srcfile
  95         }
  96         if [regexp "^function:(\[0-9\]+),(\[0-9\]+),.*" $line] {
  97             incr function
  98         }
  99         if [regexp "^lcount:(\[0-9\]+),(\[0-9\]+)" $line] {
 100             incr lcount
 101         }
 102         if [regexp "^branch:(\[0-9\]+),(taken|nottaken|notexec)" $line] {
 103             incr branch
 104         }
 105     }
 106
 107     # We should see at least one tag of each type
 108     if {$srcfile == 0} {
 109         fail "$testname expected 'file:' tag not found"
 110         incr failed
 111     }
 112     if {$function == 0} {
 113         fail "$testname expected 'function:' tag not found"
 114         incr failed
 115     }
 116     if {$lcount == 0} {
 117         fail "$testname expected 'lcount:' tag not found"
 118         incr failed
 119     }
 120     if {$branch == 0} {
 121         fail "$testname expected 'branch:' tag not found"
 122         incr failed
 123     }
 124     return $failed
 125 }
 126
 127
 128 #
 129 # verify-branches -- check that branch percentages are as expected
 130 #
 131 # TESTNAME is the name of the test, including unique flags.
 132 # TESTCASE is the name of the test file.
 133 # FILE is the name of the gcov output file.
 134 #
 135 # Checks are based on comments in the source file.  This means to look for
 136 # branch percentages 10 or 90, 20 or 80, and # 70 or 30:
 137 #     /* branch(10, 20, 70) */
 138 # This means that all specified percentages should have been seen by now:
 139 #     /* branch(end) */
 140 # All specified percentages must also be seen by the next branch(n) or
 141 # by the end of the file.
 142 #
 143 # Each check depends on the compiler having generated the expected
 144 # branch instructions.  Don't check for branches that might be
 145 # optimized away or replaced with predicated instructions.
 146 #
 147 proc verify-branches { testname testcase file } {
 148     #send_user "verify-branches\n"
 149
 150     set failed 0
 151     set shouldbe ""
 152     set fd [open $file r]
 153     set n 0
 154     while { [gets $fd line] >= 0 } {
 155         regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
 156         if [regexp "branch" $line] {
 157             verbose "Processing branch line $n: $line" 3
 158             if [regexp "branch\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
 159                 # All percentages in the current list should have been seen.
 160                 if {[llength $shouldbe] != 0} {
 161                     fail "$testname line $n: expected branch percentages not found: $shouldbe"
 162                     incr failed
 163                     set shouldbe ""
 164                 }
 165                 set shouldbe $new_shouldbe
 166                 #send_user "$n: looking for: $shouldbe\n"
 167                 # Record the percentages to check for. Replace percentage
 168                 # n > 50 with 100-n, since block ordering affects the
 169                 # direction of a branch.
 170                 for {set i 0} {$i < [llength $shouldbe]} {incr i} {
 171                     set num [lindex $shouldbe $i]
 172                     if {$num > 50} {
 173                         set shouldbe [lreplace $shouldbe $i $i [expr 100 - $num]]
 174                     }
 175                 }
 176             } elseif [regexp "branch +\[0-9\]+ taken (-\[0-9\]+)%" "$line" \
 177                         all taken] {
 178                 # Percentages should never be negative.
 179                 fail "$testname line $n: negative percentage: $taken"
 180                 incr failed
 181             } elseif [regexp "branch +\[0-9\]+ taken (\[0-9\]+)%" "$line" \
 182                         all taken] {
 183                 #send_user "$n: taken = $taken\n"
 184                 # Percentages should never be greater than 100.
 185                 if {$taken > 100} {
 186                     fail "$testname line $n: branch percentage greater than 100: $taken"
 187                     incr failed
 188                 }
 189                 if {$taken > 50} {
 190                     set taken [expr 100 - $taken]
 191                 }
 192                 # If this percentage is one to check for then remove it
 193                 # from the list.  It's normal to ignore some reports.
 194                 set i [lsearch $shouldbe $taken]
 195                 if {$i != -1} {
 196                     set shouldbe [lreplace $shouldbe $i $i]
 197                 }
 198             } elseif [regexp "branch\\(end\\)" "$line"] {
 199                 # All percentages in the list should have been seen by now.
 200                 if {[llength $shouldbe] != 0} {
 201                     fail "$testname line n: expected branch percentages not found: $shouldbe"
 202                     incr failed
 203                 }
 204                 set shouldbe ""
 205             }
 206         }
 207     }
 208     # All percentages in the list should have been seen.
 209     if {[llength $shouldbe] != 0} {
 210         fail "$testname line $n: expected branch percentages not found: $shouldbe"
 211         incr failed
 212     }
 213     close $fd
 214     return $failed
 215 }
 216
 217 #
 218 # verify-calls -- check that call return percentages are as expected
 219 #
 220 # TESTNAME is the name of the test, including unique flags.
 221 # TESTCASE is the name of the test file.
 222 # FILE is the name of the gcov output file.
 223 #
 224 # Checks are based on comments in the source file.  This means to look for
 225 # call return percentages 50, 20, 33:
 226 #     /* returns(50, 20, 33) */
 227 # This means that all specified percentages should have been seen by now:
 228 #     /* returns(end) */
 229 # All specified percentages must also be seen by the next returns(n) or
 230 # by the end of the file.
 231 #
 232 # Each check depends on the compiler having generated the expected
 233 # call instructions.  Don't check for calls that are inserted by the
 234 # compiler or that might be inlined.
 235 #
 236 proc verify-calls { testname testcase file } {
 237     #send_user "verify-calls\n"
 238
 239     set failed 0
 240     set shouldbe ""
 241     set fd [open $file r]
 242     set n 0
 243     while { [gets $fd line] >= 0 } {
 244         regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
 245         if [regexp "return" $line] {
 246             verbose "Processing returns line $n: $line" 3
 247             if [regexp "returns\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
 248                 # All percentages in the current list should have been seen.
 249                 if {[llength $shouldbe] != 0} {
 250                     fail "$testname line $n: expected return percentages not found: $shouldbe"
 251                     incr failed
 252                     set shouldbe ""
 253                 }
 254                 # Record the percentages to check for.
 255                 set shouldbe $new_shouldbe
 256             } elseif [regexp "call +\[0-9\]+ returned (-\[0-9\]+)%" "$line" \
 257                         all returns] {
 258                 # Percentages should never be negative.
 259                 fail "$testname line $n: negative percentage: $returns"
 260                 incr failed
 261             } elseif [regexp "call +\[0-9\]+ returned (\[0-9\]+)%" "$line" \
 262                         all returns] {
 263                 # For branches we check that percentages are not greater than
 264                 # 100 but call return percentages can be, as for setjmp(), so
 265                 # don't count that as an error.
 266                 #
 267                 # If this percentage is one to check for then remove it
 268                 # from the list.  It's normal to ignore some reports.
 269                 set i [lsearch $shouldbe $returns]
 270                 if {$i != -1} {
 271                     set shouldbe [lreplace $shouldbe $i $i]
 272                 }
 273             } elseif [regexp "returns\\(end\\)" "$line"] {
 274                 # All percentages in the list should have been seen by now.
 275                 if {[llength $shouldbe] != 0} {
 276                     fail "$testname line $n: expected return percentages not found: $shouldbe"
 277                     incr failed
 278                 }
 279                 set shouldbe ""
 280             }
 281         }
 282     }
 283     # All percentages in the list should have been seen.
 284     if {[llength $shouldbe] != 0} {
 285         fail "$testname line $n: expected return percentages not found: $shouldbe"
 286         incr failed
 287     }
 288     close $fd
 289     return $failed
 290 }
 291
 292 # Called by dg-final to run gcov and analyze the results.
 293 #
 294 # ARGS consists of the optional strings "branches" and/or "calls",
 295 # (indicating that these things should be verified) followed by a
 296 # list of arguments to provide to gcov, including the name of the
 297 # source file.
 298
 299 proc run-gcov { args } {
 300     global GCOV
 301     global srcdir subdir
 302
 303     set gcov_args ""
 304     set gcov_verify_calls 0
 305     set gcov_verify_branches 0
 306     set gcov_verify_lines 1
 307     set gcov_verify_intermediate 0
 308     set xfailed 0
 309
 310     foreach a $args {
 311         if { $a == "calls" } {
 312           set gcov_verify_calls 1
 313         } elseif { $a == "branches" } {
 314           set gcov_verify_branches 1
 315         } elseif { $a == "intermediate" } {
 316           set gcov_verify_intermediate 1
 317           set gcov_verify_calls 0
 318           set gcov_verify_branches 0
 319           set gcov_verify_lines 0
 320         } elseif { $gcov_args == "" } {
 321             set gcov_args $a
 322         } else {
 323             switch [dg-process-target $a] {
 324                 "N" { return }
 325                 "F" { set xfailed 1 }
 326             }
 327         }
 328     }
 329
 330     set testname [testname-for-summary]
 331
 332     # Extract the test file name from the arguments.
 333     set testcase [lindex $gcov_args end]
 334
 335     verbose "Running $GCOV $testcase" 2
 336     set testcase [remote_download host $testcase]
 337     set result [remote_exec host $GCOV $gcov_args]
 338     if { [lindex $result 0] != 0 } {
 339         if { $xfailed } {
 340             setup_xfail "*-*-*"
 341         }
 342         fail "$testname gcov failed: [lindex $result 1]"
 343         clean-gcov $testcase
 344         return
 345     }
 346
 347     # Get the gcov output file after making sure it exists.
 348     set files [glob -nocomplain $testcase.gcov]
 349     if { $files == "" } {
 350         if { $xfailed } {
 351             setup_xfail "*-*-*"
 352         }
 353         fail "$testname gcov failed: $testcase.gov does not exist"
 354         clean-gcov $testcase
 355         return
 356     }
 357     remote_upload host $testcase.gcov $testcase.gcov
 358
 359     # Check that line execution counts are as expected.
 360     if { $gcov_verify_lines } {
 361         # Check that line execution counts are as expected.
 362         set lfailed [verify-lines $testname $testcase $testcase.gcov]
 363     } else {
 364         set lfailed 0
 365     }
 366
 367     # If requested via the .x file, check that branch and call information
 368     # is correct.
 369     if { $gcov_verify_branches } {
 370         set bfailed [verify-branches $testname $testcase $testcase.gcov]
 371     } else {
 372         set bfailed 0
 373     }
 374     if { $gcov_verify_calls } {
 375         set cfailed [verify-calls $testname $testcase $testcase.gcov]
 376     } else {
 377         set cfailed 0
 378     }
 379     if { $gcov_verify_intermediate } {
 380         # Check that intermediate format has the expected format
 381         set ifailed [verify-intermediate $testname $testcase $testcase.gcov]
 382     } else {
 383         set ifailed 0
 384     }
 385
 386     # Report whether the gcov test passed or failed.  If there were
 387     # multiple failures then the message is a summary.
 388     set tfailed [expr $lfailed + $bfailed + $cfailed + $ifailed]
 389     if { $xfailed } {
 390         setup_xfail "*-*-*"
 391     }
 392     if { $tfailed > 0 } {
 393         fail "$testname gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages, $ifailed in intermediate format"
 394         if { $xfailed } {
 395             clean-gcov $testcase
 396         }
 397     } else {
 398         pass "$testname gcov"
 399         clean-gcov $testcase
 400     }
 401 }