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