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