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: program output pattern to match with string-match
 158 # xerror: 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     global cpu_option
 168     global global_as_options
 169     global global_ld_options
 170     global global_sim_options
 171
 172     if [string match "*/*" $name] {
 173         set file $name
 174         set name [file tail $name]
 175     } else {
 176         set file "$srcdir/$subdir/$name"
 177     }
 178
 179     set opt_array [slurp_options "${file}"]
 180     if { $opt_array == -1 } {
 181         unresolved $subdir/$name
 182         return
 183     }
 184     # Clear default options
 185     set opts(as) ""
 186     set opts(ld) ""
 187     set opts(sim) ""
 188     set opts(output) ""
 189     set opts(mach) ""
 190     set opts(timeout) ""
 191     set opts(xerror) "no"
 192
 193     if ![info exists global_as_options] {
 194         set global_as_options ""
 195     }
 196     if ![info exists global_ld_options] {
 197         set global_ld_options ""
 198     }
 199     if ![info exists global_sim_options] {
 200         set global_sim_options ""
 201     }
 202
 203     # Clear any machine specific options specified in a previous test case
 204     foreach m $requested_machs {
 205         if [info exists opts(as,$m)] {
 206             unset opts(as,$m)
 207         }
 208         if [info exists opts(ld,$m)] {
 209             unset opts(ld,$m)
 210         }
 211         if [info exists opts(sim,$m)] {
 212             unset opts(sim,$m)
 213         }
 214     }
 215
 216     foreach i $opt_array {
 217         set opt_name [lindex $i 0]
 218         set opt_machs [lindex $i 1]
 219         set opt_val [lindex $i 2]
 220         if ![info exists opts($opt_name)] {
 221             perror "unknown option $opt_name in file $file"
 222             unresolved $subdir/$name
 223             return
 224         }
 225         foreach m $opt_machs {
 226             set opts($opt_name,$m) $opt_val
 227         }
 228         if { "$opt_machs" == "" } {
 229             set opts($opt_name) $opt_val
 230         }
 231     }
 232
 233     set testname $name
 234     set sourcefile $file
 235     if { $opts(output) == "" } {
 236         if { "$opts(xerror)" == "no" } {
 237             set opts(output) "pass\n"
 238         } else {
 239             set opts(output) "fail\n"
 240         }
 241     }
 242     # Change \n sequences to newline chars.
 243     regsub -all "\\\\n" $opts(output) "\n" opts(output)
 244
 245     set testcase_machs $opts(mach)
 246     if { "$testcase_machs" == "all" } {
 247         set testcase_machs $requested_machs
 248     }
 249
 250     foreach mach $testcase_machs {
 251         if { [lsearch $requested_machs $mach] < 0 } {
 252             verbose -log "Skipping $mach version of $name, not requested."
 253             continue
 254         }
 255
 256         verbose -log "Testing $name on machine $mach."
 257
 258         if ![info exists opts(as,$mach)] {
 259             set opts(as,$mach) $opts(as)
 260         }
 261
 262         set as_options "$opts(as,$mach) -I$srcdir/$subdir"
 263         if [info exists cpu_option] {
 264             set as_options "$as_options $cpu_option=$mach"
 265         }
 266         set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
 267
 268         if ![string match "" $comp_output] {
 269             verbose -log "$comp_output" 3
 270             fail "$mach $testname (assembling)"
 271             continue
 272         }
 273
 274         if ![info exists opts(ld,$mach)] {
 275             set opts(ld,$mach) $opts(ld)
 276         }
 277
 278         set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
 279
 280         if ![string match "" $comp_output] {
 281             verbose -log "$comp_output" 3
 282             fail "$mach $testname (linking)"
 283             continue
 284         }
 285
 286         # If no machine specific options, default to the general version.
 287         if ![info exists opts(sim,$mach)] {
 288             set opts(sim,$mach) $opts(sim)
 289         }
 290
 291         # Build the options argument.
 292         set options ""
 293         if { "$opts(timeout)" != "" } {
 294             set options "$options timeout=$opts(timeout)"
 295         }
 296
 297         set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "" "" "$options"]
 298         set status [lindex $result 0]
 299         set output [lindex $result 1]
 300
 301         if { "$status" == "pass" } {
 302             if { "$opts(xerror)" == "no" } {
 303                 if [string match $opts(output) $output] {
 304                     pass "$mach $testname"
 305                     file delete ${name}.o ${name}.x
 306                 } else {
 307                     verbose -log "output:  $output" 3
 308                     verbose -log "pattern: $opts(output)" 3
 309                     fail "$mach $testname (execution)"
 310                 }
 311             } else {
 312                 verbose -log "`pass' return code when expecting failure" 3
 313                 fail "$mach $testname (execution)"
 314             }
 315         } elseif { "$status" == "fail" } {
 316             if { "$opts(xerror)" == "no" } {
 317                 fail "$mach $testname (execution)"
 318             } else {
 319                 if [string match $opts(output) $output] {
 320                     pass "$mach $testname"
 321                     file delete ${name}.o ${name}.x
 322                 } else {
 323                     verbose -log "output:  $output" 3
 324                     verbose -log "pattern: $opts(output)" 3
 325                     fail "$mach $testname (execution)"
 326                 }
 327             }
 328         } else {
 329             $status "$mach $testname"
 330         }
 331     }
 332 }
 333
 334 # Subroutine of run_sim_test to process options in FILE.
 335
 336 proc slurp_options { file } {
 337     if [catch { set f [open $file r] } x] {
 338         #perror "couldn't open `$file': $x"
 339         perror "$x"
 340         return -1
 341     }
 342     set opt_array {}
 343     # whitespace expression
 344     set ws  {[  ]*}
 345     set nws {[^         ]*}
 346     # whitespace is ignored anywhere except within the options list;
 347     # option names are alphabetic only
 348     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
 349     # Allow arbitrary lines until the first option is seen.
 350     set seen_opt 0
 351     while { [gets $f line] != -1 } {
 352         set line [string trim $line]
 353         # Whitespace here is space-tab.
 354         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 355             # match!
 356             lappend opt_array [list $opt_name $opt_machs $opt_val]
 357             set seen_opt 1
 358         } else {
 359             if { $seen_opt } {
 360                 break
 361             }
 362         }
 363     }
 364     close $f
 365     return $opt_array
 366 }