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