/[mailutils]/mailutils/mail/testsuite/lib/mail.exp
ViewVC logotype

Diff of /mailutils/mail/testsuite/lib/mail.exp

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

revision 1.7 by gray, Wed Aug 7 23:00:51 2002 UTC revision 1.8 by gray, Tue Aug 20 20:24:53 2002 UTC
# Line 16  Line 16 
16  # along with this program; if not, write to the Free Software Foundation,  # along with this program; if not, write to the Free Software Foundation,
17  # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18    
19  verbose "STARTED" 1  source ../../testsuite/lib/mailutils.exp
 if [info exists TOOL_EXECUTABLE] {  
     set MAIL $TOOL_EXECUTABLE  
 }  
 if ![info exists MAIL] {  
     if ![is_remote host] {  
         set MAIL [findfile $base_dir/../mail "$base_dir/../mail" [transform mail]]  
         set MAIL_SPOOL_SOURCE "$srcdir/spool"  
         set MAIL_FOLDER_SOURCE "$srcdir/folder"  
         set MAIL_SPOOL_DIR "$objdir/data/spool"  
         set MAIL_FOLDER_DIR "$objdir/data/folder"  
         set MAIL_RC_DIR "$srcdir/etc"  
         set MAKESPOOL "$srcdir/makespool"  
     } else {  
         if [info exists host_board] {  
             if [board_info $host_board exists top_builddir] {  
                 append MAIL "[board_info $host_board top_builddir]/mail/mail"  
             } elseif [board_info $host_board exists top_srcdir] {  
                 append MAIL "[board_info $host_board top_srcdir]/mail/mail"  
             }  
         }  
20    
21          if ![info exists MAIL] {  set TOOL_NAME "mail"
22              perror "The test suite is not set up for the remote testing"  mu_init
             perror "Please, read file README in mail/testsuite subdirectory"  
             perror "for instructions on how to set up it."  
             exit 1  
         }        
         set MAIL_RC_DIR "[board_info $host_board srcdir]/etc"  
         set MAIL_SPOOL_SOURCE "[board_info $host_board srcdir]/spool"  
         set MAIL_FOLDER_SOURCE "[board_info $host_board srcdir]/folder"  
         set MAIL_SPOOL_DIR "[board_info $host_board objdir]/data/spool"  
         set MAIL_FOLDER_DIR "[board_info $host_board objdir]/data/folder"  
         set MAKESPOOL "[board_info $host_board srcdir]/makespool"  
     }  
 }  
   
 verbose "using MAIL = $MAIL" 2  
