import insight-2000-02-04 snapshot (2nd try)
[external/binutils.git] / sim / testsuite / lib / sim-defs.exp
index 9db9641..3224528 100644 (file)
@@ -1,12 +1,27 @@
 # Simulator dejagnu utilities.
 
+# Communicate simulator path from sim_init to sim_version.
+# For some reason [board_info target sim] doesn't work in sim_version.
+# [Presumubly because the target has been "popped" by then.  Odd though.]
+set sim_path "unknown-run"
+
+# Initialize the testrun.
+# Required by dejagnu.
+
+proc sim_init { args } {
+    global sim_path
+    set sim_path [board_info target sim]
+    # Need to return an empty string (copied from GAS).
+    return ""
+}
+
 # Print the version of the simulator being tested.
 # Required by dejagnu.
 
 proc sim_version {} {
+    global sim_path
     set version 0.5
-    set program [board_info target sim]
-    clone_output "$program $version\n"
+    clone_output "$sim_path $version\n"
 }
 
 # Cover function to target_compile.
@@ -17,14 +32,24 @@ proc sim_compile { source dest type options } {
     regsub "\[\r\n\]*$" "$result" "" result
     regsub "^\[\r\n\]*" "$result" "" result
     if { $result != "" } {
-       clone_output "sim compile failed, $result"
+       clone_output "sim compile output: $result"
     }
     return $result
 }
 
 # Run a program on the simulator.
 # Required by dejagnu (at least ${tool}_run used to be).
-# FIXME: What should we do with `redir'?
+#
+# SIM_OPTS are options for the simulator.
+# PROG_OPTS are options passed to the simulated program.
+# At present REDIR must be "" or "> foo".
+# OPTIONS is a list of options internal to this routine.
+# This is modelled after target_compile.  We want to be able to add new
+# options without having to update all our users.
+# Currently:
+#      env(foo)=val    - set environment variable foo to val for this run
+#      timeout=val     - set the timeout to val for this run
+#
 # The result is a list of two elements.
 # The first is one of pass/fail/etc.
 # The second is the program's output.
