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