gcc/testsuite/lib/gcov.exp

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