gcc/testsuite/lib/gcov.exp

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