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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-7.2/] [sim/] [testsuite/] [lib/] [sim-defs.exp] - Blame information for rev 373

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

Line No. Rev Author Line
1 330 jeremybenn
# Simulator dejagnu utilities.
2
 
3
# Communicate simulator path from sim_init to sim_version.
4
# For some reason [board_info target sim] doesn't work in sim_version.
5
# [Presumubly because the target has been "popped" by then.  Odd though.]
6
set sim_path "unknown-run"
7
 
8
# Initialize the testrun.
9
# Required by dejagnu.
10
 
11
proc sim_init { args } {
12
    global sim_path
13
    set sim_path [board_info target sim]
14
    # Need to return an empty string (copied from GAS).
15
    return ""
16
}
17
 
18
# Print the version of the simulator being tested.
19
# Required by dejagnu.
20
 
21
proc sim_version {} {
22
    global sim_path
23
    set version 0.5
24
    clone_output "$sim_path $version\n"
25
}
26
 
27
# Cover function to target_compile.
28
# Copied from gdb_compile.
29
 
30
proc sim_compile { source dest type options } {
31
    set result [target_compile $source $dest $type $options]
32
    regsub "\[\r\n\]*$" "$result" "" result
33
    regsub "^\[\r\n\]*" "$result" "" result
34
    if { $result != "" } {
35
        clone_output "sim compile output: $result"
36
    }
37
    return $result
38
}
39
 
40
# Run a program on the simulator.
41
# Required by dejagnu (at least ${tool}_run used to be).
42
#
43
# SIM_OPTS are options for the simulator.
44
# PROG_OPTS are options passed to the simulated program.
45
# At present REDIR must be "" or "> foo".
46
# OPTIONS is a list of options internal to this routine.
47
# This is modelled after target_compile.  We want to be able to add new
48
# options without having to update all our users.
49
# Currently:
50
#       env(foo)=val    - set environment variable foo to val for this run
51
#       timeout=val     - set the timeout to val for this run
52
#
53
# The result is a list of two elements.
54
# The first is one of pass/fail/etc.
55
# The second is the program's output.
56
#
57
# This is different than the sim_load routine provided by
58
# dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
59
# simulator (not the simulated program, the simulator) with sim_load.
60
 
61
proc sim_run { prog sim_opts prog_opts redir options } {
62
    global SIMFLAGS
63
 
64
    # Set the default value of the timeout.
65
    # FIXME: The timeout value we actually want is a function of
66
    # host, target, and testcase.
67
    set testcase_timeout [board_info target sim_time_limit]
68
    if { "$testcase_timeout" == "" } {
69
        set testcase_timeout [board_info host testcase_timeout]
70
    }
71
    if { "$testcase_timeout" == "" } {
72
        set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
73
    }
74
 
75
    # Initial the environment we pass to the testcase.
76
    set testcase_env ""
77
 
78
    # Process OPTIONS ...
79
    foreach o $options {
80
        if [regexp {^env\((.*)\)=(.*)} $o full var val] {
81
            set testcase_env "$testcase_env $var=$val"
82
        } elseif [regexp {^timeout=(.*)} $o full val] {
83
            set testcase_timeout $val
84
        }
85
 
86
    }
87
 
88
    verbose "testcase timeout is set to $testcase_timeout" 1
89
 
90
    set sim [board_info target sim]
91
    if [string equal "" $sim] {
92
        # Special case the simulator.  These tests are designed to
93
        # be run inside of the simulator, not on the native host.
94
        # So if the sim target isn't set, default to the target run.
95
        # These global variables come from generated site.exp.
96
        global objdir
97
        global arch
98
        set sim "$objdir/../$arch/run"
99
    }
100
 
101
    if [is_remote host] {
102
        set prog [remote_download host $prog]
103
        if { $prog == "" } {
104
            error "download failed"
105
            return -1
106
        }
107
    }
108
 
109
    set board [target_info name]
110
    if [board_info $board exists sim,options] {
111
        set always_opts [board_info $board sim,options]
112
    } else {
113
        set always_opts ""
114
    }
115
 
116
    # FIXME: this works for UNIX only
117
    if { "$testcase_env" != "" } {
118
        set sim "env $testcase_env $sim"
119
    }
120
 
121
    if { [board_info target sim,protocol] == "sid" } {
122
        set cmd ""
123
        set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\""
124
    } else {
125
        set cmd "$prog"
126
    }
127
 
128
    send_log "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts\n"
129
 
130
    if { "$redir" == "" } {
131
        remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts"
132
    } else {
133
        remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts $redir" writeonly
134
    }
135
    set result [remote_wait host $testcase_timeout]
136
 
137
    set return_code [lindex $result 0]
138
    set output [lindex $result 1]
139
    # Remove the \r part of "\r\n" so we don't break all the patterns
140
    # we want to match.
141
    regsub -all -- "\r" $output "" output
142
 
143
    if [is_remote host] {
144
        # clean up after ourselves.
145
        remote_file host delete $prog
146
    }
147
 
148
    # ??? Not sure the test for pass/fail is right.
149
    # We just care that the simulator ran correctly, not whether the simulated
150
    # program return 0 or non-zero from `main'.
151
    set status fail
152
    if { $return_code == 0 } {
153
        set status pass
154
    }
155
 
156
    return [list $status $output]
157
}
158
 
