| # 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 |
| clone_output "$sim_path $version\n" |
| } |
| |
| # Cover function to target_compile. |
| # Copied from gdb_compile. |
| |
| proc sim_compile { source dest type options } { |
| set result [target_compile $source $dest $type $options] |
| regsub "\[\r\n\]*$" "$result" "" result |
| regsub "^\[\r\n\]*" "$result" "" result |
| if { $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). |
| # |
| # 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. |
| # |
| # This is different than the sim_load routine provided by |
| # 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 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] |
| if { "$testcase_timeout" == "" } { |
| set testcase_timeout [board_info host testcase_timeout] |
| } |
| if { "$testcase_timeout" == "" } { |
| 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] |
| |
| 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" |
| } |
| |
| if { [board_info target sim,protocol] == "sid" } { |
| set cmd "" |
| set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\"" |
| } else { |
| set cmd "$prog" |
| } |
| |
| send_log "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts\n" |
| |
| if { "$redir" == "" } { |
| remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts" |
| } else { |
| remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts $redir" writeonly |
| } |
| set result [remote_wait host $testcase_timeout] |
| |
| set return_code [lindex $result 0] |
| set output [lindex $result 1] |
| # Remove the \r part of "\r\n" so we don't break all the patterns |
| # 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'. |
| set status fail |
| if { $return_code == 0 } { |
| set status pass |
| } |
| |
| return [list $status $output] |
| } |
| |
| # Run testcase NAME. |
| # NAME is either a fully specified file name, or just the file name in which |
| # case $srcdir/$subdir will be prepended. |
| # 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: [all | machine names] |
| # as[(mach-list)]: <assembler options> |
| # ld[(mach-list)]: <linker options> |
| # sim[(mach-list)]: <simulator options> |
| # output: program output pattern to match with string-match |
| # xerror: program is expected to return with a "failure" exit code |
| # xfail: <PRMS-opt> <target-triplets-where-test-fails> |
| # kfail: <PRMS> <target-triplets-where-test-fails> |
| # 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. |
| # Multiple "output", "xfail" and "kfail" options concatenate. |
| # The xfail and kfail arguments are space-separated target triplets and PRIDs. |
| # There must be a PRMS (bug report ID) specified for kfail, while it's |
| # optional for xfail. |
| |
| proc run_sim_test { name requested_machs } { |
| global subdir srcdir |
| global SIMFLAGS |
| global opts |
| global cpu_option |
| global global_as_options |
| global global_ld_options |
| global global_sim_options |
| |
| if [string match "*/*" $name] { |
| set file $name |
| set name [file tail $name] |
| } else { |
| set file "$srcdir/$subdir/$name" |
| } |
| |
| set opt_array [slurp_options "${file}"] |
| if { $opt_array == -1 } { |
| unresolved $subdir/$name |
| return |
| } |
| # Clear default options |
| set opts(as) "" |
| set opts(ld) "" |
| set opts(sim) "" |
| set opts(output) "" |
| set opts(mach) "" |
| set opts(timeout) "" |
| set opts(xerror) "no" |
| set opts(xfail) "" |
| set opts(kfail) "" |
| |
| if ![info exists global_as_options] { |
| set global_as_options "" |
| } |
| if ![info exists global_ld_options] { |
| set global_ld_options "" |
| } |
| if ![info exists global_sim_options] { |
| set global_sim_options "" |
| } |
| |
| # Clear any machine specific options specified in a previous test case |
| foreach m $requested_machs { |
| if [info exists opts(as,$m)] { |
| unset opts(as,$m) |
| } |
| if [info exists opts(ld,$m)] { |
| unset opts(ld,$m) |
| } |
| if [info exists opts(sim,$m)] { |
| unset opts(sim,$m) |
| } |
| } |
| |
| foreach i $opt_array { |
| set opt_name [lindex $i 0] |
| set opt_machs [lindex $i 1] |
| set opt_val [lindex $i 2] |
| if ![info exists opts($opt_name)] { |
| perror "unknown option $opt_name in file $file" |
| unresolved $subdir/$name |
| return |
| } |
| # Multiple "output" specifications concatenate, they don't override. |
| if { $opt_name == "output" } { |
| set opt_val "$opts(output)$opt_val" |
| } |
| # Similar with "xfail" and "kfail", but arguments are space-separated. |
| if { $opt_name == "xfail" || $opt_name == "kfail" } { |
| set opt_val "$opts($opt_name) $opt_val" |
| } |
| |
| foreach m $opt_machs { |
| set opts($opt_name,$m) $opt_val |
| } |
| if { "$opt_machs" == "" } { |
| set opts($opt_name) $opt_val |
| } |
| } |
| |
| set testname $name |
| set sourcefile $file |
| if { $opts(output) == "" } { |
| 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) |
| |
| 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." |
| |
| # Time to setup xfailures and kfailures. |
| if { "$opts(xfail)" != "" } { |
| verbose -log "xfail: $opts(xfail)" |
| # Using eval to make $opts(xfail) appear as individual |
| # arguments. |
| eval setup_xfail $opts(xfail) |
| } |
| if { "$opts(kfail)" != "" } { |
| verbose -log "kfail: $opts(kfail)" |
| eval setup_kfail $opts(kfail) |
| } |
| |
| if ![info exists opts(as,$mach)] { |
| set opts(as,$mach) $opts(as) |
| } |
| |
| set as_options "$opts(as,$mach) -I$srcdir/$subdir" |
| if [info exists cpu_option] { |
| set as_options "$as_options $cpu_option=$mach" |
| } |
| set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"] |
| |
| if ![string match "" $comp_output] { |
| verbose -log "$comp_output" 3 |
| fail "$mach $testname (assembling)" |
| continue |
| } |
| |
| if ![info exists opts(ld,$mach)] { |
| set opts(ld,$mach) $opts(ld) |
| } |
| |
| set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"] |
| |
| if ![string match "" $comp_output] { |
| verbose -log "$comp_output" 3 |
| fail "$mach $testname (linking)" |
| continue |
| } |
| |
| # If no machine specific options, default to the general version. |
| if ![info exists opts(sim,$mach)] { |
| set opts(sim,$mach) $opts(sim) |
| } |
| |
| # Build the options argument. |
| set options "" |
| if { "$opts(timeout)" != "" } { |
| set options "$options timeout=$opts(timeout)" |
| } |
| |
| set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "" "" "$options"] |
| set status [lindex $result 0] |
| set output [lindex $result 1] |
| |
| if { "$status" == "pass" } { |
| if { "$opts(xerror)" == "no" } { |
| if [string match $opts(output) $output] { |
| pass "$mach $testname" |
| file delete ${name}.o ${name}.x |
| } else { |
| verbose -log "output: $output" 3 |
| verbose -log "pattern: $opts(output)" 3 |
| fail "$mach $testname (execution)" |
| } |
| } else { |
| verbose -log "`pass' return code when expecting failure" 3 |
| fail "$mach $testname (execution)" |
| } |
| } elseif { "$status" == "fail" } { |
| if { "$opts(xerror)" == "no" } { |
| fail "$mach $testname (execution)" |
| } else { |
| if [string match $opts(output) $output] { |
| pass "$mach $testname" |
| file delete ${name}.o ${name}.x |
| } else { |
| verbose -log "output: $output" 3 |
| verbose -log "pattern: $opts(output)" 3 |
| fail "$mach $testname (execution)" |
| } |
| } |
| } else { |
| $status "$mach $testname" |
| } |
| } |
| } |
| |
| # Subroutine of run_sim_test to process options in FILE. |
| |
| proc slurp_options { file } { |
| if [catch { set f [open $file r] } x] { |
| #perror "couldn't open `$file': $x" |
| perror "$x" |
| return -1 |
| } |
| set opt_array {} |
| # whitespace expression |
| set ws {[ ]*} |
| 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\$" |
| # Allow arbitrary lines until the first option is seen. |
| set seen_opt 0 |
| while { [gets $f line] != -1 } { |
| set line [string trim $line] |
| # Whitespace here is space-tab. |
| if [regexp $pat $line xxx opt_name opt_machs opt_val] { |
| # match! |
| lappend opt_array [list $opt_name $opt_machs $opt_val] |
| set seen_opt 1 |
| } else { |
| if { $seen_opt } { |
| break |
| } |
| } |
| } |
| close $f |
| return $opt_array |
| } |