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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [lib/] [gcov.exp] - Blame information for rev 823

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

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

powered by: WebSVN 2.1.0

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