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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [libmudflap/] [testsuite/] [lib/] [mfdg.exp] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 275 jeremybenn
# `mfdg' - overrides parts of general purpose testcase driver.
2
# Copyright (C) 1994 - 2001, 2003, 2009 Free Software Foundation, Inc.
3
 
4
# This program is free software; you can redistribute it and/or modify
5
# it under the terms of the GNU General Public License as published by
6
# the Free Software Foundation; either version 3 of the License, or
7
# (at your option) any later version.
8
#
9
# This program is distributed in the hope that it will be useful,
10
# but WITHOUT ANY WARRANTY; without even the implied warranty of
11
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
# GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License
15
# along with this program; see the file COPYING3.  If not see
16
# .
17
 
18
 
19
# This is a modified excerpt of dejagnu/lib/dg.exp.
20
 
21
load_lib dg.exp
22
 
23
 
24
# dg-test -- runs a new style DejaGnu test
25
#
26
# Syntax: dg-test [-keep-output] prog tool_flags default_extra_tool_flags
27
#
28
# PROG is the full path name of the file to pass to the tool (eg: compiler).
29
# TOOL_FLAGS is a set of options to always pass.
30
# DEFAULT_EXTRA_TOOL_FLAGS are additional options if the testcase has none.
31
 
32
#proc dg-test { prog tool_flags default_extra_tool_flags } {
33
proc dg-test { args } {
34
    global dg-do-what-default dg-interpreter-batch-mode dg-linenum-format
35
    global errorCode errorInfo
36
    global tool
37
    global srcdir               ;# eg: /calvin/dje/build/gcc/./testsuite/
38
    global host_triplet target_triplet
39
 
40
    set keep 0
41
    set i 0
42
    set dg-repetitions 1 ;# may be overridden by { dg-repetitions N }
43
    unset_timeout_vars
44
 
45
    if { [string index [lindex $args 0] 0] == "-" } {
46
        for { set i 0 } { $i < [llength $args] } { incr i } {
47
            if { [lindex $args $i] == "--" } {
48
                incr i
49
                break
50
            } elseif { [lindex $args $i] == "-keep-output" } {
51
                set keep 1
52
            } elseif { [string index [lindex $args $i] 0] == "-" } {
53
                clone_output "ERROR: dg-test: illegal argument: [lindex $args $i]"
54
                return
55
            } else {
56
                break
57
            }
58
        }
59
    }
60
 
61
    if { $i + 3 != [llength $args] } {
62
        clone_output "ERROR: dg-test: missing arguments in call"
63
        return
64
    }
65
    set prog [lindex $args $i]
66
    set tool_flags [lindex $args [expr $i + 1]]
67
    set default_extra_tool_flags [lindex $args [expr $i + 2]]
68
 
69
    set text "\[- A-Za-z0-9\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*"
70
 
71
    set name [dg-trim-dirname $srcdir $prog]
72
    # If we couldn't rip $srcdir out of `prog' then just do the best we can.
73
    # The point is to reduce the unnecessary noise in the logs.  Don't strip
74
    # out too much because different testcases with the same name can confuse
75
    # `test-tool'.
76
    if [string match "/*" $name] {
77
        set name "[file tail [file dirname $prog]]/[file tail $prog]"
78
    }
79
 
80
    if {$tool_flags != ""} {
81
        append name " ($tool_flags)"
82
    }
83
 
84
    # Process any embedded dg options in the testcase.
85
 
86
    # Use "" for the second element of dg-do-what so we can tell if it's been
87
    # explicitly set to "S".
88
    set dg-do-what [list ${dg-do-what-default} "" P]
89
    set dg-excess-errors-flag 0
90
    set dg-messages ""
91
    set dg-extra-tool-flags $default_extra_tool_flags
92
    set dg-final-code ""
93
 
94
    # `dg-output-text' is a list of two elements: pass/fail and text.
95
    # Leave second element off for now (indicates "don't perform test")
96
    set dg-output-text "P"
97
 
98
    # Define our own "special function" `unknown' so we catch spelling errors.
99
    # But first rename the existing one so we can restore it afterwards.
100
    catch {rename dg-save-unknown ""}
101
    rename unknown dg-save-unknown
102
    proc unknown { args } {
103
        return -code error "unknown dg option: $args"
104
    }
105
 
106
    set tmp [dg-get-options $prog]
107
    foreach op $tmp {
108
        verbose "Processing option: $op" 3
109
        set status [catch "$op" errmsg]
110
        if { $status != 0 } {
111
            if { 0 && [info exists errorInfo] } {
112
                # This also prints a backtrace which will just confuse
113
                # testcase writers, so it's disabled.
114
                perror "$name: $errorInfo\n"
115
            } else {
116
                perror "$name: $errmsg for \"$op\"\n"
117
            }
118
            # ??? The call to unresolved here is necessary to clear `errcnt'.
119
            # What we really need is a proc like perror that doesn't set errcnt.
120
            # It should also set exit_status to 1.
121
            unresolved "$name: $errmsg for \"$op\""
122
            return
123
        }
124
    }
125
 
126
    # Restore normal error handling.
127
    rename unknown ""
128
    rename dg-save-unknown unknown
129
 
130
    # If we're not supposed to try this test on this target, we're done.
131
    if { [lindex ${dg-do-what} 1] == "N" } {
132
        unsupported "$name"
133
        verbose "$name not supported on this target, skipping it" 3
134
        return
135
    }
136
 
137
    # Run the tool and analyze the results.
138
    # The result of ${tool}-dg-test is in a bit of flux.
139
    # Currently it is the name of the output file (or "" if none).
140
    # If we need more than this it will grow into a list of things.
141
    # No intention is made (at this point) to preserve upward compatibility
142
    # (though at some point we'll have to).
143
 
144
    set results [${tool}-dg-test $prog [lindex ${dg-do-what} 0] "$tool_flags ${dg-extra-tool-flags}"];
145
 
146
    set comp_output [lindex $results 0];
147
    set output_file [lindex $results 1];
148
 
149
    #send_user "\nold_dejagnu.exp: comp_output1 = :$comp_output:\n\n"
150
    #send_user "\nold_dejagnu.exp: message = :$message:\n\n"
151
    #send_user "\nold_dejagnu.exp: message length = [llength $message]\n\n"
152
 
153
    foreach i ${dg-messages} {
154
        verbose "Scanning for message: $i" 4
155
 
156
        # Remove all error messages for the line [lindex $i 0]
157
        # in the source file.  If we find any, success!
158
        set line [lindex $i 0]
159
        set pattern [lindex $i 2]
160
        set comment [lindex $i 3]
161
        #send_user "Before:\n$comp_output\n"
162
        if [regsub -all "(^|\n)(\[^\n\]+$line\[^\n\]*($pattern)\[^\n\]*\n?)+" $comp_output "\n" comp_output] {
163
            set comp_output [string trimleft $comp_output]
164
            set ok pass
165
            set uhoh fail
166
        } else {
167
            set ok fail
168
            set uhoh pass
169
        }
170
        #send_user "After:\n$comp_output\n"
171
 
172
        # $line will either be a formatted line number or a number all by
173
        # itself.  Delete the formatting.
174
        scan $line ${dg-linenum-format} line
175
        switch [lindex $i 1] {
176
            "ERROR" {
177
                $ok "$name $comment (test for errors, line $line)"
178
            }
179
            "XERROR" {
180
                x$ok "$name $comment (test for errors, line $line)"
181
            }
182
            "WARNING" {
183
                $ok "$name $comment (test for warnings, line $line)"
184
            }
185
            "XWARNING" {
186
                x$ok "$name $comment (test for warnings, line $line)"
187
            }
188
            "BOGUS" {
189
                $uhoh "$name $comment (test for bogus messages, line $line)"
190
            }
191
            "XBOGUS" {
192
                x$uhoh "$name $comment (test for bogus messages, line $line)"
193
            }
194
            "BUILD" {
195
                $uhoh "$name $comment (test for build failure, line $line)"
196
            }
197
            "XBUILD" {
198
                x$uhoh "$name $comment (test for build failure, line $line)"
199
            }
200
            "EXEC" { }
201
            "XEXEC" { }
202
        }
203
        #send_user "\nold_dejagnu.exp: comp_output2= :$comp_output:\n\n"
204
    }
205
    #send_user "\nold_dejagnu.exp: comp_output3 = :$comp_output:\n\n"
206
 
207
    # Remove messages from the tool that we can ignore.
208
    #send_user "comp_output: $comp_output\n"
209
    set comp_output [prune_warnings $comp_output]
210
 
211
    if { [info proc ${tool}-dg-prune] != "" } {
212
        set comp_output [${tool}-dg-prune $target_triplet $comp_output]
213
        switch -glob $comp_output {
214
            "::untested::*" {
215
                regsub "::untested::" $comp_output "" message
216
                untested "$name: $message"
217
                return
218
            }
219
            "::unresolved::*" {
220
                regsub "::unresolved::" $comp_output "" message
221
                unresolved "$name: $message"
222
                return
223
            }
224
            "::unsupported::*" {
225
                regsub "::unsupported::" $comp_output "" message
226
                unsupported "$name: $message"
227
                return
228
            }
229
        }
230
    }
231
 
232
    # See if someone forgot to delete the extra lines.
233
    regsub -all "\n+" $comp_output "\n" comp_output
234
    regsub "^\n+" $comp_output "" comp_output
235
    #send_user "comp_output: $comp_output\n"
236
 
237
    # Don't do this if we're testing an interpreter.
238
    # FIXME: why?
239
    if { ${dg-interpreter-batch-mode} == 0 } {
240
        # Catch excess errors (new bugs or incomplete testcases).
241
        if ${dg-excess-errors-flag} {
242
            setup_xfail "*-*-*"
243
        }
244
        if ![string match "" $comp_output] {
245
            fail "$name (test for excess errors)"
246
            send_log "Excess errors:\n$comp_output\n"
247
        } else {
248
            pass "$name (test for excess errors)"
249
        }
250
    }
251
 
252
    # Run the executable image if asked to do so.
253
    # FIXME: This is the only place where we assume a standard meaning to
254
    # the `keyword' argument of dg-do.  This could be cleaned up.
255
    if { [lindex ${dg-do-what} 0] == "run" } {
256
        if ![file exists $output_file] {
257
            warning "$name compilation failed to produce executable"
258
        } else {
259
            set testname $name
260
            for {set rep 0} {$rep < ${dg-repetitions}} {incr rep} {
261
                # include repetition number in test name
262
                if {$rep > 0} { set name "$testname (rerun $rep)" }
263
 
264
                set status -1
265
                set result [${tool}_load $output_file]
266
                set status [lindex $result 0];
267
                set output [lindex $result 1];
268
                #send_user "After exec, status: $status\n"
269
 
270
                if { "$status" == "pass" } {
271
                    verbose "Exec succeeded." 3
272
                } elseif { "$status" == "fail" } {
273
                    # It would be nice to get some info out of errorCode.
274
                    if [info exists errorCode] {
275
                        verbose "Exec failed, errorCode: $errorCode" 3
276
                    } else {
277
                        verbose "Exec failed, errorCode not defined!" 3
278
                    }
279
                }
280
 
281
                if { [lindex ${dg-do-what} 2] == "F" } {
282
                    # Instead of modelling this as an xfail (via setup_xfail),
283
                    # treat an expected crash as a success.
284
                    if { $status == "pass" } then { set status fail } else { set status pass }
285
                    set testtype "crash"
286
                } else { set testtype "execution" }
287
 
288
                $status "$name $testtype test"
289
 
290
                if { [llength ${dg-output-text}] > 1 } {
291
                    #send_user "${dg-output-text}\n"
292
                    if { [lindex ${dg-output-text} 0] == "F" } {
293
                        setup_xfail "*-*-*"
294
                    }
295
                    set texttmp [lindex ${dg-output-text} 1]
296
                    if { ![regexp $texttmp ${output}] } {
297
                        fail "$name output pattern test"
298
                    } else {
299
                        pass "$name output pattern test"
300
                    }
301
                    verbose -log "Output pattern $texttmp"
302
                    unset texttmp
303
                }
304
            }
305
        }
306
    }
307
 
308
    # Are there any further tests to perform?
309
    # Note that if the program has special run-time requirements, running
310
    # of the program can be delayed until here.  Ditto for other situations.
311
    # It would be a bit cumbersome though.
312
 
313
    if ![string match ${dg-final-code} ""] {
314
        regsub -all "\\\\(\[{}\])" ${dg-final-code} "\\1" dg-final-code
315
        # Note that the use of `args' here makes this a varargs proc.
316
        proc dg-final-proc { args } ${dg-final-code}
317
        verbose "Running dg-final tests." 3
318
        verbose "dg-final-proc:\n[info body dg-final-proc]" 4
319
        if [catch "dg-final-proc $prog" errmsg] {
320
            perror "$name: error executing dg-final: $errmsg"
321
            # ??? The call to unresolved here is necessary to clear `errcnt'.
322
            # What we really need is a proc like perror that doesn't set errcnt.
323
            # It should also set exit_status to 1.
324
            unresolved "$name: error executing dg-final: $errmsg"
325
        }
326
    }
327
 
328
    # Do some final clean up.
329
    # When testing an interpreter, we don't compile something and leave an
330
    # output file.
331
    if { ! ${keep} && ${dg-interpreter-batch-mode} == 0 } {
332
        catch "exec rm -f $output_file"
333
    }
334
}
335
 
336
 
337
 
338
#
339
# Indicate that this test case is to be rerun several times.  This
340
# is useful if it is nondeterministic.  This applies to rerunning the
341
# test program only, not rebuilding it.
342
# The embedded format is "{ dg-repetitions N }", where N is the number
343
# of repetitions.  It better be greater than zero.
344
#
345
proc dg-repetitions { line value } {
346
    upvar dg-repetitions repetitions
347
    set repetitions $value
348
}

powered by: WebSVN 2.1.0

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