sim/testsuite/lib/sim-defs.exp

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