/[dejagnu]/dejagnu/lib/kermit.exp
ViewVC logotype

Diff of /dejagnu/lib/kermit.exp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by bje, Sat Aug 16 13:08:57 2003 UTC revision 1.8 by bje, Fri Aug 22 10:38:12 2003 UTC
# Line 17  Line 17 
17  # Please email any bugs, comments, and/or additions to this file to:  # Please email any bugs, comments, and/or additions to this file to:
18  # bug-dejagnu@gnu.org  # bug-dejagnu@gnu.org
19    
20  #  # Connect to DEST using Kermit. Note that we're just using Kermit as a
 # Connect to DEST using kermit. Note that we're just using kermit as a  
21  # simple serial or network connect program; we don't actually use Kermit  # simple serial or network connect program; we don't actually use Kermit
22  # protocol to do downloads.  # protocol to do downloads.
 #     returns -1 if it failed, otherwise it returns  
 #         the spawn_id.  
23  #  #
24  proc kermit_open { dest args } {  # Returns -1 if it failed, otherwise it returns the spawn_id.
25    #
26    proc kermit_open {dest args} {
27      global spawn_id      global spawn_id
28      global board_info      global board_info
29    
# Line 46  proc kermit_open { dest args } { Line 45  proc kermit_open { dest args } {
45      set result -1      set result -1
46      verbose "kermit $device"      verbose "kermit $device"
47      eval spawn kermit $device      eval spawn kermit $device
48      if { $spawn_id < 0 } {      if {$spawn_id < 0} {
49          perror "invalid spawn id from kermit"          perror "invalid spawn id from Kermit"
50          return -1          return -1
51      }      }
52    
# Line 64  proc kermit_open { dest args } { Line 63  proc kermit_open { dest args } {
63                      warning "Never got prompt from Kermit."                      warning "Never got prompt from Kermit."
64                      set result -1                      set result -1
65                      incr tries                      incr tries
66                      if { $tries <= 2 } {                      if {$tries <= 2} {
67                          exp_continue                          exp_continue
68                      }                      }
69                  }                  }
# Line 74  proc kermit_open { dest args } { Line 73  proc kermit_open { dest args } {
73              perror "Never connected."              perror "Never connected."
74              set result -1              set result -1
75              incr tries              incr tries
76              if { $tries <= 2 } {              if {$tries <= 2} {
77                  exp_continue                  exp_continue
78              }              }
79          }          }
# Line 82  proc kermit_open { dest args } { Line 81  proc kermit_open { dest args } {
81              warning "Timed out trying to connect."              warning "Timed out trying to connect."
82              set result -1              set result -1
83              incr tries              incr tries
84              if { $tries<=2 } {              if {$tries <= 2} {
85                  exp_continue                  exp_continue
86              }              }
87          }          }
88      }      }
89    
90      if { $result < 0 } {      if {$result < 0} {
91          perror "Couldn't connect after $tries tries."          perror "Couldn't connect after $tries tries."
92          if [info exists board_info($dest,fileid)] {          if [info exists board_info($dest,fileid)] {
93              unset board_info($dest,fileid)              unset board_info($dest,fileid)
# Line 105  proc kermit_open { dest args } { Line 104  proc kermit_open { dest args } {
104      }      }
105  }  }
106    
 #  
107  # Send a list of commands to the Kermit session connected to DEST.  # Send a list of commands to the Kermit session connected to DEST.
108  #  #
109  proc kermit_command { dest args } {  proc kermit_command {dest args} {
110      if [board_info $dest exists name] {      if [board_info $dest exists name] {
111          set dest [board_info $dest name]          set dest [board_info $dest name]
112      }      }
113      set shell_id [board_info $dest fileid]      set shell_id [board_info $dest fileid]
114    
115      # Sometimes we have to send multiple ^\c sequences. Don't know      # Sometimes we have to send multiple ^\c sequences. Don't know
116      # why.      # why.
117      set timeout 2      set timeout 2
118      for { set i 1 } { $i <= 5 } { incr i } {      for {set i 1} {$i <= 5} {incr i} {
119          send -i $shell_id "c"          send -i $shell_id "c"
120          expect {          expect {
121              -i $shell_id -re ".*Back at.*ermit.*>.*$" { set i 10 }              -i $shell_id -re ".*Back at.*ermit.*>.*$" {set i 10}
122              -i $shell_id timeout {              -i $shell_id timeout {
123                  if { $i > 2 } {                  if {$i > 2} {
124                      warning "Unable to get prompt from kermit."                      warning "Unable to get prompt from kermit."
125                  }                  }
126              }              }
# Line 133  proc kermit_command { dest args } { Line 132  proc kermit_command { dest args } {
132          expect {          expect {
133              -i $shell_id -re ".*ermit.*>.*$" { }              -i $shell_id -re ".*ermit.*>.*$" { }
134              -i $shell_id timeout {              -i $shell_id timeout {
135                  perror "Response failed from kermit."                  perror "Response failed from Kermit."
136                  return -1                  return -1
137              }              }
138          }          }
# Line 142  proc kermit_command { dest args } { Line 141  proc kermit_command { dest args } {
141      expect {      expect {
142          -i $shell_id -re ".*other options.\[\r\n\]+" { }          -i $shell_id -re ".*other options.\[\r\n\]+" { }
143          -i $shell_id timeout {          -i $shell_id timeout {
144              perror "Unable to resume kermit connection."              perror "Unable to resume Kermit connection."
145              return -1              return -1
146          }          }
147      }      }
148      return 0      return 0
149  }  }
150    
   
 #  
151  # Send STRING to DEST.  # Send STRING to DEST.
152  #  #
153  proc kermit_send { dest string args } {  proc kermit_send {dest string args} {
154      if [board_info $dest exists transmit_pause] {      if [board_info $dest exists transmit_pause] {
155          set f [open "/tmp/fff" "w"]          set f [open "/tmp/fff" "w"]
156          puts -nonewline $f "$string"          puts -nonewline $f "$string"
# Line 166  proc kermit_send { dest string args } { Line 163  proc kermit_send { dest string args } {
163      }      }
164  }  }
165    
166    # Transmit FILE directly to DEST as raw data.
167    # No translation is performed.
168  #  #
169  # Transmit FILE directly to DEST as raw data. No translation is  proc kermit_transmit {dest file args} {
 # performed.  
 #  
 proc kermit_transmit { dest file args } {  
170      if [board_info $dest exists transmit_pause] {      if [board_info $dest exists transmit_pause] {
171          kermit_command $dest "transmit $file"          kermit_command $dest "transmit $file"
172          return ""          return ""

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26