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