1# Copyright (C) 1997, 2001 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 2 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 this program; if not, write to the Free Software 15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 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 -- delete the working files the compiler creates for gcov 24# 25# TESTCASE is the name of the test. 26# 27proc clean-gcov { testcase } { 28 set basename [file tail $testcase] 29 set base [file rootname $basename] 30 remote_file host delete $base.bb $base.bbg $base.da $basename.gcov 31} 32 33# 34# verify-lines -- check that line counts are as expected 35# 36# TESTCASE is the name of the test. 37# FILE is the name of the gcov output file. 38# 39proc verify-lines { testcase file } { 40 #send_user "verify-lines\n" 41 set failed 0 42 set fd [open $file r] 43 while { [gets $fd line] >= 0 } { 44 if [regexp "^ *(\[^:]*): *(\[0-9\]+):.*count\\((\[0-9\]+)\\)" \ 45 "$line" all is n shouldbe] { 46 if { $is == "" } { 47 fail "$n:no data available for this line" 48 incr failed 49 } elseif { $is != $shouldbe } { 50 fail "$n:is $is:should be $shouldbe" 51 incr failed 52 } 53 } 54 } 55 return $failed 56} 57 58# 59# verify-branches -- check that branch percentages are as expected 60# 61# TESTCASE is the name of the test. 62# FILE is the name of the gcov output file. 63# 64# Checks are based on comments in the source file. This means to look for 65# branch percentages 10 or 90, 20 or 80, and # 70 or 30: 66# /* branch(10, 20, 70) */ 67# This means that all specified percentages should have been seen by now: 68# /* branch(end) */ 69# All specified percentages must also be seen by the next branch(n) or 70# by the end of the file. 71# 72# Each check depends on the compiler having generated the expected 73# branch instructions. Don't check for branches that might be 74# optimized away or replaced with predicated instructions. 75# 76proc verify-branches { testcase file } { 77 #send_user "verify-branches\n" 78 set failed 0 79 set shouldbe "" 80 set fd [open $file r] 81 set n 0 82 while { [gets $fd line] >= 0 } { 83 regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n 84 if [regexp "branch" $line] { 85 verbose "Processing branch line $n: $line" 3 86 if [regexp "branch\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] { 87 # All percentages in the current list should have been seen. 88 if {[llength $shouldbe] != 0} { 89 fail "$n: expected branch percentages not found: $shouldbe" 90 incr failed 91 set shouldbe "" 92 } 93 set shouldbe $new_shouldbe 94 #send_user "$n: looking for: $shouldbe\n" 95 # Record the percentages to check for. Replace percentage 96 # n > 50 with 100-n, since block ordering affects the 97 # direction of a branch. 98 for {set i 0} {$i < [llength $shouldbe]} {incr i} { 99 set num [lindex $shouldbe $i] 100 if {$num > 50} { 101 set shouldbe [lreplace $shouldbe $i $i [expr 100 - $num]] 102 } 103 } 104 } elseif [regexp "branch +\[0-9\]+ taken (-\[0-9\]+)%" "$line" \ 105 all taken] { 106 # Percentages should never be negative. 107 fail "$n: negative percentage: $taken" 108 incr failed 109 } elseif [regexp "branch +\[0-9\]+ taken (\[0-9\]+)%" "$line" \ 110 all taken] { 111 #send_user "$n: taken = $taken\n" 112 # Percentages should never be greater than 100. 113 if {$taken > 100} { 114 fail "$n: percentage greater than 100: $taken" 115 incr failed 116 } 117 if {$taken > 50} { 118 set taken [expr 100 - $taken] 119 } 120 # If this percentage is one to check for then remove it 121 # from the list. It's normal to ignore some reports. 122 set i [lsearch $shouldbe $taken] 123 if {$i != -1} { 124 set shouldbe [lreplace $shouldbe $i $i] 125 } 126 } elseif [regexp "branch\\(end\\)" "$line"] { 127 # All percentages in the list should have been seen by now. 128 if {[llength $shouldbe] != 0} { 129 fail "$n: expected branch percentages not found: $shouldbe" 130 incr failed 131 } 132 set shouldbe "" 133 } 134 } 135 } 136 # All percentages in the list should have been seen. 137 if {[llength $shouldbe] != 0} { 138 fail "$n: expected branch percentages not found: $shouldbe" 139 incr failed 140 } 141 close $fd 142 return $failed 143} 144 145# 146# verify-calls -- check that call return percentages are as expected 147# 148# TESTCASE is the name of the test. 149# FILE is the name of the gcov output file. 150# 151# Checks are based on comments in the source file. This means to look for 152# call return percentages 50, 20, 33: 153# /* returns(50, 20, 33) */ 154# This means that all specified percentages should have been seen by now: 155# /* returns(end) */ 156# All specified percentages must also be seen by the next returns(n) or 157# by the end of the file. 158# 159# Each check depends on the compiler having generated the expected 160# call instructions. Don't check for calls that are inserted by the 161# compiler or that might be inlined. 162# 163proc verify-calls { testcase file } { 164 #send_user "verify-calls\n" 165 set failed 0 166 set shouldbe "" 167 set fd [open $file r] 168 set n 0 169 while { [gets $fd line] >= 0 } { 170 regexp "^\[^:\]+: *(\[0-9\]+):" "$line" all n 171 if [regexp "returns" $line] { 172 verbose "Processing returns line $n: $line" 3 173 if [regexp "returns\\((\[0-9 \]+)\\)" "$line" all new_shouldbe] { 174 # All percentages in the current list should have been seen. 175 if {[llength $shouldbe] != 0} { 176 fail "$n: expected return percentages not found: $shouldbe" 177 incr failed 178 set shouldbe "" 179 } 180 # Record the percentages to check for. 181 set shouldbe $new_shouldbe 182 } elseif [regexp "call +\[0-9\]+ returns (-\[0-9\]+)%" "$line" \ 183 all returns] { 184 # Percentages should never be negative. 185 fail "$n: negative percentage: $returns" 186 incr failed 187 } elseif [regexp "call +\[0-9\]+ returns (\[0-9\]+)%" "$line" \ 188 all returns] { 189 # For branches we check that percentages are not greater than 190 # 100 but call return percentages can be, as for setjmp(), so 191 # don't count that as an error. 192 # 193 # If this percentage is one to check for then remove it 194 # from the list. It's normal to ignore some reports. 195 set i [lsearch $shouldbe $returns] 196 if {$i != -1} { 197 set shouldbe [lreplace $shouldbe $i $i] 198 } 199 } elseif [regexp "returns\\(end\\)" "$line"] { 200 # All percentages in the list should have been seen by now. 201 if {[llength $shouldbe] != 0} { 202 fail "$n: expected return percentages not found: $shouldbe" 203 incr failed 204 } 205 set shouldbe "" 206 } 207 } 208 } 209 # All percentages in the list should have been seen. 210 if {[llength $shouldbe] != 0} { 211 fail "$n: expected return percentages not found: $shouldbe" 212 incr failed 213 } 214 close $fd 215 return $failed 216} 217 218# Called by dg-final to run gcov and analyze the results. 219# 220# ARGS is the options to pass to gcov followed by the name of the 221# test source file. 222 223proc run-gcov { args } { 224 global GCOV 225 global srcdir subdir 226 227 # Extract the test name from the arguments. 228 set testcase [lindex $args end] 229 230 # Get special options for this test from the .x script, if present. 231 # This can include: 232 # gcov_execute_xfail string to pass to setup_xfail 233 # gcov_verify_xfail string to pass to setup_xfail 234 # gcov_verify_branches if defined, check branch percentages 235 # gcov_verify_calls if defined, check call return percentages 236 if [file exists [file rootname $srcdir/$subdir/$testcase].x] { 237 set done_p 0 238 catch "set done_p \[source [file rootname $srcdir/$subdir/$testcase].x\]" 239 if { $done_p } { 240 return 241 } 242 } 243 244 if [info exists gcov_execute_xfail] { 245 eval setup_xfail [split $gcov_execute_xfail] 246 } 247 248 verbose "Running $GCOV $testcase" 2 249 set testcase [remote_download host $testcase]; 250 set result [remote_exec host $GCOV $args]; 251 if { [lindex $result 0] != 0 } { 252 fail "$subdir/$testcase gcov failed: [lindex $result 1]" 253 clean-gcov $testcase 254 return 255 } 256 257 # Get the gcov output file after making sure it exists. 258 set files [glob -nocomplain $testcase.gcov] 259 if { $files == "" } { 260 fail "$subdir/$testcase gcov failed: $testcase.gcov does not exist" 261 clean-gcov $testcase 262 return; 263 } 264 remote_upload host $testcase.gcov $testcase.gcov; 265 266 if [info exists gcov_verify_xfail] { 267 eval setup_xfail [split $gcov_verify_xfail] 268 } 269 270 # Check that line execution counts are as expected. 271 set lfailed [verify-lines $testcase $testcase.gcov] 272 273 # If requested via the .x file, check that branch and call information 274 # is correct. 275 if [info exists gcov_verify_branches] { 276 set bfailed [verify-branches $testcase $testcase.gcov] 277 } else { 278 set bfailed 0 279 } 280 if [info exists gcov_verify_calls] { 281 set cfailed [verify-calls $testcase $testcase.gcov] 282 } else { 283 set cfailed 0 284 } 285 286 # Report whether the gcov test passed or failed. If there were 287 # multiple failures then the message is a summary. 288 set tfailed [expr $lfailed + $bfailed + $cfailed] 289 if { $tfailed > 0 } { 290 fail "$subdir/$testcase gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages" 291 } else { 292 pass "$subdir/$testcase gcov" 293 clean-gcov $testcase 294 } 295} 296