sim/testsuite/lib/sim-defs.exp

   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.]
   7 set sim_path "unknown-run"
   8
   9 # Initialize the testrun.
  10 # Required by dejagnu.
  11
  12 proc 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
  32 proc 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
  41 proc 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
  72 proc 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
 198 proc 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
 426 proc 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 }