1# 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.] 6set sim_path "unknown-run" 7 8# Initialize the testrun. 9# Required by dejagnu. 10 11proc 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 21proc 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 30proc 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 61proc 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)]: <assembler options> 171# ld[(mach-list)]: <linker options> 172# cc[(mach-list)]: <compiler options> 173# sim[(mach-list)]: <simulator options> 174# progopts: <arguments to the program being simulated> 175# output: program output pattern to match with string-match 176# xerror: program is expected to return with a "failure" exit code 177# xfail: <PRMS-opt> <target-triplets-where-test-fails> 178# kfail: <PRMS> <target-triplets-where-test-fails> 179# If `output' is not specified, the program must output "pass" if !xerror or 180# "fail" if xerror. 181# The parens in "optname()" are optional if the specification is for all machs. 182# Multiple "output", "xfail" and "kfail" options concatenate. 183# The xfail and kfail arguments are space-separated target triplets and PRIDs. 184# There must be a PRMS (bug report ID) specified for kfail, while it's 185# optional for xfail. 186 187proc run_sim_test { name requested_machs } { 188 global subdir srcdir 189 global SIMFLAGS 190 global opts 191 global cpu_option 192 global global_as_options 193 global global_ld_options 194 global global_cc_options 195 global global_sim_options 196 197 if [string match "*/*" $name] { 198 set file $name 199 set name [file tail $name] 200 } else { 201 set file "$srcdir/$subdir/$name" 202 } 203 204 set opt_array [slurp_options "${file}"] 205 if { $opt_array == -1 } { 206 unresolved $subdir/$name 207 return 208 } 209 # Clear default options 210 set opts(as) "" 211 set opts(ld) "" 212 set opts(cc) "" 213 set opts(progopts) "" 214 set opts(sim) "" 215 set opts(output) "" 216 set opts(mach) "" 217 set opts(timeout) "" 218 set opts(xerror) "no" 219 set opts(xfail) "" 220 set opts(kfail) "" 221 222 if ![info exists global_as_options] { 223 set global_as_options "" 224 } 225 if ![info exists global_ld_options] { 226 set global_ld_options "" 227 } 228 if ![info exists global_cc_options] { 229 set global_cc_options "" 230 } 231 if ![info exists global_sim_options] { 232 set global_sim_options "" 233 } 234 235 # Clear any machine specific options specified in a previous test case 236 foreach m $requested_machs { 237 if [info exists opts(as,$m)] { 238 unset opts(as,$m) 239 } 240 if [info exists opts(ld,$m)] { 241 unset opts(ld,$m) 242 } 243 if [info exists opts(cc,$m)] { 244 unset opts(cc,$m) 245 } 246 if [info exists opts(sim,$m)] { 247 unset opts(sim,$m) 248 } 249 } 250 251 foreach i $opt_array { 252 set opt_name [lindex $i 0] 253 set opt_machs [lindex $i 1] 254 set opt_val [lindex $i 2] 255 if ![info exists opts($opt_name)] { 256 perror "unknown option $opt_name in file $file" 257 unresolved $subdir/$name 258 return 259 } 260 # Multiple "output" specifications concatenate, they don't override. 261 if { $opt_name == "output" } { 262 set opt_val "$opts(output)$opt_val" 263 } 264 # Similar with "xfail" and "kfail", but arguments are space-separated. 265 if { $opt_name == "xfail" || $opt_name == "kfail" } { 266 set opt_val "$opts($opt_name) $opt_val" 267 } 268 269 foreach m $opt_machs { 270 set opts($opt_name,$m) $opt_val 271 } 272 if { "$opt_machs" == "" } { 273 set opts($opt_name) $opt_val 274 } 275 } 276 277 set testname $name 278 set sourcefile $file 279 if { $opts(output) == "" } { 280 if { "$opts(xerror)" == "no" } { 281 set opts(output) "pass\n" 282 } else { 283 set opts(output) "fail\n" 284 } 285 } 286 # Change \n sequences to newline chars. 287 regsub -all "\\\\n" $opts(output) "\n" opts(output) 288 289 set testcase_machs $opts(mach) 290 if { "$testcase_machs" == "all" } { 291 set testcase_machs $requested_machs 292 } 293 294 foreach mach $testcase_machs { 295 if { [lsearch $requested_machs $mach] < 0 } { 296 verbose -log "Skipping $mach version of $name, not requested." 297 continue 298 } 299 300 verbose -log "Testing $name on machine $mach." 301 302 # Time to setup xfailures and kfailures. 303 if { "$opts(xfail)" != "" } { 304 verbose -log "xfail: $opts(xfail)" 305 # Using eval to make $opts(xfail) appear as individual 306 # arguments. 307 eval setup_xfail $opts(xfail) 308 } 309 if { "$opts(kfail)" != "" } { 310 verbose -log "kfail: $opts(kfail)" 311 eval setup_kfail $opts(kfail) 312 } 313 314 if ![info exists opts(as,$mach)] { 315 set opts(as,$mach) $opts(as) 316 } 317 318 set as_options "$opts(as,$mach) -I$srcdir/$subdir" 319 if [info exists cpu_option] { 320 set as_options "$as_options $cpu_option=$mach" 321 } 322 regsub {(^ *| +)([^ ]+)} "$as_options $global_as_options" { -Wa,\2} c_as_options 323 324 if ![info exists opts(ld,$mach)] { 325 set opts(ld,$mach) $opts(ld) 326 } 327 regsub {(^ *| +)([^ ]+)} "$opts(ld,$mach) $global_ld_options" { -Wl,\2} c_ld_options 328 329 if ![info exists opts(cc,$mach)] { 330 set opts(cc,$mach) $opts(cc) 331 } 332 333 if [string match "*.c" $sourcefile] { 334 set comp_output [target_compile $sourcefile ${name}.x "executable" \ 335 [list "incdir=$srcdir/$subdir" "additional_flags=$c_as_options $c_ld_options $opts(cc,$mach) $global_cc_options"]] 336 set method "compiling/linking" 337 } else { 338 if [string match "*.S" $sourcefile] { 339 set comp_output [target_compile $sourcefile ${name}.o "object" \ 340 [list "incdir=$srcdir/$subdir" "additional_flags=$c_as_options"]] 341 set method "compiling" 342 } else { 343 set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"] 344 set method "assembling" 345 } 346 347 if ![string match "" $comp_output] { 348 verbose -log "$comp_output" 3 349 fail "$mach $testname (${method})" 350 continue 351 } 352 353 set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"] 354 set method "linking" 355 } 356 357 if ![string match "" $comp_output] { 358 verbose -log "$comp_output" 3 359 fail "$mach $testname (${method})" 360 continue 361 } 362 363 # If no machine specific options, default to the general version. 364 if ![info exists opts(sim,$mach)] { 365 set opts(sim,$mach) $opts(sim) 366 } 367 368 # Build the options argument. 369 set options "" 370 if { "$opts(timeout)" != "" } { 371 set options "$options timeout=$opts(timeout)" 372 } 373 374 set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "$opts(progopts)" "" "$options"] 375 set status [lindex $result 0] 376 set output [lindex $result 1] 377 378 if { "$status" == "pass" } { 379 if { "$opts(xerror)" == "no" } { 380 if [string match $opts(output) $output] { 381 pass "$mach $testname" 382 file delete ${name}.o ${name}.x 383 } else { 384 verbose -log "output: $output" 3 385 verbose -log "pattern: $opts(output)" 3 386 fail "$mach $testname (execution)" 387 } 388 } else { 389 verbose -log "`pass' return code when expecting failure" 3 390 fail "$mach $testname (execution)" 391 } 392 } elseif { "$status" == "fail" } { 393 if { "$opts(xerror)" == "no" } { 394 fail "$mach $testname (execution)" 395 } else { 396 if [string match $opts(output) $output] { 397 pass "$mach $testname" 398 file delete ${name}.o ${name}.x 399 } else { 400 verbose -log "output: $output" 3 401 verbose -log "pattern: $opts(output)" 3 402 fail "$mach $testname (execution)" 403 } 404 } 405 } else { 406 $status "$mach $testname" 407 } 408 } 409} 410 411# Subroutine of run_sim_test to process options in FILE. 412 413proc slurp_options { file } { 414 if [catch { set f [open $file r] } x] { 415 #perror "couldn't open `$file': $x" 416 perror "$x" 417 return -1 418 } 419 set opt_array {} 420 # whitespace expression 421 set ws {[ ]*} 422 set nws {[^ ]*} 423 # whitespace is ignored anywhere except within the options list; 424 # option names are alphabetic only 425 set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$" 426 # Allow arbitrary lines until the first option is seen. 427 set seen_opt 0 428 while { [gets $f line] != -1 } { 429 set line [string trim $line] 430 # Whitespace here is space-tab. 431 if [regexp $pat $line xxx opt_name opt_machs opt_val] { 432 # match! 433 lappend opt_array [list $opt_name $opt_machs $opt_val] 434 set seen_opt 1 435 } else { 436 if { $seen_opt } { 437 break 438 } 439 } 440 } 441 close $f 442 return $opt_array 443} 444