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