159
# Run testcase NAME.
160
# NAME is either a fully specified file name, or just the file name in which
161
# case $srcdir/$subdir will be prepended.
162
# REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
163
# for the specified machine(s), it is ignored.
164
# Typically REQUESTED_MACHS contains just one element, it is up to the caller
165
# to iterate over the desired machine variants.
166
#
167
# The file can contain options in the form "# option(mach list): value".
168
# Possibilities:
169
# mach: [all | machine names]
170
# as[(mach-list)]: 
171
# ld[(mach-list)]: 
172
# sim[(mach-list)]: 
173
# progopts: 
174
# output: program output pattern to match with string-match
175
# xerror: program is expected to return with a "failure" exit code
176
# xfail:  
177
# kfail:  
178
# If `output' is not specified, the program must output "pass" if !xerror or
179
# "fail" if xerror.
180
# The parens in "optname()" are optional if the specification is for all machs.
181
# Multiple "output", "xfail" and "kfail" options concatenate.
182
# The xfail and kfail arguments are space-separated target triplets and PRIDs.
183
# There must be a PRMS (bug report ID) specified for kfail, while it's
184
# optional for xfail.
185
 
186
proc run_sim_test { name requested_machs } {
187
    global subdir srcdir
188
    global SIMFLAGS
189
    global opts
190
    global cpu_option
191
    global global_as_options
192
    global global_ld_options
193
    global global_sim_options
194
 
195
    if [string match "*/*" $name] {
196
        set file $name
197
        set name [file tail $name]
198
    } else {
199
        set file "$srcdir/$subdir/$name"
200
    }
201
 
202
    set opt_array [slurp_options "${file}"]
203
    if { $opt_array == -1 } {
204
        unresolved $subdir/$name
205
        return
206
    }
207
    # Clear default options
208
    set opts(as) ""
209
    set opts(ld) ""
210
    set opts(progopts) ""
211
    set opts(sim) ""
212
    set opts(output) ""
213
    set opts(mach) ""
214
    set opts(timeout) ""
215
    set opts(xerror) "no"
216
    set opts(xfail) ""
217
    set opts(kfail) ""
218
 
219
    if ![info exists global_as_options] {
220
        set global_as_options ""
221
    }
222
    if ![info exists global_ld_options] {
223
        set global_ld_options ""
224
    }
225
    if ![info exists global_sim_options] {
226
        set global_sim_options ""
227
    }
228
 
229
    # Clear any machine specific options specified in a previous test case
230
    foreach m $requested_machs {
231
        if [info exists opts(as,$m)] {
232
            unset opts(as,$m)
233
        }
234
        if [info exists opts(ld,$m)] {
235
            unset opts(ld,$m)
236
        }
237
        if [info exists opts(sim,$m)] {
238
            unset opts(sim,$m)
239
        }
240
    }
241
 
242
    foreach i $opt_array {
243
        set opt_name [lindex $i 0]
244
        set opt_machs [lindex $i 1]
245
        set opt_val [lindex $i 2]
246
        if ![info exists opts($opt_name)] {
247
            perror "unknown option $opt_name in file $file"
248
            unresolved $subdir/$name
249
            return
250
        }
251
        # Multiple "output" specifications concatenate, they don't override.
252
        if { $opt_name == "output" } {
253
            set opt_val "$opts(output)$opt_val"
254
        }
255
        # Similar with "xfail" and "kfail", but arguments are space-separated.
256
        if { $opt_name == "xfail" || $opt_name == "kfail" } {
257
            set opt_val "$opts($opt_name) $opt_val"
258
        }
259
 
260
        foreach m $opt_machs {
261
            set opts($opt_name,$m) $opt_val
262
        }
263
        if { "$opt_machs" == "" } {
264
            set opts($opt_name) $opt_val
265
        }
266
    }
267
 
268
    set testname $name
269
    set sourcefile $file
270
    if { $opts(output) == "" } {
271
        if { "$opts(xerror)" == "no" } {
272
            set opts(output) "pass\n"
273
        } else {
274
            set opts(output) "fail\n"
275
        }
276
    }
277
    # Change \n sequences to newline chars.
278
    regsub -all "\\\\n" $opts(output) "\n" opts(output)
279
 
280
    set testcase_machs $opts(mach)
281
    if { "$testcase_machs" == "all" } {
282
        set testcase_machs $requested_machs
283
    }
284
 
285
    foreach mach $testcase_machs {
286
        if { [lsearch $requested_machs $mach] < 0 } {
287
            verbose -log "Skipping $mach version of $name, not requested."
288
            continue
289
        }
290
 
291
        verbose -log "Testing $name on machine $mach."
292
 
293
        # Time to setup xfailures and kfailures.
294
        if { "$opts(xfail)" != "" } {
295
            verbose -log "xfail: $opts(xfail)"
296
            # Using eval to make $opts(xfail) appear as individual
297
            # arguments.
298
            eval setup_xfail $opts(xfail)
299
        }
300
        if { "$opts(kfail)" != "" } {
301
            verbose -log "kfail: $opts(kfail)"
302
            eval setup_kfail $opts(kfail)
303
        }
304
 
305
        if ![info exists opts(as,$mach)] {
306
            set opts(as,$mach) $opts(as)
307
        }
308
 
309
        set as_options "$opts(as,$mach) -I$srcdir/$subdir"
310
        if [info exists cpu_option] {
311
            set as_options "$as_options $cpu_option=$mach"
312
        }
313
        set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
314
 
315
        if ![string match "" $comp_output] {
316
            verbose -log "$comp_output" 3
317
            fail "$mach $testname (assembling)"
318
            continue
319
        }
320
 
321
        if ![info exists opts(ld,$mach)] {
322
            set opts(ld,$mach) $opts(ld)
323
        }
324
 
325
        set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
326
 
327
        if ![string match "" $comp_output] {
328
            verbose -log "$comp_output" 3
329
            fail "$mach $testname (linking)"
330
            continue
331
        }
332
 
333
        # If no machine specific options, default to the general version.
334
        if ![info exists opts(sim,$mach)] {
335
            set opts(sim,$mach) $opts(sim)
336
        }
337
 
338
        # Build the options argument.
339
        set options ""
340
        if { "$opts(timeout)" != "" } {
341
            set options "$options timeout=$opts(timeout)"
342
        }
343
 
344
        set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "$opts(progopts)" "" "$options"]
345
        set status [lindex $result 0]
346
        set output [lindex $result 1]
347
 
348
        if { "$status" == "pass" } {
349
            if { "$opts(xerror)" == "no" } {
350
                if [string match $opts(output) $output] {
351
                    pass "$mach $testname"
352
                    file delete ${name}.o ${name}.x
353
                } else {
354
                    verbose -log "output:  $output" 3
355
                    verbose -log "pattern: $opts(output)" 3
356
                    fail "$mach $testname (execution)"
357
                }
358
            } else {
359
                verbose -log "`pass' return code when expecting failure" 3
360
                fail "$mach $testname (execution)"
361
            }
362
        } elseif { "$status" == "fail" } {
363
            if { "$opts(xerror)" == "no" } {
364
                fail "$mach $testname (execution)"
365
            } else {
366
                if [string match $opts(output) $output] {
367
                    pass "$mach $testname"
368
                    file delete ${name}.o ${name}.x
369
                } else {
370
                    verbose -log "output:  $output" 3
371
                    verbose -log "pattern: $opts(output)" 3
372
                    fail "$mach $testname (execution)"
373
                }
374
            }
375
        } else {
376
            $status "$mach $testname"
377
        }
378
    }
379
}
380
 
381
# Subroutine of run_sim_test to process options in FILE.
382
 
383
proc slurp_options { file } {
384
    if [catch { set f [open $file r] } x] {
385
        #perror "couldn't open `$file': $x"
386
        perror "$x"
387
        return -1
388
    }
389
    set opt_array {}
390
    # whitespace expression
391
    set ws  {[  ]*}
392
    set nws {[^         ]*}
393
    # whitespace is ignored anywhere except within the options list;
394
    # option names are alphabetic only
395
    set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
396
    # Allow arbitrary lines until the first option is seen.
397
    set seen_opt 0
398
    while { [gets $f line] != -1 } {
399
        set line [string trim $line]
400
        # Whitespace here is space-tab.
401
        if [regexp $pat $line xxx opt_name opt_machs opt_val] {
402
            # match!
403
            lappend opt_array [list $opt_name $opt_machs $opt_val]
404
            set seen_opt 1
405
        } else {
406
            if { $seen_opt } {
407
                break
408
            }
409
        }
410
    }
411
    close $f
412
    return $opt_array
413
}

powered by: WebSVN 2.1.0

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