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