blob: 9d5b2cdb86bbecac463fb1f850a1049c80c0514e [file] [log] [blame]
# Copyright (C) 1997-2022 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# Verify various kinds of gcov output: line counts, branch percentages,
# and call return percentages. None of this is language-specific.
load_lib "target-supports.exp"
global GCOV
#
# clean-gcov-file -- delete a working file the compiler creates for gcov
#
# TESTCASE is the name of the test.
# SUFFIX is file suffix
proc clean-gcov-file { testcase suffix } {
set basename [file tail $testcase]
set base [file rootname $basename]
remote_file host delete $base.$suffix
}
#
# clean-gcov -- delete the working files the compiler creates for gcov
#
# TESTCASE is the name of the test.
#
proc clean-gcov { testcase } {
clean-gcov-file $testcase "gcno"
clean-gcov-file $testcase "gcda"
clean-gcov-file $testcase "h.gcov"
remote_file host delete "$testcase.gcov"
}
#
# verify-lines -- check that line counts are as expected
#
# TESTNAME is the name of the test, including unique flags.
# TESTCASE is the name of the test file.
# FILE is the name of the gcov output file.
#
proc verify-lines { testname testcase file } {
#send_user "verify-lines\n"
global subdir
set failed 0
set fd [open $file r]
while { [gets $fd line] >= 0 } {
# We want to match both "-" and "#####" as count as well as numbers,
# since we want to detect lines that shouldn't be marked as covered.
if [regexp "^ *(\[^:]*): *(\[0-9\\-#]+):.*count\\((\[0-9\\-#=\\.kMGTPEZY\*]+)\\)(.*)" \
"$line" all is n shouldbe rest] {
if [regexp "^ *{(.*)}" $rest all xfailed] {
switch [dg-process-target $xfailed] {
"N" { continue }
"F" { setup_xfail "*-*-*" }
}
}
if { $is == "" } {
fail "$testname line $n: no data available"
incr failed
} elseif { $is != $shouldbe } {
fail "$testname line $n: is $is:should be $shouldbe"
incr failed
} else {
pass "$testname count for line $n"
}
}
}
close $fd
return $failed
}
#
# verify-branches -- check that branch percentages are as expected
#
# TESTNAME is the name of the test, including unique flags.
# TESTCASE is the name of the test file.
# FILE is the name of the gcov output file.
#
# Checks are based on comments in the source file. This means to look for
# branch percentages 10 or 90, 20 or 80, and # 70 or 30:
# /* branch(10, 20, 70) */
# This means that all specified percentages should have been seen by now:
# /* branch(end) */
# All specified percentages must also be seen by the next branch(n) or
# by the end of the file.
#
# Each check depends on the compiler having generated the expected
# branch instructions. Don't check for branches that might be
# optimized away or replaced with predicated instructions.
#
proc verify-branches { testname testcase file } {
#send_user "verify-branches\n"
set failed 0
set shouldbe ""
set fd [open $file r]
set n 0
while { [gets $fd line] >= 0 } {
regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
if [regexp "branch" $line] {
verbose "Processing branch line $n: $line" 3
if [regexp "branch\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
# All percentages in the current list should have been seen.
if {[llength $shouldbe] != 0} {
fail "$testname line $n: expected branch percentages not found: $shouldbe"
incr failed
set shouldbe ""
}
set shouldbe $new_shouldbe
#send_user "$n: looking for: $shouldbe\n"
# Record the percentages to check for. Replace percentage
# n > 50 with 100-n, since block ordering affects the
# direction of a branch.
for {set i 0} {$i < [llength $shouldbe]} {incr i} {
set num [lindex $shouldbe $i]
if {$num > 50} {
set shouldbe [lreplace $shouldbe $i $i [expr 100 - $num]]
}
}
} elseif [regexp "branch +\[0-9\]+ taken (-\[0-9\]+)%" "$line" \
all taken] {
# Percentages should never be negative.
fail "$testname line $n: negative percentage: $taken"
incr failed
} elseif [regexp "branch +\[0-9\]+ taken (\[0-9\]+)%" "$line" \
all taken] {
#send_user "$n: taken = $taken\n"
# Percentages should never be greater than 100.
if {$taken > 100} {
fail "$testname line $n: branch percentage greater than 100: $taken"
incr failed
}
if {$taken > 50} {
set taken [expr 100 - $taken]
}
# If this percentage is one to check for then remove it
# from the list. It's normal to ignore some reports.
set i [lsearch $shouldbe $taken]
if {$i != -1} {
set shouldbe [lreplace $shouldbe $i $i]
}
} elseif [regexp "branch\\(end\\)" "$line"] {
# All percentages in the list should have been seen by now.
if {[llength $shouldbe] != 0} {
fail "$testname line n: expected branch percentages not found: $shouldbe"
incr failed
}
set shouldbe ""
}
}
}
# All percentages in the list should have been seen.
if {[llength $shouldbe] != 0} {
fail "$testname line $n: expected branch percentages not found: $shouldbe"
incr failed
}
close $fd
return $failed
}
#
# verify-calls -- check that call return percentages are as expected
#
# TESTNAME is the name of the test, including unique flags.
# TESTCASE is the name of the test file.
# FILE is the name of the gcov output file.
#
# Checks are based on comments in the source file. This means to look for
# call return percentages 50, 20, 33:
# /* returns(50, 20, 33) */
# This means that all specified percentages should have been seen by now:
# /* returns(end) */
# All specified percentages must also be seen by the next returns(n) or
# by the end of the file.
#
# Each check depends on the compiler having generated the expected
# call instructions. Don't check for calls that are inserted by the
# compiler or that might be inlined.
#
proc verify-calls { testname testcase file } {
#send_user "verify-calls\n"
set failed 0
set shouldbe ""
set fd [open $file r]
set n 0
while { [gets $fd line] >= 0 } {
regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n
if [regexp "return" $line] {
verbose "Processing returns line $n: $line" 3
if [regexp "returns\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] {
# All percentages in the current list should have been seen.
if {[llength $shouldbe] != 0} {
fail "$testname line $n: expected return percentages not found: $shouldbe"
incr failed
set shouldbe ""
}
# Record the percentages to check for.
set shouldbe $new_shouldbe
} elseif [regexp "call +\[0-9\]+ returned (-\[0-9\]+)%" "$line" \
all returns] {
# Percentages should never be negative.
fail "$testname line $n: negative percentage: $returns"
incr failed
} elseif [regexp "call +\[0-9\]+ returned (\[0-9\]+)%" "$line" \
all returns] {
# For branches we check that percentages are not greater than
# 100 but call return percentages can be, as for setjmp(), so
# don't count that as an error.
#
# If this percentage is one to check for then remove it
# from the list. It's normal to ignore some reports.
set i [lsearch $shouldbe $returns]
if {$i != -1} {
set shouldbe [lreplace $shouldbe $i $i]
}
} elseif [regexp "returns\\(end\\)" "$line"] {
# All percentages in the list should have been seen by now.
if {[llength $shouldbe] != 0} {
fail "$testname line $n: expected return percentages not found: $shouldbe"
incr failed
}
set shouldbe ""
}
}
}
# All percentages in the list should have been seen.
if {[llength $shouldbe] != 0} {
fail "$testname line $n: expected return percentages not found: $shouldbe"
incr failed
}
close $fd
return $failed
}
proc gcov-pytest-format-line { args } {
global subdir
set testcase [lindex $args 0]
set pytest_script [lindex $args 1]
set output_line [lindex $args 2]
set index [string first "::" $output_line]
set test_output [string range $output_line [expr $index + 2] [string length $output_line]]
return "$subdir/$testcase ${pytest_script}::${test_output}"
}
# Call by dg-final to run gcov --json-format which produces a JSON file
# that is later analysed by a pytest Python script.
# We pass filename of a test via GCOV_PATH environment variable.
proc run-gcov-pytest { args } {
global GCOV
global srcdir subdir
# Extract the test file name from the arguments.
set testcase [lindex $args 0]
verbose "Running $GCOV $testcase in $srcdir/$subdir" 2
set testcase [remote_download host $testcase]
set result [remote_exec host $GCOV "$testcase -i"]
set pytest_script [lindex $args 1]
if { ![check_effective_target_pytest3] } {
unsupported "$pytest_script pytest python3 is missing"
return
}
setenv GCOV_PATH $testcase
spawn -noecho python3 -m pytest --color=no -rap -s --tb=no $srcdir/$subdir/$pytest_script
set prefix "\[^\r\n\]*"
expect {
-re "FAILED($prefix)\[^\r\n\]+\r\n" {
set output [gcov-pytest-format-line $testcase $pytest_script $expect_out(1,string)]
fail $output
exp_continue
}
-re "ERROR($prefix)\[^\r\n\]+\r\n" {
set output [gcov-pytest-format-line $testcase $pytest_script $expect_out(1,string)]
fail $output
exp_continue
}
-re "PASSED($prefix)\[^\r\n\]+\r\n" {
set output [gcov-pytest-format-line $testcase $pytest_script $expect_out(1,string)]
pass $output
exp_continue
}
}
clean-gcov $testcase
}
# Called by dg-final to run gcov and analyze the results.
#
# ARGS consists of the optional strings "branches" and/or "calls",
# (indicating that these things should be verified) followed by a
# list of arguments to provide to gcov, including the name of the
# source file.
proc run-gcov { args } {
global GCOV
global srcdir subdir
set gcov_args ""
set gcov_verify_calls 0
set gcov_verify_branches 0
set gcov_verify_lines 1
set gcov_verify_intermediate 0
set gcov_remove_gcda 0
set xfailed 0
foreach a $args {
if { $a == "calls" } {
set gcov_verify_calls 1
} elseif { $a == "branches" } {
set gcov_verify_branches 1
} elseif { $a == "intermediate" } {
set gcov_verify_intermediate 1
set gcov_verify_calls 0
set gcov_verify_branches 0
set gcov_verify_lines 0
} elseif { $a == "remove-gcda" } {
set gcov_remove_gcda 1
} elseif { $gcov_args == "" } {
set gcov_args $a
} else {
switch [dg-process-target $a] {
"N" { return }
"F" { set xfailed 1 }
}
}
}
set testname [testname-for-summary]
# Extract the test file name from the arguments.
set testcase [lindex $gcov_args end]
if { $gcov_remove_gcda } {
verbose "Removing $testcase.gcda"
clean-gcov-file $testcase "gcda"
}
verbose "Running $GCOV $testcase" 2
set testcase [remote_download host $testcase]
set result [remote_exec host $GCOV $gcov_args]
if { [lindex $result 0] != 0 } {
if { $xfailed } {
setup_xfail "*-*-*"
}
fail "$testname gcov failed: [lindex $result 1]"
clean-gcov $testcase
return
}
set builtin_index [string first "File '<built-in>'" $result]
if { $builtin_index != -1 } {
fail "$testname gcov failed: <built-in>.gcov should not be created"
clean-gcov $testcase
return
}
# Get the gcov output file after making sure it exists.
set files [glob -nocomplain $testcase.gcov]
if { $files == "" } {
if { $xfailed } {
setup_xfail "*-*-*"
}
fail "$testname gcov failed: $testcase.gcov does not exist"
clean-gcov $testcase
return
}
remote_upload host $testcase.gcov $testcase.gcov
# Check that line execution counts are as expected.
if { $gcov_verify_lines } {
# Check that line execution counts are as expected.
set lfailed [verify-lines $testname $testcase $testcase.gcov]
} else {
set lfailed 0
}
# If requested via the .x file, check that branch and call information
# is correct.
if { $gcov_verify_branches } {
set bfailed [verify-branches $testname $testcase $testcase.gcov]
} else {
set bfailed 0
}
if { $gcov_verify_calls } {
set cfailed [verify-calls $testname $testcase $testcase.gcov]
} else {
set cfailed 0
}
if { $gcov_verify_intermediate } {
# Check that intermediate format has the expected format
set ifailed [verify-intermediate $testname $testcase $testcase.gcov]
} else {
set ifailed 0
}
# Report whether the gcov test passed or failed. If there were
# multiple failures then the message is a summary.
set tfailed [expr $lfailed + $bfailed + $cfailed + $ifailed]
if { $xfailed } {
setup_xfail "*-*-*"
}
if { $tfailed > 0 } {
fail "$testname gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages, $ifailed in intermediate format"
if { $xfailed } {
clean-gcov $testcase
}
} else {
pass "$testname gcov"
clean-gcov $testcase
}
}