Subversion Repositories openrisc

#   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"
    global subdir
    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 rest] {
            if [regexp "^ *{(.*)}" $rest all xfailed] {
                switch [dg-process-target $xfailed] {
                    "N" { continue }
                    "F" { setup_xfail "*-*-*" }
                }
            }
            if { $is == "" } {
                fail "$subdir/$testcase:$n:no data available for this line"
                incr failed
            } elseif { $is != $shouldbe } {
                fail "$subdir/$testcase:$n:is $is:should be $shouldbe"
                incr failed
            } else {
                pass "$subdir/$testcase:$n line count"
            }
        }
    }
    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 ""
    set gcov_verify_calls 0
    set gcov_verify_branches 0
    set xfailed 0

    foreach a $args {
        if { $a == "calls" } {
          set gcov_verify_calls 1
        } elseif { $a == "branches" } {
          set gcov_verify_branches 1
        } elseif { $gcov_args == "" } {
            set gcov_args $a
        } else {
            switch [dg-process-target $a] {
                "N" { return }
                "F" { set xfailed 1 }
            }
        }
    }

    # Extract the test name from the arguments.
    set testcase [lindex $gcov_args end]

    verbose "Running $GCOV $testcase" 2
    set testcase [remote_download host $testcase]
    set result [remote_exec host $GCOV $gcov_args]
    if { [lindex $result 0] != 0 } {
        if { $xfailed } {
            setup_xfail "*-*-*"
        }
        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 == "" } {
        if { $xfailed } {
            setup_xfail "*-*-*"
        }
        fail "$subdir/$testcase gcov failed: $testcase.gcov does not exist"
        clean-gcov $testcase
        return
    }
    remote_upload host $testcase.gcov $testcase.gcov

    # 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 { $xfailed } {
        setup_xfail "*-*-*"
    }
    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
    }
}