23    
24  if ![info exists MAILFLAGS] {  if ![info exists MAILFLAGS] {
25      set MAILFLAGS "--nosum --norc --mail-spool $MAIL_SPOOL_DIR"      set MAILFLAGS "--nosum --norc --mail-spool $MU_SPOOL_DIR"
26  }  }
27    
28    set MU_TOOL_FLAGS $MAILFLAGS
29    
30  #FIXME: this doesn't work with remote testing  #FIXME: this doesn't work with remote testing
31  set env(MAILRC) $MAIL_RC_DIR/mail.rc  set env(MAILRC) $MU_RC_DIR/mail.rc
32  set env(MBOX) "$MAIL_SPOOL_DIR/mbox"  set env(MBOX) "$MU_SPOOL_DIR/mbox"
33    
34  # The variable mail_prompt is a regexp which matches the mail prompt.  # The variable mail_prompt is a regexp which matches the mail prompt.
35  global mail_prompt  global mail_prompt
# Line 71  if ![info exists mail_prompt] then { Line 39  if ![info exists mail_prompt] then {
39    
40  ### Only procedures should come after this point.  ### Only procedures should come after this point.
41    
 proc mail_prepare_spools {} {  
     global MAIL_SPOOL_SOURCE  
     global MAIL_SPOOL_DIR  
     global MAIL_FOLDER_SOURCE  
     global MAIL_FOLDER_DIR  
     global MAKESPOOL  
   
     set output [remote_exec host "$MAKESPOOL \  
                     $MAIL_SPOOL_SOURCE $MAIL_SPOOL_DIR\  
                     $MAIL_FOLDER_SOURCE $MAIL_FOLDER_DIR"]  
 }  
   
 proc mail_cleanup_spools {} {  
     global MAIL_SPOOL_SOURCE  
     global MAIL_SPOOL_DIR  
     global MAIL_FOLDER_SOURCE  
     global MAIL_FOLDER_DIR  
     global MAKESPOOL  
   
     if { $MAIL_SPOOL_SOURCE != $MAIL_SPOOL_DIR } {  
         set output [remote_exec host "$MAKESPOOL -r \  
                     $MAIL_SPOOL_DIR $MAIL_FOLDER_DIR"]  
     }  
 }  
               
 proc default_mail_version {} {  
     global MAIL  
     global MAILFLAGS  
     global MAILVERSION  
   
     if [info exists MAILVERSION] {  
         return  
     }  
       
     set output [remote_exec host "$MAIL --version"]  
     regexp " \[0-9\]\[^ \t\n\r\]+" "$output" MAILVERSION  
 }  
   
42  proc mail_version {} {  proc mail_version {} {
43      global MAIL      global MU_TOOL
44      global MAILFLAGS      global MU_TOOL_FLAGS
45      global MAILVERSION      global MU_TOOL_VERSION
46            
47      default_mail_version      mu_version
48      if ![is_remote host] {      if ![is_remote host] {
49          clone_output "[which $MAIL] version $MAILVERSION"          clone_output "[which $MU_TOOL] version $MU_TOOL_VERSION"
50      } else {      } else {
51          clone_output "$MAIL on remote host version $MAILVERSION"          clone_output "$MU_TOOL on remote host version $MU_TOOL_VERSION"
52      }      }
53  }  }
54    
55  proc default_mail_start {args} {  proc default_mail_start {args} {
     global srcdir  
     global srcdir  
56      global verbose      global verbose
57      global MAIL      global MU_TOOL
58      global MAILFLAGS      global MU_TOOL_FLAGS
59      global mail_prompt      global mail_prompt
     global CAPABILITY  
60      global expect_out      global expect_out
61            
62      default_mail_version      mu_version
63            
64      set sw $args      set sw $args
65      append sw " "      append sw " "
66        if [info exists MU_TOOL_FLAGS] {
67            append sw $MU_TOOL_FLAGS
68        }
69            
70      if [info exists host_board] {      if [info exists host_board] {
71          if [board_info $host_board exists top_srcdir] {          if [board_info $host_board exists top_srcdir] {
# Line 143  proc default_mail_start {args} { Line 73  proc default_mail_start {args} {
73          }          }
74      }      }
75    
76      set mail_cmd "$MAIL $MAILFLAGS $args"      set mail_cmd "$MU_TOOL $sw"
     verbose "MAILRC is $srcdir/etc/mail.rc" 2  
77      verbose "Spawning $mail_cmd"      verbose "Spawning $mail_cmd"
78    
79      set res [remote_spawn host $mail_cmd]      set res [remote_spawn host $mail_cmd]
# Line 153  proc default_mail_start {args} { Line 82  proc default_mail_start {args} {
82          return 1;          return 1;
83      }      }
84    
85      mail_expect 360 {      mu_expect 360 {
86          -re "\[\r\n\]?${mail_prompt}$" {          -re "\[\r\n\]?${mail_prompt}$" {
87              verbose "mail initialized."              verbose "mail initialized."
88          }          }
# Line 185  proc mail_start {args} { Line 114  proc mail_start {args} {
114      }      }
115    
116      if {$reuse_spool == 0} {      if {$reuse_spool == 0} {
117          mail_prepare_spools          mu_prepare_spools
118      }      }
119      return [default_mail_start [lrange $args $i end]]      return [default_mail_start [lrange $args $i end]]
120  }  }
# Line 197  proc mail_stop {} { Line 126  proc mail_stop {} {
126  ##  ##
127    
128  proc mail_send { string } {  proc mail_send { string } {
129      global suppress_flag;      return [mu_send "$string"]
     if {[info exists suppress_flag] && $suppress_flag} {  
         return "suppressed";  
     }  
     return [remote_send host "$string"]  
130  }  }
131    
132  proc mail_command { cmd } {  proc mail_command { cmd } {
133      set res [mail_send "$cmd\n"]      return [mu_command $cmd]
     mail_expect 30 {  
         -ex "\r\n" { }  
         default {  
             perror "mail_command for target failed";  
             return -1  
         }  
     }  
     return $res  
134  }  }
135    
136  proc mail_exit {} {  proc mail_exit {} {
# Line 222  proc mail_exit {} { Line 139  proc mail_exit {} {
139      return res      return res
140  }  }
141    
 proc mail_expect { args } {  
     global env  
     if { [lindex $args 0] == "-notransfer" } {  
         set notransfer -notransfer;  
         set args [lrange $args 1 end];  
     } else {  
         set notransfer "";  
     }  
   
     if { [llength $args] == 2  && [lindex $args 0] != "-re" } {  
         set gtimeout [lindex $args 0];  
         set expcode [list [lindex $args 1]];  
     } else {  
         upvar timeout timeout;  
   
         set expcode $args;  
         if [target_info exists mail,timeout] {  
             if [info exists timeout] {  
                 if { $timeout < [target_info mail,timeout] } {  
                     set gtimeout [target_info mail,timeout];  
                 } else {  
                     set gtimeout $timeout;  
                 }  
             } else {  
                 set gtimeout [target_info mail,timeout];  
             }  
         }  
   
         if ![info exists gtimeout] {  
             global timeout;  
             if [info exists timeout] {  
                 set gtimeout $timeout;  
             } else {  
                 # Eeeeew.  
                 set gtimeout 60;  
             }  
         }  
     }  
   
     global suppress_flag;  
     global remote_suppress_flag;  
     global verbose  
     if [info exists remote_suppress_flag] {  
         set old_val $remote_suppress_flag;  
     }  
     if [info exists suppress_flag] {  
         if { $suppress_flag } {  
             set remote_suppress_flag 1;  
         }  
     }  
   
     verbose "RUNNING remote_expect host $gtimeout $notransfer $expcode" 2  
   
     set code [catch \  
         {uplevel remote_expect host $gtimeout $notransfer $expcode} string];  
     if [info exists old_val] {  
         set remote_suppress_flag $old_val;  
     } else {  
         if [info exists remote_suppress_flag] {  
             unset remote_suppress_flag;  
         }  
     }  
   
     if {$code == 1} {  
         global errorInfo errorCode;  
   
         return -code error -errorinfo $errorInfo -errorcode $errorCode $string  
     } elseif {$code == 2} {  
         return -code return $string  
     } elseif {$code == 3} {  
         return  
     } elseif {$code > 4} {  
         return -code $code $string  
     }  
 }  
   
 # default_mail_test COMMAND PATTERN  
 # COMMAND   - Command to send to mail  
 # PATTERN   - A list of strings to expect in return  
 # Return value:  
 #        -3 - eof  
 #        -2 - timeout  
 #        -1 - generic failure  
 #         1 - test fails  
 #         0 - test succeeds  
 proc default_mail_test { args } {  
     global verbose  
     global mail_prompt  
     global suppress_flag  
     global mail_prompt    
     upvar timeout timeout  
       
     set command [lindex $args 0]  
     set pattern [lindex $args 1]  
   
     if { [info exists suppress_flag] && $suppress_flag } {  
         set do_suppress 1  
     } else {  
         set do_suppress 0  
     }  
   
     if $verbose>2 then {  
         send_user "Command: \"$command\"\n"  
         send_user "Pattern: \"$pattern\"\n"  
     }  
       
     set result -1  
     if { "${command}" != "" } {  
         if { [mail_command "${command}"] != "" } {  
             if { ! $do_suppress } {  
                 perror "Couldn't send \"$command\".";  
             }  
             return $result;  
         }  
     }  
   
     if [info exists timeout] {  
         set tmt $timeout;  
     } else {  
         global timeout;  
         if [info exists timeout] {  
             set tmt $timeout;  
         } else {  
             set tmt 60;  
         }  
     }  
   
     set result 0  
     for {set i 0} {$i < [llength $pattern]} {incr i} {  
         regsub "\[ \t\]*$" [lindex ${pattern} $i] "" pat  
         verbose "i=$i, pat=$pat" 2  
         mail_expect $tmt {  
             -ex "$pat" {  
                 if { $expect_out(buffer) != $expect_out(0,string) } {  
                     verbose "Got \"$expect_out(buffer)\"" 2  
                     verbose "instead of expected \"$pat\\r\\n\"" 2  
                     set result 1  
                     break  
                 }  
                 mail_expect $tmt {  
                     -re "\[ \t]*\r\n" { }  
                     default {  
                         set result 1  
                         break  
                     }  
                     timeout {  
                         set result -2  
                         break  
                     }  
                     eof {  
                         set result -3  
                         break  
                     }  
                 }  
             }  
             default {  
                 set result 1  
                 break  
             }  
             timeout {  
                 set result -2  
                 break  
             }  
             eof {  
                 set result -3  
                 break  
             }  
         }  
     }  
   
     return $result  
 }  
   
