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