gcc/testsuite/lib/gcov.exp

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