#   Copyright (C) 1997, 2001, 2007 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.global GCOV## clean-gcov -- delete the working files the compiler creates for gcov## TESTCASE is the name of the test.#proc clean-gcov { testcase } {    set basename [file tail $testcase]    set base [file rootname $basename]    remote_file host delete $base.gcno $base.gcda \	$basename.gcov $base.h.gcov}## verify-lines -- check that line counts are as expected## TESTCASE is the name of the test.# FILE is the name of the gcov output file.#proc verify-lines { testcase file } {    #send_user "verify-lines\n"    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\\-#]+)\\)" \		"$line" all is n shouldbe] {	    if { $is == "" } {		fail "$n:no data available for this line"		incr failed	    } elseif { $is != $shouldbe } {		fail "$n:is $is:should be $shouldbe"		incr failed	    }	}    }    close $fd    return $failed}## verify-branches -- check that branch percentages are as expected## TESTCASE is the name of the test.# 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 { 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 "$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 "$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 "$n: 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 "$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 "$n: expected branch percentages not found: $shouldbe"	incr failed    }    close $fd    return $failed}## verify-calls -- check that call return percentages are as expected## TESTCASE is the name of the test.# 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 { 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 "$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 "$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 "$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 "$n: expected return percentages not found: $shouldbe"	incr failed    }    close $fd    return $failed}# 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 [lindex $args end]    set gcov_verify_calls 0    set gcov_verify_branches 0    set gcov_execute_xfail ""    set gcov_verify_xfail ""    foreach a $args {	if { $a == "calls" } {	  set gcov_verify_calls 1	} elseif { $a == "branches" } {	  set gcov_verify_branches 1	}    }    # Extract the test name from the arguments.    set testcase [lindex $gcov_args end]    if { $gcov_execute_xfail != "" } {	eval setup_xfail [split $gcov_execute_xfail]    }    verbose "Running $GCOV $testcase" 2    set testcase [remote_download host $testcase]    set result [remote_exec host $GCOV $gcov_args]    if { [lindex $result 0] != 0 } {	fail "$subdir/$testcase gcov failed: [lindex $result 1]"	clean-gcov $testcase	return    }    # Get the gcov output file after making sure it exists.    set files [glob -nocomplain $testcase.gcov]    if { $files == "" } {        fail "$subdir/$testcase gcov failed: $testcase.gcov does not exist"        clean-gcov $testcase        return    }    remote_upload host $testcase.gcov $testcase.gcov    if { $gcov_verify_xfail != "" } {	eval setup_xfail [split $gcov_verify_xfail]    }    # Check that line execution counts are as expected.    set lfailed [verify-lines $testcase $testcase.gcov]    # If requested via the .x file, check that branch and call information    # is correct.    if { $gcov_verify_branches } {	set bfailed [verify-branches $testcase $testcase.gcov]    } else {	set bfailed 0    }    if { $gcov_verify_calls } {	set cfailed [verify-calls $testcase $testcase.gcov]    } else {	set cfailed 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]    if { $tfailed > 0 } {	fail "$subdir/$testcase gcov: $lfailed failures in line counts, $bfailed in branch percentages, $cfailed in return percentages"    } else {	pass "$subdir/$testcase gcov"	clean-gcov $testcase    }}