142  # mail_test [-message MESSAGE][-default (FAIL|XFAIL)][-noprompt]  # mail_test [-message MESSAGE][-default (FAIL|XFAIL)][-noprompt]
143  #            COMMAND PATTERN [PATTERN...]  #            COMMAND PATTERN [PATTERN...]
144  # COMMAND   - Command to send to mail.  # COMMAND   - Command to send to mail.
# Line 434  proc mail_test { args } { Line 178  proc mail_test { args } {
178      }      }
179      set command [lindex $args 0]      set command [lindex $args 0]
180      set pattern [lrange $args 1 end]      set pattern [lrange $args 1 end]
181      set result [default_mail_test $command $pattern]      set result [mu_test $command $pattern]
182      if {$wait_for_prompt} {      if {$wait_for_prompt} {
183          mail_expect 30 {          mu_expect 30 {
184                  -re "\[\r\n\]?${mail_prompt}$" {}                  -re "\[\r\n\]?${mail_prompt}$" {}
185                  default {                  default {
186                          perror "mail not initialized"                          perror "mail not initialized"
# Line 464  proc mail_test { args } { Line 208  proc mail_test { args } {
208      return $result      return $result
209  }  }
210    
 proc mail_test_file {args} {  
     global verbose  
       
     set default ""  
     set message ""  
   
     for {set i 0} {$i < [llength $args]} {incr i} {  
         set a [lindex $args $i]  
         if {"$a" == "-default"} {  
             set default [lindex $args [expr $i + 1]]  
             incr i  
         } elseif {"$a" == "-message"} {  
             set message [lindex $args [expr $i + 1]]  
             incr i  
         } else {  
             set args [lrange $args $i end]  
             break  
         }  
     }  
       
     if {"$message" == ""}  {  
         set message "Contents of [lindex $args 0]"  
     }  
   
     if $verbose>2 then {  
         send_user "Message is \"$message\"\n"  
     }  
   
     set filename [lindex $args 0]  
     set pattern [lrange $args 1 end]  
   
     set res [remote_spawn host "/bin/cat $filename"]  
     if { $res < 0 || $res == "" } {  
         perror "Reading $filename failed."  
         return 1;  
     }  
     set result [default_mail_test "" $pattern]  
     if {$result == 0} {  
         pass "$message"  
     } elseif {$result == 1} {  
         if { "$default" == "" || "$default" != "FAIL" } {  
             fail "$message"  
         } else {  
             xfail "$message"  
             set result 0  
         }  
     } elseif {$result == -2} {  
         fail "$message (timeout)"  
     } elseif {$result == -3} {  
         fail "$message (eof)"  
     } else {  
         fail "$message"  
     }  
     return $result  
 }  
       
211    

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