| # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software |
| # Foundation, Inc. |
| # |
| # This file is part of DejaGnu. |
| # |
| # DejaGnu is free software; you can redistribute it and/or modify it |
| # under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 2 of the License, or |
| # (at your option) any later version. |
| # |
| # DejaGnu is distributed in the hope that it will be useful, but |
| # WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| # General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with DejaGnu; if not, write to the Free Software Foundation, |
| |
| # When using the simulator (-n iss) and running nice'd, things can naturally |
| # take a little longer, so increase the timeout. |
| |
| # |
| # udi_load -- load the program and execute it |
| # |
| # See default.exp for explanation of arguments and results. |
| # |
| |
| proc udi_load { dest prog args } { |
| set shell_prompt [board_info $dest shell_prompt] |
| set output "" |
| |
| if ![file exists $prog] then { |
| perror "$prog does not exist." |
| verbose -log "$prog does not exist." 3 |
| return [list "untested" ""] |
| } |
| |
| # Load the program. |
| if ![board_info $dest exists fileid] then { |
| remote_open $dest |
| if ![board_info $dest exists fileid] then { |
| verbose -log "$prog not executed, couldn't connect to $dest." 3 |
| return "untested" |
| } |
| } |
| |
| if { [remote_ld $dest $prog] == "" } { |
| verbose -log "$prog not executed, load failed." 3 |
| return [list "unresolved" ""] |
| } |
| |
| # Execute it. |
| set result -1 |
| set output "" |
| set noappend 0 |
| |
| verbose "Executing $prog." 2 |
| remote_send $dest "g\n" |
| # FIXME: The value 300 below should be a parameter. |
| remote_expect $dest 300 { |
| -re "(.*)Process exited with 0x0\[^\r\n\]*\[\r\n\]" { |
| append output $expect_out(1,string) |
| verbose "$prog executed successfully" 2 |
| set noappend 1 |
| set result 0 |
| exp_continue |
| } |
| -re "(.*)Halt instruction encountered" { |
| append output $expect_out(1,string) |
| verbose "$prog got a HALT instruction" 2 |
| set result 1 |
| set noappend 1 |
| exp_continue |
| } |
| -re "(^|\[\r\n\])$shell_prompt" { |
| if { $result == -1 } { |
| exp_continue |
| } |
| } |
| -re "(^|\[\r\n\]+)g\[\r\n\]+" { |
| exp_continue |
| } |
| -re "\[\r\n\]+" { |
| if { ! $noappend } { |
| append output $expect_out(buffer) |
| if { [string length $output] < 512000 } { |
| exp_continue |
| } else { |
| set result 1 |
| } |
| } else { |
| exp_continue |
| } |
| } |
| timeout { |
| warning "$prog timed out." |
| } |
| } |
| |
| # See what happened. |
| switch -- $result { |
| 0 { |
| set status [check_for_board_status output] |
| if { $status < 0 } { |
| blammo |
| } |
| if { $status > 0 } { |
| set result "fail" |
| } else { |
| set result "pass" |
| } |
| } |
| 1 - -1 { |
| warning "Resetting $dest." |
| remote_send $dest "r\n" |
| remote_expect $dest 5 { |
| -re "r.*$shell_prompt.*" { |
| verbose "Target reset." 2 |
| } |
| timeout { |
| # Get nastier. We want to leave the system in a state |
| # ready to run the next testcase. |
| remote_send $dest "q\n" |
| remote_close $dest |
| set udi_shell_id [remote_open $dest] |
| if { $udi_shell_id < 0 } { |
| perror "Couldn't reset $dest." |
| } |
| } |
| } |
| if { $result == 1 } { |
| set result "fail" |
| } else { |
| set result "unresolved" |
| } |
| } |
| default { |
| set result "unresolved" |
| } |
| } |
| return [list $result $output] |
| } |
| |
| # |
| # udi_exit -- shutdown the connection (or simulator) |
| # |
| |
| proc udi_exit {} { |
| remote_close target |
| } |
| |
| set_board_info protocol "udi" |
| set_board_info connect "mondfe" |
| set_board_info shell_prompt "mondfe>" |