@@ -33,9 +58,10 @@ proc sim_compile { source dest type options } {
 # dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
 # simulator (not the simulated program, the simulator) with sim_load.
 
-proc sim_run { prog sim_opts redir } {
+proc sim_run { prog sim_opts prog_opts redir options } {
     global SIMFLAGS
 
+    # Set the default value of the timeout.
     # FIXME: The timeout value we actually want is a function of
     # host, target, and testcase.
     set testcase_timeout [board_info target sim_time_limit]
@@ -46,9 +72,50 @@ proc sim_run { prog sim_opts redir } {
        set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
     }
 
+    # Initial the environment we pass to the testcase.
+    set testcase_env ""
+
+    # Process OPTIONS ...
+    foreach o $options {
+       if [regexp {^env\((.*)\)=(.*)} $o full var val] {
+           set testcase_env "$testcase_env $var=$val"
+       } elseif [regexp {^timeout=(.*)} $o full val] {
+           set testcase_timeout $val
+       }
+       
+    }
+       
+    verbose "testcase timeout is set to $testcase_timeout" 1
+
     set sim [board_info target sim]
 
-    remote_spawn host "$sim $SIMFLAGS $sim_opts $prog"
+    if [is_remote host] {
+       set prog [remote_download host $prog]
+       if { $prog == "" } {
+           error "download failed"
+           return -1;
+       }
+    }
+
+    set board [target_info name]
+    if [board_info $board exists sim,options] {
+       set always_opts [board_info $board sim,options]
+    } else {
+       set always_opts ""
+    }
+
+    # FIXME: this works for UNIX only
+    if { "$testcase_env" != "" } {
+       set sim "env $testcase_env $sim"
+    }
+
+    send_log "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts\n"
+
+    if { "$redir" == "" } {
+       remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts"
+    } else {
+       remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $prog $prog_opts $redir" writeonly
+    }
     set result [remote_wait host $testcase_timeout]
 
     set return_code [lindex $result 0]
@@ -57,6 +124,11 @@ proc sim_run { prog sim_opts redir } {
     # we want to match.
     regsub -all -- "\r" $output "" output
 
+    if [is_remote host] {
+       # clean up after ourselves.
+       remote_file host delete $prog
+    }
+
     # ??? Not sure the test for pass/fail is right.
     # We just care that the simulator ran correctly, not whether the simulated
     # program return 0 or non-zero from `main'.
@@ -68,29 +140,29 @@ proc sim_run { prog sim_opts redir } {
     return [list $status $output]
 }
 
-# Initialize the testrun.
-# Required by dejagnu.
-
-proc sim_init { args } {
-    # Need to return an empty string (copied from GAS).
-    return ""
-}
-
 # Run testcase NAME.
 # NAME is either a fully specified file name, or just the file name in which
 # case $srcdir/$subdir will be prepended.
-# The file can contain options in the form "# option(mach list): value"
+# REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
+# for the specified machine(s), it is ignored.
+# Typically REQUESTED_MACHS contains just one element, it is up to the caller
+# to iterate over the desired machine variants.
+#
+# The file can contain options in the form "# option(mach list): value".
 # Possibilities:
-# mach(): machine names
-# as(mach): <assembler options>
-# ld(mach): <linker options>
-# sim(mach): <simulator options>
-# output(): program output pattern to match with string-match
-# If `output' is not specified, the program must output "pass".
-
-proc run_sim_test { name } {
+# mach: [all | machine names]
+# as[(mach-list)]: <assembler options>
+# ld[(mach-list)]: <linker options>
+# sim[(mach-list)]: <simulator options>
+# output[(mach-list)]: program output pattern to match with string-match
+# xerror[(mach-list)]: program is expected to return with a "failure" exit code
+# If `output' is not specified, the program must output "pass" if !xerror or
+# "fail" if xerror.
+# The parens in "optname()" are optional if the specification is for all machs.
+
+proc run_sim_test { name requested_machs } {
     global subdir srcdir
-    global AS ASFLAGS LD LDFLAGS SIMFLAGS
+    global SIMFLAGS
     global opts
 
     if [string match "*/*" $name] {
@@ -110,6 +182,8 @@ proc run_sim_test { name } {
     set opts(sim) {}
     set opts(output) {}
     set opts(mach) {}
+    set opts(timeout) {}
+    set opts(xerror) "no"
 
     foreach i $opt_array {
        set opt_name [lindex $i 0]
@@ -131,17 +205,33 @@ proc run_sim_test { name } {
     set testname $name
     set sourcefile $file
     if { $opts(output) == "" } {
-       set opts(output) "pass\n"
+       if { "$opts(xerror)" == "no" } {
+           set opts(output) "pass\n"
+       } else {
+           set opts(output) "fail\n"
+       }
     }
+    # Change \n sequences to newline chars.
+    regsub -all "\\\\n" $opts(output) "\n" opts(output)
 
-    foreach mach $opts(mach) {
-       verbose "Testing $name on $mach."
+    set testcase_machs $opts(mach)
+    if { "$testcase_machs" == "all" } {
+       set testcase_machs $requested_machs
+    }
+
+    foreach mach $testcase_machs {
+       if { [lsearch $requested_machs $mach] < 0 } {
+           verbose -log "Skipping $mach version of $name, not requested."
+           continue
+       }
+
+       verbose -log "Testing $name on machine $mach."
 
        if ![info exists opts(as,$mach)] {
            set opts(as,$mach) $opts(as)
        }
-       send_log "$AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile\n"
-       catch "exec $AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile" comp_output
+
+       set comp_output [target_assemble $sourcefile ${name}.o "$opts(as,$mach) -I$srcdir/$subdir"]
 
        if ![string match "" $comp_output] {
            verbose -log "$comp_output" 3
@@ -152,8 +242,8 @@ proc run_sim_test { name } {
        if ![info exists opts(ld,$mach)] {
            set opts(ld,$mach) $opts(ld)
        }
-       send_log "$LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o\n"
-       catch "exec $LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o" comp_output
+
+       set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach)"]
 
        if ![string match "" $comp_output] {
            verbose -log "$comp_output" 3
@@ -166,18 +256,44 @@ proc run_sim_test { name } {
            set opts(sim,$mach) $opts(sim)
        }
 
-       set result [sim_run ${name}.x "$opts(sim,$mach)" ""]
+       # Build the options argument.
+       set options ""
+       if { "$opts(timeout)" != "" } {
+           set options "$options timeout=$opts(timeout)"
+       }
+
+       set result [sim_run ${name}.x "$opts(sim,$mach)" "" "" "$options"]
        set status [lindex $result 0]
        set output [lindex $result 1]
 
        if { "$status" == "pass" } {
-           if ![string match $opts(output) $output] {
-               verbose -log "output:  $output" 3
-               verbose -log "pattern: $opts(output)" 3
+           if { "$opts(xerror)" == "no" } {
+               if [string match $opts(output) $output] {
+                   pass "$mach $testname"
+               } else {
+                   verbose -log "output:  $output" 3
+                   verbose -log "pattern: $opts(output)" 3
+                   fail "$mach $testname"
+               }
+           } else {
+               verbose -log "`pass' return code when expecting failure" 3
+               fail "$mach $testname"
            }
+       } elseif { "$status" == "fail" } {
+           if { "$opts(xerror)" == "no" } {
+               fail "$mach $testname"
+           } else {
+               if [string match $opts(output) $output] {
+                   pass "$mach $testname"
+               } else {
+                   verbose -log "output:  $output" 3
+                   verbose -log "pattern: $opts(output)" 3
+                   fail "$mach $testname"
+               }
+           }
+       } else {
+           $status "$mach $testname"
        }
-
-       $status "$mach $testname"
     }
 }
 
@@ -195,7 +311,7 @@ proc slurp_options { file } {
     set nws {[^        ]*}
     # whitespace is ignored anywhere except within the options list;
     # option names are alphabetic only
-    set pat "^#${ws}(\[a-zA-Z\]*)\\((.*)\\)$ws:${ws}(.*)$ws\$"
+    set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
     # Allow comment as first line of file.
     set firstline 1
     while { [gets $f line] != -1 } {