OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [lib/] [gcov.exp] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.