| 1 |
106 |
markom |
# 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 |
|
|
|
| 92 |
|
|
if [is_remote host] {
|
| 93 |
|
|
set prog [remote_download host $prog]
|
| 94 |
|
|
if { $prog == "" } {
|
| 95 |
|
|
error "download failed"
|
| 96 |
|
|
return -1;
|
| 97 |
|
|
}
|
| 98 |
|
|
}
|
| 99 |
|
|
|
| 100 |
|
|
set board [target_info name]
|
| 101 |
|
|
if [board_info $board exists sim,options] {
|
| 102 |
|
|
set always_opts [board_info $board sim,options]
|
| 103 |
|
|
} else {
|
| 104 |
|
|
set always_opts ""
|
| 105 |
|
|
}
|
| 106 |
|
|
|
| 107 |
|
|
# FIXME: this works for UNIX only
|
| 108 |
|
|
if { "$testcase_env" != "" } {
|
| 109 |
|
|
set sim "env $testcase_env $sim"
|
| 110 |
|
|
}
|
| 111 |
|
|
|
| 112 |
|
|
send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"
|
| 113 |
|
|
|
| 114 |
|
|
if { "$redir" == "" } {
|
| 115 |
|
|
remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
|
| 116 |
|
|
} else {
|
| 117 |
|
|
remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
|
| 118 |
|
|
}
|
| 119 |
|
|
set result [remote_wait host $testcase_timeout]
|
| 120 |
|
|
|
| 121 |
|
|
set return_code [lindex $result 0]
|
| 122 |
|
|
set output [lindex $result 1]
|
| 123 |
|
|
# Remove the \r part of "\r\n" so we don't break all the patterns
|
| 124 |
|
|
# we want to match.
|
| 125 |
|
|
regsub -all -- "\r" $output "" output
|
| 126 |
|
|
|
| 127 |
|
|
if [is_remote host] {
|
| 128 |
|
|
# clean up after ourselves.
|
| 129 |
|
|
remote_file host delete $prog
|
| 130 |
|
|
}
|
| 131 |
|
|
|
| 132 |
|
|
# ??? Not sure the test for pass/fail is right.
|
| 133 |
|
|
# We just care that the simulator ran correctly, not whether the simulated
|
| 134 |
|
|
# program return 0 or non-zero from `main'.
|
| 135 |
|
|
set status fail
|
| 136 |
|
|
if { $return_code == 0 } {
|
| 137 |
|
|
set status pass
|
| 138 |
|
|
}
|
| 139 |
|
|
|
| 140 |
|
|
return [list $status $output]
|
| 141 |
|
|
}
|
| 142 |
|
|
|
| 143 |
|
|
# Run testcase NAME.
|
| 144 |
|
|
# NAME is either a fully specified file name, or just the file name in which
|
| 145 |
|
|
# case $srcdir/$subdir will be prepended.
|
| 146 |
|
|
# REQUESTED_MACHS is a list of machines to run the testcase on. If NAME isn't
|
| 147 |
|
|
# for the specified machine(s), it is ignored.
|
| 148 |
|
|
# Typically REQUESTED_MACHS contains just one element, it is up to the caller
|
| 149 |
|
|
# to iterate over the desired machine variants.
|
| 150 |
|
|
#
|
| 151 |
|
|
# The file can contain options in the form "# option(mach list): value".
|
| 152 |
|
|
# Possibilities:
|
| 153 |
|
|
# mach: [all | machine names]
|
| 154 |
|
|
# as[(mach-list)]:
|
| 155 |
|
|
# ld[(mach-list)]:
|
| 156 |
|
|
# sim[(mach-list)]:
|
| 157 |
|
|
# output[(mach-list)]: program output pattern to match with string-match
|
| 158 |
|
|
# xerror[(mach-list)]: program is expected to return with a "failure" exit code
|
| 159 |
|
|
# If `output' is not specified, the program must output "pass" if !xerror or
|
| 160 |
|
|
# "fail" if xerror.
|
| 161 |
|
|
# The parens in "optname()" are optional if the specification is for all machs.
|
| 162 |
|
|
|
| 163 |
|
|
proc run_sim_test { name requested_machs } {
|
| 164 |
|
|
global subdir srcdir
|
| 165 |
|
|
global SIMFLAGS
|
| 166 |
|
|
global opts
|
| 167 |
|
|
|
| 168 |
|
|
if [string match "*/*" $name] {
|
| 169 |
|
|
set file $name
|
| 170 |
|
|
set name [file tail $name]
|
| 171 |
|
|
} else {
|
| 172 |
|
|
set file "$srcdir/$subdir/$name"
|
| 173 |
|
|
}
|
| 174 |
|
|
|
| 175 |
|
|
set opt_array [slurp_options "${file}"]
|
| 176 |
|
|
if { $opt_array == -1 } {
|
| 177 |
|
|
unresolved $subdir/$name
|
| 178 |
|
|
return
|
| 179 |
|
|
}
|
| 180 |
|
|
set opts(as) {}
|
| 181 |
|
|
set opts(ld) {}
|
| 182 |
|
|
set opts(sim) {}
|
| 183 |
|
|
set opts(output) {}
|
| 184 |
|
|
set opts(mach) {}
|
| 185 |
|
|
set opts(timeout) {}
|
| 186 |
|
|
set opts(xerror) "no"
|
| 187 |
|
|
|
| 188 |
|
|
foreach i $opt_array {
|
| 189 |
|
|
set opt_name [lindex $i 0]
|
| 190 |
|
|
set opt_machs [lindex $i 1]
|
| 191 |
|
|
set opt_val [lindex $i 2]
|
| 192 |
|
|
if ![info exists opts($opt_name)] {
|
| 193 |
|
|
perror "unknown option $opt_name in file $file"
|
| 194 |
|
|
unresolved $subdir/$name
|
| 195 |
|
|
return
|
| 196 |
|
|
}
|
| 197 |
|
|
foreach m $opt_machs {
|
| 198 |
|
|
set opts($opt_name,$m) $opt_val
|
| 199 |
|
|
}
|
| 200 |
|
|
if { "$opt_machs" == "" } {
|
| 201 |
|
|
set opts($opt_name) $opt_val
|
| 202 |
|
|
}
|
| 203 |
|
|
}
|
| 204 |
|
|
|
| 205 |
|
|
set testname $name
|
| 206 |
|
|
set sourcefile $file
|
| 207 |
|
|
if { $opts(output) == "" } {
|
| 208 |
|
|
if { "$opts(xerror)" == "no" } {
|
| 209 |
|
|
set opts(output) "pass\n"
|
| 210 |
|
|
} else {
|
| 211 |
|
|
set opts(output) "fail\n"
|
| 212 |
|
|
}
|
| 213 |
|
|
}
|
| 214 |
|
|
# Change \n sequences to newline chars.
|
| 215 |
|
|
regsub -all "\\\\n" $opts(output) "\n" opts(output)
|
| 216 |
|
|
|
| 217 |
|
|
set testcase_machs $opts(mach)
|
| 218 |
|
|
if { "$testcase_machs" == "all" } {
|
| 219 |
|
|
set testcase_machs $requested_machs
|
| 220 |
|
|
}
|
| 221 |
|
|
|
| 222 |
|
|
foreach mach $testcase_machs {
|
| 223 |
|
|
if { [lsearch $requested_machs $mach] < 0 } {
|
| 224 |
|
|
verbose -log "Skipping $mach version of $name, not requested."
|
| 225 |
|
|
continue
|
| 226 |
|
|
}
|
| 227 |
|
|
|
| 228 |
|
|
verbose -log "Testing $name on machine $mach."
|
| 229 |
|
|
|
| 230 |
|
|
if ![info exists opts(as,$mach)] {
|
| 231 |
|
|
set opts(as,$mach) $opts(as)
|
| 232 |
|
|
}
|
| 233 |
|
|
|
| 234 |
|
|
set comp_output [target_assemble $sourcefile ${name}.o "$opts(as,$mach) -I$srcdir/$subdir"]
|
| 235 |
|
|
|
| 236 |
|
|
if ![string match "" $comp_output] {
|
| 237 |
|
|
verbose -log "$comp_output" 3
|
| 238 |
|
|
fail "$mach $testname"
|
| 239 |
|
|
continue
|
| 240 |
|
|
}
|
| 241 |
|
|
|
| 242 |
|
|
if ![info exists opts(ld,$mach)] {
|
| 243 |
|
|
set opts(ld,$mach) $opts(ld)
|
| 244 |
|
|
}
|
| 245 |
|
|
|
| 246 |
|
|
set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]
|
| 247 |
|
|
|
| 248 |
|
|
if ![string match "" $comp_output] {
|
| 249 |
|
|
verbose -log "$comp_output" 3
|
| 250 |
|
|
fail "$mach $testname"
|
| 251 |
|
|
continue
|
| 252 |
|
|
}
|
| 253 |
|
|
|
| 254 |
|
|
# If no machine specific options, default to the general version.
|
| 255 |
|
|
if ![info exists opts(sim,$mach)] {
|
| 256 |
|
|
set opts(sim,$mach) $opts(sim)
|
| 257 |
|
|
}
|
| 258 |
|
|
|
| 259 |
|
|
# Build the options argument.
|
| 260 |
|
|
set options ""
|
| 261 |
|
|
if { "$opts(timeout)" != "" } {
|
| 262 |
|
|
set options "$options timeout=$opts(timeout)"
|
| 263 |
|
|
}
|
| 264 |
|
|
|
| 265 |
|
|
set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
|
| 266 |
|
|
set status [lindex $result 0]
|
| 267 |
|
|
set output [lindex $result 1]
|
| 268 |
|
|
|
| 269 |
|
|
if { "$status" == "pass" } {
|
| 270 |
|
|
if { "$opts(xerror)" == "no" } {
|
| 271 |
|
|
if [string match $opts(output) $output] {
|
| 272 |
|
|
pass "$mach $testname"
|
| 273 |
|
|
} else {
|
| 274 |
|
|
verbose -log "output: $output" 3
|
| 275 |
|
|
verbose -log "pattern: $opts(output)" 3
|
| 276 |
|
|
fail "$mach $testname"
|
| 277 |
|
|
}
|
| 278 |
|
|
} else {
|
| 279 |
|
|
verbose -log "`pass' return code when expecting failure" 3
|
| 280 |
|
|
fail "$mach $testname"
|
| 281 |
|
|
}
|
| 282 |
|
|
} elseif { "$status" == "fail" } {
|
| 283 |
|
|
if { "$opts(xerror)" == "no" } {
|
| 284 |
|
|
fail "$mach $testname"
|
| 285 |
|
|
} else {
|
| 286 |
|
|
if [string match $opts(output) $output] {
|
| 287 |
|
|
pass "$mach $testname"
|
| 288 |
|
|
} else {
|
| 289 |
|
|
verbose -log "output: $output" 3
|
| 290 |
|
|
verbose -log "pattern: $opts(output)" 3
|
| 291 |
|
|
fail "$mach $testname"
|
| 292 |
|
|
}
|
| 293 |
|
|
}
|
| 294 |
|
|
} else {
|
| 295 |
|
|
$status "$mach $testname"
|
| 296 |
|
|
}
|
| 297 |
|
|
}
|
| 298 |
|
|
}
|
| 299 |
|
|
|
| 300 |
|
|
# Subroutine of run_sim_test to process options in FILE.
|
| 301 |
|
|
|
| 302 |
|
|
proc slurp_options { file } {
|
| 303 |
|
|
if [catch { set f [open $file r] } x] {
|
| 304 |
|
|
#perror "couldn't open `$file': $x"
|
| 305 |
|
|
perror "$x"
|
| 306 |
|
|
return -1
|
| 307 |
|
|
}
|
| 308 |
|
|
set opt_array {}
|
| 309 |
|
|
# whitespace expression
|
| 310 |
|
|
set ws {[ ]*}
|
| 311 |
|
|
set nws {[^ ]*}
|
| 312 |
|
|
# whitespace is ignored anywhere except within the options list;
|
| 313 |
|
|
# option names are alphabetic only
|
| 314 |
|
|
set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
|
| 315 |
|
|
# Allow comment as first line of file.
|
| 316 |
|
|
set firstline 1
|
| 317 |
|
|
while { [gets $f line] != -1 } {
|
| 318 |
|
|
set line [string trim $line]
|
| 319 |
|
|
# Whitespace here is space-tab.
|
| 320 |
|
|
if [regexp $pat $line xxx opt_name opt_machs opt_val] {
|
| 321 |
|
|
# match!
|
| 322 |
|
|
lappend opt_array [list $opt_name $opt_machs $opt_val]
|
| 323 |
|
|
} else {
|
| 324 |
|
|
if { ! $firstline } {
|
| 325 |
|
|
break
|
| 326 |
|
|
}
|
| 327 |
|
|
}
|
| 328 |
|
|
set firstline 0
|
| 329 |
|
|
}
|
| 330 |
|
|
close $f
|
| 331 |
|
|
return $opt_array
|
| 332 |
|
|
}
|
