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