sim/testsuite/lib/sim-defs.exp

   1 # Simulator dejagnu utilities.
   2
   3 # Print the version of the simulator being tested.
   4 # Required by dejagnu.
   5
   6 proc sim_version {} {
   7     set version 0.5
   8     set program [board_info target sim]
   9     clone_output "$program $version\n"
  10 }
  11
  12 # Cover function to target_compile.
  13 # Copied from gdb_compile.
  14
  15 proc sim_compile { source dest type options } {
  16     set result [target_compile $source $dest $type $options]
  17     regsub "\[\r\n\]*$" "$result" "" result
  18     regsub "^\[\r\n\]*" "$result" "" result
  19     if { $result != "" } {
  20         clone_output "sim compile failed, $result"
  21     }
  22     return $result
  23 }
  24
  25 # Run a program on the simulator.
  26 # Required by dejagnu (at least ${tool}_run used to be).
  27 # FIXME: What should we do with `redir'?
  28 # The result is a list of two elements.
  29 # The first is one of pass/fail/etc.
  30 # The second is the program's output.
  31 #
  32 # This is different than the sim_load routine provided by
  33 # dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
  34 # simulator (not the simulated program, the simulator) with sim_load.
  35
  36 proc sim_run { prog sim_opts redir } {
  37     global SIMFLAGS
  38
  39     # FIXME: The timeout value we actually want is a function of
  40     # host, target, and testcase.
  41     set testcase_timeout [board_info target sim_time_limit]
  42     if { "$testcase_timeout" == "" } {
  43         set testcase_timeout [board_info host testcase_timeout]
  44     }
  45     if { "$testcase_timeout" == "" } {
  46         set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
  47     }
  48
  49     set sim [board_info target sim]
  50
  51     remote_spawn host "$sim $SIMFLAGS $sim_opts $prog"
  52     set result [remote_wait host $testcase_timeout]
  53
  54     set return_code [lindex $result 0]
  55     set output [lindex $result 1]
  56     # Remove the \r part of "\r\n" so we don't break all the patterns
  57     # we want to match.
  58     regsub -all -- "\r" $output "" output
  59
  60     # ??? Not sure the test for pass/fail is right.
  61     # We just care that the simulator ran correctly, not whether the simulated
  62     # program return 0 or non-zero from `main'.
  63     set status fail
  64     if { $return_code == 0 } {
  65         set status pass
  66     }
  67
  68     return [list $status $output]
  69 }
  70
  71 # Initialize the testrun.
  72 # Required by dejagnu.
  73
  74 proc sim_init { args } {
  75     # Need to return an empty string (copied from GAS).
  76     return ""
  77 }
  78
  79 # Run testcase NAME.
  80 # NAME is either a fully specified file name, or just the file name in which
  81 # case $srcdir/$subdir will be prepended.
  82 # The file can contain options in the form "# option(mach list): value"
  83 # Possibilities:
  84 # mach(): machine names
  85 # as(mach): <assembler options>
  86 # ld(mach): <linker options>
  87 # sim(mach): <simulator options>
  88 # output(): program output pattern to match with string-match
  89 # If `output' is not specified, the program must output "pass".
  90
  91 proc run_sim_test { name } {
  92     global subdir srcdir
  93     global AS ASFLAGS LD LDFLAGS SIMFLAGS
  94     global opts
  95
  96     if [string match "*/*" $name] {
  97         set file $name
  98         set name [file tail $name]
  99     } else {
 100         set file "$srcdir/$subdir/$name"
 101     }
 102
 103     set opt_array [slurp_options "${file}"]
 104     if { $opt_array == -1 } {
 105         unresolved $subdir/$name
 106         return
 107     }
 108     set opts(as) {}
 109     set opts(ld) {}
 110     set opts(sim) {}
 111     set opts(output) {}
 112     set opts(mach) {}
 113
 114     foreach i $opt_array {
 115         set opt_name [lindex $i 0]
 116         set opt_machs [lindex $i 1]
 117         set opt_val [lindex $i 2]
 118         if ![info exists opts($opt_name)] {
 119             perror "unknown option $opt_name in file $file"
 120             unresolved $subdir/$name
 121             return
 122         }
 123         foreach m $opt_machs {
 124             set opts($opt_name,$m) $opt_val
 125         }
 126         if { "$opt_machs" == "" } {
 127             set opts($opt_name) $opt_val
 128         }
 129     }
 130
 131     set testname $name
 132     set sourcefile $file
 133     if { $opts(output) == "" } {
 134         set opts(output) "pass\n"
 135     }
 136
 137     foreach mach $opts(mach) {
 138         verbose "Testing $name on $mach."
 139
 140         if ![info exists opts(as,$mach)] {
 141             set opts(as,$mach) $opts(as)
 142         }
 143         send_log "$AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile\n"
 144         catch "exec $AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile" comp_output
 145
 146         if ![string match "" $comp_output] {
 147             verbose -log "$comp_output" 3
 148             fail "$mach $testname"
 149             continue
 150         }
 151
 152         if ![info exists opts(ld,$mach)] {
 153             set opts(ld,$mach) $opts(ld)
 154         }
 155         send_log "$LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o\n"
 156         catch "exec $LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o" comp_output
 157
 158         if ![string match "" $comp_output] {
 159             verbose -log "$comp_output" 3
 160             fail "$mach $testname"
 161             continue
 162         }
 163
 164         # If no machine specific options, default to the general version.
 165         if ![info exists opts(sim,$mach)] {
 166             set opts(sim,$mach) $opts(sim)
 167         }
 168
 169         set result [sim_run ${name}.x "$opts(sim,$mach)" ""]
 170         set status [lindex $result 0]
 171         set output [lindex $result 1]
 172
 173         if { "$status" == "pass" } {
 174             if ![string match $opts(output) $output] {
 175                 verbose -log "output:  $output" 3
 176                 verbose -log "pattern: $opts(output)" 3
 177             }
 178         }
 179
 180         $status "$mach $testname"
 181     }
 182 }
 183
 184 # Subroutine of run_sim_test to process options in FILE.
 185
 186 proc slurp_options { file } {
 187     if [catch { set f [open $file r] } x] {
 188         #perror "couldn't open `$file': $x"
 189         perror "$x"
 190         return -1
 191     }
 192     set opt_array {}
 193     # whitespace expression
 194     set ws  {[  ]*}
 195     set nws {[^         ]*}
 196     # whitespace is ignored anywhere except within the options list;
 197     # option names are alphabetic only
 198     set pat "^#${ws}(\[a-zA-Z\]*)\\((.*)\\)$ws:${ws}(.*)$ws\$"
 199     # Allow comment as first line of file.
 200     set firstline 1
 201     while { [gets $f line] != -1 } {
 202         set line [string trim $line]
 203         # Whitespace here is space-tab.
 204         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 205             # match!
 206             lappend opt_array [list $opt_name $opt_machs $opt_val]
 207         } else {
 208             if { ! $firstline } {
 209                 break
 210             }
 211         }
 212         set firstline 0
 213     }
 214     close $f
 215     return $opt_array
 216 }