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     send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"
 113
 114     if { "$redir" == "" } {
 115         remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
 116     } else {
 117         remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
 118     }
 119     set result [remote_wait host $testcase_timeout]
 120
 121     set return_code [lindex $result 0]
 122     set output [lindex $result 1]
 123     # Remove the \r part of "\r\n" so we don't break all the patterns
 124     # we want to match.
 125     regsub -all -- "\r" $output "" output
 126
 127     if [is_remote host] {
 128         # clean up after ourselves.
 129         remote_file host delete $prog
 130     }
 131
 132     # ??? Not sure the test for pass/fail is right.
 133     # We just care that the simulator ran correctly, not whether the simulated
 134     # program return 0 or non-zero from `main'.
 135     set status fail
 136     if { $return_code == 0 } {
 137         set status pass
 138     }
 139
 140     return [list $status $output]
 141 }
 142
 143 # Run testcase NAME.
 144 # NAME is either a fully specified file name, or just the file name in which
 145 # case $srcdir/$subdir will be prepended.
 146 # REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
 147 # for the specified machine(s), it is ignored.
 148 # Typically REQUESTED_MACHS contains just one element, it is up to the caller
 149 # to iterate over the desired machine variants.
 150 #
 151 # The file can contain options in the form "# option(mach list): value".
 152 # Possibilities:
 153 # mach: [all | machine names]
 154 # as[(mach-list)]: <assembler options>
 155 # ld[(mach-list)]: <linker options>
 156 # sim[(mach-list)]: <simulator options>
 157 # output[(mach-list)]: program output pattern to match with string-match
 158 # xerror[(mach-list)]: program is expected to return with a "failure" exit code
 159 # If `output' is not specified, the program must output "pass" if !xerror or
 160 # "fail" if xerror.
 161 # The parens in "optname()" are optional if the specification is for all machs.
 162
 163 proc run_sim_test { name requested_machs } {
 164     global subdir srcdir
 165     global SIMFLAGS
 166     global opts
 167
 168     if [string match "*/*" $name] {
 169         set file $name
 170         set name [file tail $name]
 171     } else {
 172         set file "$srcdir/$subdir/$name"
 173     }
 174
 175     set opt_array [slurp_options "${file}"]
 176     if { $opt_array == -1 } {
 177         unresolved $subdir/$name
 178         return
 179     }
 180     set opts(as) {}
 181     set opts(ld) {}
 182     set opts(sim) {}
 183     set opts(output) {}
 184     set opts(mach) {}
 185     set opts(timeout) {}
 186     set opts(xerror) "no"
 187
 188     foreach i $opt_array {
 189         set opt_name [lindex $i 0]
 190         set opt_machs [lindex $i 1]
 191         set opt_val [lindex $i 2]
 192         if ![info exists opts($opt_name)] {
 193             perror "unknown option $opt_name in file $file"
 194             unresolved $subdir/$name
 195             return
 196         }
 197         foreach m $opt_machs {
 198             set opts($opt_name,$m) $opt_val
 199         }
 200         if { "$opt_machs" == "" } {
 201             set opts($opt_name) $opt_val
 202         }
 203     }
 204
 205     set testname $name
 206     set sourcefile $file
 207     if { $opts(output) == "" } {
 208         if { "$opts(xerror)" == "no" } {
 209             set opts(output) "pass\n"
 210         } else {
 211             set opts(output) "fail\n"
 212         }
 213     }
 214     # Change \n sequences to newline chars.
 215     regsub -all "\\\\n" $opts(output) "\n" opts(output)
 216
 217     set testcase_machs $opts(mach)
 218     if { "$testcase_machs" == "all" } {
 219         set testcase_machs $requested_machs
 220     }
 221
 222     foreach mach $testcase_machs {
 223         if { [lsearch $requested_machs $mach] < 0 } {
 224             verbose -log "Skipping $mach version of $name, not requested."
 225             continue
 226         }
 227
 228         verbose -log "Testing $name on machine $mach."
 229
 230         if ![info exists opts(as,$mach)] {
 231             set opts(as,$mach) $opts(as)
 232         }
 233
 234         set comp_output [target_assemble $sourcefile ${name}.o "$opts(as,$mach) -I$srcdir/$subdir"]
 235
 236         if ![string match "" $comp_output] {
 237             verbose -log "$comp_output" 3
 238             fail "$mach $testname"
 239             continue
 240         }
 241
 242         if ![info exists opts(ld,$mach)] {
 243             set opts(ld,$mach) $opts(ld)
 244         }
 245
 246         set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]
 247
 248         if ![string match "" $comp_output] {
 249             verbose -log "$comp_output" 3
 250             fail "$mach $testname"
 251             continue
 252         }
 253
 254         # If no machine specific options, default to the general version.
 255         if ![info exists opts(sim,$mach)] {
 256             set opts(sim,$mach) $opts(sim)
 257         }
 258
 259         # Build the options argument.
 260         set options ""
 261         if { "$opts(timeout)" != "" } {
 262             set options "$options timeout=$opts(timeout)"
 263         }
 264
 265         set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
 266         set status [lindex $result 0]
 267         set output [lindex $result 1]
 268
 269         if { "$status" == "pass" } {
 270             if { "$opts(xerror)" == "no" } {
 271                 if [string match $opts(output) $output] {
 272                     pass "$mach $testname"
 273                 } else {
 274                     verbose -log "output:  $output" 3
 275                     verbose -log "pattern: $opts(output)" 3
 276                     fail "$mach $testname"
 277                 }
 278             } else {
 279                 verbose -log "`pass' return code when expecting failure" 3
 280                 fail "$mach $testname"
 281             }
 282         } elseif { "$status" == "fail" } {
 283             if { "$opts(xerror)" == "no" } {
 284                 fail "$mach $testname"
 285             } else {
 286                 if [string match $opts(output) $output] {
 287                     pass "$mach $testname"
 288                 } else {
 289                     verbose -log "output:  $output" 3
 290                     verbose -log "pattern: $opts(output)" 3
 291                     fail "$mach $testname"
 292                 }
 293             }
 294         } else {
 295             $status "$mach $testname"
 296         }
 297     }
 298 }
 299
 300 # Subroutine of run_sim_test to process options in FILE.
 301
 302 proc slurp_options { file } {
 303     if [catch { set f [open $file r] } x] {
 304         #perror "couldn't open `$file': $x"
 305         perror "$x"
 306         return -1
 307     }
 308     set opt_array {}
 309     # whitespace expression
 310     set ws  {[  ]*}
 311     set nws {[^         ]*}
 312     # whitespace is ignored anywhere except within the options list;
 313     # option names are alphabetic only
 314     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
 315     # Allow comment as first line of file.
 316     set firstline 1
 317     while { [gets $f line] != -1 } {
 318         set line [string trim $line]
 319         # Whitespace here is space-tab.
 320         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 321             # match!
 322             lappend opt_array [list $opt_name $opt_machs $opt_val]
 323         } else {
 324             if { ! $firstline } {
 325                 break
 326             }
 327         }
 328         set firstline 0
 329     }
 330     close $f
 331     return $opt_array
 332 }