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