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     return ""
  16 }
  17
  18 # Print the version of the simulator being tested.
  19 # Required by dejagnu.
  20
  21 proc 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
  30 proc 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
  61 proc 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
  92     if [is_remote host] {
  93         set prog [remote_download host $prog]
  94         if { $prog == "" } {
  95             error "download failed"
  96             return -1
  97         }
  98     }
  99
 100     set board [target_info name]
 101     if [board_info $board exists sim,options] {
 102         set always_opts [board_info $board sim,options]
 103     } else {
 104         set always_opts ""
 105     }
 106
 107     # FIXME: this works for UNIX only
 108     if { "$testcase_env" != "" } {
 109         set sim "env $testcase_env $sim"
 110     }
 111
 112     if { [board_info target sim,protocol] == "sid" } {
 113         set cmd ""
 114         set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\""
 115     } else {
 116         set cmd "$prog"
 117     }
 118
 119     send_log "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts\n"
 120
 121     if { "$redir" == "" } {
 122         remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts"
 123     } else {
 124         remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts $redir" writeonly
 125     }
 126     set result [remote_wait host $testcase_timeout]
 127
 128     set return_code [lindex $result 0]
 129     set output [lindex $result 1]
 130     # Remove the \r part of "\r\n" so we don't break all the patterns
 131     # we want to match.
 132     regsub -all -- "\r" $output "" output
 133
 134     if [is_remote host] {
 135         # clean up after ourselves.
 136         remote_file host delete $prog
 137     }
 138
 139     # ??? Not sure the test for pass/fail is right.
 140     # We just care that the simulator ran correctly, not whether the simulated
 141     # program return 0 or non-zero from `main'.
 142     set status fail
 143     if { $return_code == 0 } {
 144         set status pass
 145     }
 146
 147     return [list $status $output]
 148 }
 149
 150 # Run testcase NAME.
 151 # NAME is either a fully specified file name, or just the file name in which
 152 # case $srcdir/$subdir will be prepended.
 153 # REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
 154 # for the specified machine(s), it is ignored.
 155 # Typically REQUESTED_MACHS contains just one element, it is up to the caller
 156 # to iterate over the desired machine variants.
 157 #
 158 # The file can contain options in the form "# option(mach list): value".
 159 # Possibilities:
 160 # mach: [all | machine names]
 161 # as[(mach-list)]: <assembler options>
 162 # ld[(mach-list)]: <linker options>
 163 # sim[(mach-list)]: <simulator options>
 164 # progopts: <arguments to the program being simulated>
 165 # output: program output pattern to match with string-match
 166 # xerror: program is expected to return with a "failure" exit code
 167 # xfail: <PRMS-opt> <target-triplets-where-test-fails>
 168 # kfail: <PRMS> <target-triplets-where-test-fails>
 169 # If `output' is not specified, the program must output "pass" if !xerror or
 170 # "fail" if xerror.
 171 # The parens in "optname()" are optional if the specification is for all machs.
 172 # Multiple "output", "xfail" and "kfail" options concatenate.
 173 # The xfail and kfail arguments are space-separated target triplets and PRIDs.
 174 # There must be a PRMS (bug report ID) specified for kfail, while it's
 175 # optional for xfail.
 176
 177 proc run_sim_test { name requested_machs } {
 178     global subdir srcdir
 179     global SIMFLAGS
 180     global opts
 181     global cpu_option
 182     global global_as_options
 183     global global_ld_options
 184     global global_sim_options
 185
 186     if [string match "*/*" $name] {
 187         set file $name
 188         set name [file tail $name]
 189     } else {
 190         set file "$srcdir/$subdir/$name"
 191     }
 192
 193     set opt_array [slurp_options "${file}"]
 194     if { $opt_array == -1 } {
 195         unresolved $subdir/$name
 196         return
 197     }
 198     # Clear default options
 199     set opts(as) ""
 200     set opts(ld) ""
 201     set opts(progopts) ""
 202     set opts(sim) ""
 203     set opts(output) ""
 204     set opts(mach) ""
 205     set opts(timeout) ""
 206     set opts(xerror) "no"
 207     set opts(xfail) ""
 208     set opts(kfail) ""
 209
 210     if ![info exists global_as_options] {
 211         set global_as_options ""
 212     }
 213     if ![info exists global_ld_options] {
 214         set global_ld_options ""
 215     }
 216     if ![info exists global_sim_options] {
 217         set global_sim_options ""
 218     }
 219
 220     # Clear any machine specific options specified in a previous test case
 221     foreach m $requested_machs {
 222         if [info exists opts(as,$m)] {
 223             unset opts(as,$m)
 224         }
 225         if [info exists opts(ld,$m)] {
 226             unset opts(ld,$m)
 227         }
 228         if [info exists opts(sim,$m)] {
 229             unset opts(sim,$m)
 230         }
 231     }
 232
 233     foreach i $opt_array {
 234         set opt_name [lindex $i 0]
 235         set opt_machs [lindex $i 1]
 236         set opt_val [lindex $i 2]
 237         if ![info exists opts($opt_name)] {
 238             perror "unknown option $opt_name in file $file"
 239             unresolved $subdir/$name
 240             return
 241         }
 242         # Multiple "output" specifications concatenate, they don't override.
 243         if { $opt_name == "output" } {
 244             set opt_val "$opts(output)$opt_val"
 245         }
 246         # Similar with "xfail" and "kfail", but arguments are space-separated.
 247         if { $opt_name == "xfail" || $opt_name == "kfail" } {
 248             set opt_val "$opts($opt_name) $opt_val"
 249         }
 250
 251         foreach m $opt_machs {
 252             set opts($opt_name,$m) $opt_val
 253         }
 254         if { "$opt_machs" == "" } {
 255             set opts($opt_name) $opt_val
 256         }
 257     }
 258
 259     set testname $name
 260     set sourcefile $file
 261     if { $opts(output) == "" } {
 262         if { "$opts(xerror)" == "no" } {
 263             set opts(output) "pass\n"
 264         } else {
 265             set opts(output) "fail\n"
 266         }
 267     }
 268     # Change \n sequences to newline chars.
 269     regsub -all "\\\\n" $opts(output) "\n" opts(output)
 270
 271     set testcase_machs $opts(mach)
 272     if { "$testcase_machs" == "all" } {
 273         set testcase_machs $requested_machs
 274     }
 275
 276     foreach mach $testcase_machs {
 277         if { [lsearch $requested_machs $mach] < 0 } {
 278             verbose -log "Skipping $mach version of $name, not requested."
 279             continue
 280         }
 281
 282         verbose -log "Testing $name on machine $mach."
 283
 284         # Time to setup xfailures and kfailures.
 285         if { "$opts(xfail)" != "" } {
 286             verbose -log "xfail: $opts(xfail)"
 287             # Using eval to make $opts(xfail) appear as individual
 288             # arguments.
 289             eval setup_xfail $opts(xfail)
 290         }
 291         if { "$opts(kfail)" != "" } {
 292             verbose -log "kfail: $opts(kfail)"
 293             eval setup_kfail $opts(kfail)
 294         }
 295
 296         if ![info exists opts(as,$mach)] {
 297             set opts(as,$mach) $opts(as)
 298         }
 299
 300         set as_options "$opts(as,$mach) -I$srcdir/$subdir"
 301         if [info exists cpu_option] {
 302             set as_options "$as_options $cpu_option=$mach"
 303         }
 304         set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
 305
 306         if ![string match "" $comp_output] {
 307             verbose -log "$comp_output" 3
 308             fail "$mach $testname (assembling)"
 309             continue
 310         }
 311
 312         if ![info exists opts(ld,$mach)] {
 313             set opts(ld,$mach) $opts(ld)
 314         }
 315
 316         set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
 317
 318         if ![string match "" $comp_output] {
 319             verbose -log "$comp_output" 3
 320             fail "$mach $testname (linking)"
 321             continue
 322         }
 323
 324         # If no machine specific options, default to the general version.
 325         if ![info exists opts(sim,$mach)] {
 326             set opts(sim,$mach) $opts(sim)
 327         }
 328
 329         # Build the options argument.
 330         set options ""
 331         if { "$opts(timeout)" != "" } {
 332             set options "$options timeout=$opts(timeout)"
 333         }
 334
 335         set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "$opts(progopts)" "" "$options"]
 336         set status [lindex $result 0]
 337         set output [lindex $result 1]
 338
 339         if { "$status" == "pass" } {
 340             if { "$opts(xerror)" == "no" } {
 341                 if [string match $opts(output) $output] {
 342                     pass "$mach $testname"
 343                     file delete ${name}.o ${name}.x
 344                 } else {
 345                     verbose -log "output:  $output" 3
 346                     verbose -log "pattern: $opts(output)" 3
 347                     fail "$mach $testname (execution)"
 348                 }
 349             } else {
 350                 verbose -log "`pass' return code when expecting failure" 3
 351                 fail "$mach $testname (execution)"
 352             }
 353         } elseif { "$status" == "fail" } {
 354             if { "$opts(xerror)" == "no" } {
 355                 fail "$mach $testname (execution)"
 356             } else {
 357                 if [string match $opts(output) $output] {
 358                     pass "$mach $testname"
 359                     file delete ${name}.o ${name}.x
 360                 } else {
 361                     verbose -log "output:  $output" 3
 362                     verbose -log "pattern: $opts(output)" 3
 363                     fail "$mach $testname (execution)"
 364                 }
 365             }
 366         } else {
 367             $status "$mach $testname"
 368         }
 369     }
 370 }
 371
 372 # Subroutine of run_sim_test to process options in FILE.
 373
 374 proc slurp_options { file } {
 375     if [catch { set f [open $file r] } x] {
 376         #perror "couldn't open `$file': $x"
 377         perror "$x"
 378         return -1
 379     }
 380     set opt_array {}
 381     # whitespace expression
 382     set ws  {[  ]*}
 383     set nws {[^         ]*}
 384     # whitespace is ignored anywhere except within the options list;
 385     # option names are alphabetic only
 386     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
 387     # Allow arbitrary lines until the first option is seen.
 388     set seen_opt 0
 389     while { [gets $f line] != -1 } {
 390         set line [string trim $line]
 391         # Whitespace here is space-tab.
 392         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 393             # match!
 394             lappend opt_array [list $opt_name $opt_machs $opt_val]
 395             set seen_opt 1
 396         } else {
 397             if { $seen_opt } {
 398                 break
 399             }
 400         }
 401     }
 402     close $f
 403     return $opt_array
 404 }