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