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 # At present REDIR must be "" or "> foo".
  44 #
  45 # The result is a list of two elements.
  46 # The first is one of pass/fail/etc.
  47 # The second is the program's output.
  48 #
  49 # This is different than the sim_load routine provided by
  50 # dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
  51 # simulator (not the simulated program, the simulator) with sim_load.
  52
  53 proc sim_run { prog sim_opts prog_opts redir env_vals } {
  54     global SIMFLAGS
  55
  56     # FIXME: The timeout value we actually want is a function of
  57     # host, target, and testcase.
  58     set testcase_timeout [board_info target sim_time_limit]
  59     if { "$testcase_timeout" == "" } {
  60         set testcase_timeout [board_info host testcase_timeout]
  61     }
  62     if { "$testcase_timeout" == "" } {
  63         set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
  64     }
  65
  66     set sim [board_info target sim]
  67
  68     # FIXME: this works for UNIX only
  69     if { "$env_vals" != "" } {
  70         set sim "env $env_vals $sim"
  71     }
  72
  73     if { "$redir" == "" } {
  74         remote_spawn host "$sim $SIMFLAGS $sim_opts $prog $prog_opts"
  75     } else {
  76         remote_spawn host "$sim $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
  77     }
  78     set result [remote_wait host $testcase_timeout]
  79
  80     set return_code [lindex $result 0]
  81     set output [lindex $result 1]
  82     # Remove the \r part of "\r\n" so we don't break all the patterns
  83     # we want to match.
  84     regsub -all -- "\r" $output "" output
  85
  86     # ??? Not sure the test for pass/fail is right.
  87     # We just care that the simulator ran correctly, not whether the simulated
  88     # program return 0 or non-zero from `main'.
  89     set status fail
  90     if { $return_code == 0 } {
  91         set status pass
  92     }
  93
  94     return [list $status $output]
  95 }
  96
  97 # Run testcase NAME.
  98 # NAME is either a fully specified file name, or just the file name in which
  99 # case $srcdir/$subdir will be prepended.
 100 # The file can contain options in the form "# option(mach list): value"
 101 # Possibilities:
 102 # mach(): machine names
 103 # as(mach): <assembler options>
 104 # ld(mach): <linker options>
 105 # sim(mach): <simulator options>
 106 # output(): program output pattern to match with string-match
 107 # If `output' is not specified, the program must output "pass".
 108
 109 proc run_sim_test { name } {
 110     global subdir srcdir
 111     global AS ASFLAGS LD LDFLAGS SIMFLAGS
 112     global opts
 113
 114     if [string match "*/*" $name] {
 115         set file $name
 116         set name [file tail $name]
 117     } else {
 118         set file "$srcdir/$subdir/$name"
 119     }
 120
 121     set opt_array [slurp_options "${file}"]
 122     if { $opt_array == -1 } {
 123         unresolved $subdir/$name
 124         return
 125     }
 126     set opts(as) {}
 127     set opts(ld) {}
 128     set opts(sim) {}
 129     set opts(output) {}
 130     set opts(mach) {}
 131
 132     foreach i $opt_array {
 133         set opt_name [lindex $i 0]
 134         set opt_machs [lindex $i 1]
 135         set opt_val [lindex $i 2]
 136         if ![info exists opts($opt_name)] {
 137             perror "unknown option $opt_name in file $file"
 138             unresolved $subdir/$name
 139             return
 140         }
 141         foreach m $opt_machs {
 142             set opts($opt_name,$m) $opt_val
 143         }
 144         if { "$opt_machs" == "" } {
 145             set opts($opt_name) $opt_val
 146         }
 147     }
 148
 149     set testname $name
 150     set sourcefile $file
 151     if { $opts(output) == "" } {
 152         set opts(output) "pass\n"
 153     }
 154
 155     foreach mach $opts(mach) {
 156         verbose "Testing $name on $mach."
 157
 158         if ![info exists opts(as,$mach)] {
 159             set opts(as,$mach) $opts(as)
 160         }
 161         send_log "$AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile\n"
 162         catch "exec $AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile" comp_output
 163
 164         if ![string match "" $comp_output] {
 165             verbose -log "$comp_output" 3
 166             fail "$mach $testname"
 167             continue
 168         }
 169
 170         if ![info exists opts(ld,$mach)] {
 171             set opts(ld,$mach) $opts(ld)
 172         }
 173         send_log "$LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o\n"
 174         catch "exec $LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o" comp_output
 175
 176         if ![string match "" $comp_output] {
 177             verbose -log "$comp_output" 3
 178             fail "$mach $testname"
 179             continue
 180         }
 181
 182         # If no machine specific options, default to the general version.
 183         if ![info exists opts(sim,$mach)] {
 184             set opts(sim,$mach) $opts(sim)
 185         }
 186
 187         set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" ""]
 188         set status [lindex $result 0]
 189         set output [lindex $result 1]
 190
 191         if { "$status" == "pass" } {
 192             if ![string match $opts(output) $output] {
 193                 verbose -log "output:  $output" 3
 194                 verbose -log "pattern: $opts(output)" 3
 195             }
 196         }
 197
 198         $status "$mach $testname"
 199     }
 200 }
 201
 202 # Subroutine of run_sim_test to process options in FILE.
 203
 204 proc slurp_options { file } {
 205     if [catch { set f [open $file r] } x] {
 206         #perror "couldn't open `$file': $x"
 207         perror "$x"
 208         return -1
 209     }
 210     set opt_array {}
 211     # whitespace expression
 212     set ws  {[  ]*}
 213     set nws {[^         ]*}
 214     # whitespace is ignored anywhere except within the options list;
 215     # option names are alphabetic only
 216     set pat "^#${ws}(\[a-zA-Z\]*)\\((.*)\\)$ws:${ws}(.*)$ws\$"
 217     # Allow comment as first line of file.
 218     set firstline 1
 219     while { [gets $f line] != -1 } {
 220         set line [string trim $line]
 221         # Whitespace here is space-tab.
 222         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 223             # match!
 224             lappend opt_array [list $opt_name $opt_machs $opt_val]
 225         } else {
 226             if { ! $firstline } {
 227                 break
 228             }
 229         }
 230         set firstline 0
 231     }
 232     close $f
 233     return $opt_array
 234 }