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 # output: program output pattern to match with string-match
 165 # xerror: program is expected to return with a "failure" exit code
 166 # If `output' is not specified, the program must output "pass" if !xerror or
 167 # "fail" if xerror.
 168 # The parens in "optname()" are optional if the specification is for all machs.
 169
 170 proc run_sim_test { name requested_machs } {
 171     global subdir srcdir
 172     global SIMFLAGS
 173     global opts
 174     global cpu_option
 175     global global_as_options
 176     global global_ld_options
 177     global global_sim_options
 178
 179     if [string match "*/*" $name] {
 180         set file $name
 181         set name [file tail $name]
 182     } else {
 183         set file "$srcdir/$subdir/$name"
 184     }
 185
 186     set opt_array [slurp_options "${file}"]
 187     if { $opt_array == -1 } {
 188         unresolved $subdir/$name
 189         return
 190     }
 191     # Clear default options
 192     set opts(as) ""
 193     set opts(ld) ""
 194     set opts(sim) ""
 195     set opts(output) ""
 196     set opts(mach) ""
 197     set opts(timeout) ""
 198     set opts(xerror) "no"
 199
 200     if ![info exists global_as_options] {
 201         set global_as_options ""
 202     }
 203     if ![info exists global_ld_options] {
 204         set global_ld_options ""
 205     }
 206     if ![info exists global_sim_options] {
 207         set global_sim_options ""
 208     }
 209
 210     # Clear any machine specific options specified in a previous test case
 211     foreach m $requested_machs {
 212         if [info exists opts(as,$m)] {
 213             unset opts(as,$m)
 214         }
 215         if [info exists opts(ld,$m)] {
 216             unset opts(ld,$m)
 217         }
 218         if [info exists opts(sim,$m)] {
 219             unset opts(sim,$m)
 220         }
 221     }
 222
 223     foreach i $opt_array {
 224         set opt_name [lindex $i 0]
 225         set opt_machs [lindex $i 1]
 226         set opt_val [lindex $i 2]
 227         if ![info exists opts($opt_name)] {
 228             perror "unknown option $opt_name in file $file"
 229             unresolved $subdir/$name
 230             return
 231         }
 232         # Multiple "output" specifications concatenate, they don't override.
 233         if { $opt_name == "output" } {
 234             set opt_val "$opts(output)$opt_val"
 235         }
 236         foreach m $opt_machs {
 237             set opts($opt_name,$m) $opt_val
 238         }
 239         if { "$opt_machs" == "" } {
 240             set opts($opt_name) $opt_val
 241         }
 242     }
 243
 244     set testname $name
 245     set sourcefile $file
 246     if { $opts(output) == "" } {
 247         if { "$opts(xerror)" == "no" } {
 248             set opts(output) "pass\n"
 249         } else {
 250             set opts(output) "fail\n"
 251         }
 252     }
 253     # Change \n sequences to newline chars.
 254     regsub -all "\\\\n" $opts(output) "\n" opts(output)
 255
 256     set testcase_machs $opts(mach)
 257     if { "$testcase_machs" == "all" } {
 258         set testcase_machs $requested_machs
 259     }
 260
 261     foreach mach $testcase_machs {
 262         if { [lsearch $requested_machs $mach] < 0 } {
 263             verbose -log "Skipping $mach version of $name, not requested."
 264             continue
 265         }
 266
 267         verbose -log "Testing $name on machine $mach."
 268
 269         if ![info exists opts(as,$mach)] {
 270             set opts(as,$mach) $opts(as)
 271         }
 272
 273         set as_options "$opts(as,$mach) -I$srcdir/$subdir"
 274         if [info exists cpu_option] {
 275             set as_options "$as_options $cpu_option=$mach"
 276         }
 277         set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
 278
 279         if ![string match "" $comp_output] {
 280             verbose -log "$comp_output" 3
 281             fail "$mach $testname (assembling)"
 282             continue
 283         }
 284
 285         if ![info exists opts(ld,$mach)] {
 286             set opts(ld,$mach) $opts(ld)
 287         }
 288
 289         set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
 290
 291         if ![string match "" $comp_output] {
 292             verbose -log "$comp_output" 3
 293             fail "$mach $testname (linking)"
 294             continue
 295         }
 296
 297         # If no machine specific options, default to the general version.
 298         if ![info exists opts(sim,$mach)] {
 299             set opts(sim,$mach) $opts(sim)
 300         }
 301
 302         # Build the options argument.
 303         set options ""
 304         if { "$opts(timeout)" != "" } {
 305             set options "$options timeout=$opts(timeout)"
 306         }
 307
 308         set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "" "" "$options"]
 309         set status [lindex $result 0]
 310         set output [lindex $result 1]
 311
 312         if { "$status" == "pass" } {
 313             if { "$opts(xerror)" == "no" } {
 314                 if [string match $opts(output) $output] {
 315                     pass "$mach $testname"
 316                     file delete ${name}.o ${name}.x
 317                 } else {
 318                     verbose -log "output:  $output" 3
 319                     verbose -log "pattern: $opts(output)" 3
 320                     fail "$mach $testname (execution)"
 321                 }
 322             } else {
 323                 verbose -log "`pass' return code when expecting failure" 3
 324                 fail "$mach $testname (execution)"
 325             }
 326         } elseif { "$status" == "fail" } {
 327             if { "$opts(xerror)" == "no" } {
 328                 fail "$mach $testname (execution)"
 329             } else {
 330                 if [string match $opts(output) $output] {
 331                     pass "$mach $testname"
 332                     file delete ${name}.o ${name}.x
 333                 } else {
 334                     verbose -log "output:  $output" 3
 335                     verbose -log "pattern: $opts(output)" 3
 336                     fail "$mach $testname (execution)"
 337                 }
 338             }
 339         } else {
 340             $status "$mach $testname"
 341         }
 342     }
 343 }
 344
 345 # Subroutine of run_sim_test to process options in FILE.
 346
 347 proc slurp_options { file } {
 348     if [catch { set f [open $file r] } x] {
 349         #perror "couldn't open `$file': $x"
 350         perror "$x"
 351         return -1
 352     }
 353     set opt_array {}
 354     # whitespace expression
 355     set ws  {[  ]*}
 356     set nws {[^         ]*}
 357     # whitespace is ignored anywhere except within the options list;
 358     # option names are alphabetic only
 359     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
 360     # Allow arbitrary lines until the first option is seen.
 361     set seen_opt 0
 362     while { [gets $f line] != -1 } {
 363         set line [string trim $line]
 364         # Whitespace here is space-tab.
 365         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 366             # match!
 367             lappend opt_array [list $opt_name $opt_machs $opt_val]
 368             set seen_opt 1
 369         } else {
 370             if { $seen_opt } {
 371                 break
 372             }
 373         }
 374     }
 375     close $f
 376     return $opt_array
 377 }