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

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

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

revision 1.4 by gray, Mon Aug 26 17:10:05 2002 UTC revision 1.5 by gray, Tue Aug 27 10:53:03 2002 UTC
# Line 78  proc mu_init {args} { Line 78  proc mu_init {args} {
78      }      }
79  }  }
80            
81    proc mu_start {args} {
82        global verbose
83        global MU_TOOL
84        global MU_TOOL_FLAGS
85        global expect_out
86        
87        mu_version
88    
89        set args [lindex $args 0]
90        if [info exists MU_TOOL_FLAGS] {
91            set sw $MU_TOOL_FLAGS
92        } else {
93            set sw ""
94        }
95        
96        if [llength $args] {
97            append sw $args
98        }
99        
100        if [info exists host_board] {
101            if [board_info $host_board exists top_srcdir] {
102                append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool"
103            }
104        }
105    
106        set cmd "$MU_TOOL $sw"
107        verbose "Spawning $cmd"
108    
109        set res [remote_spawn host $cmd]
110        if { $res < 0 || $res == "" } {
111            perror "Spawning $cmd failed."
112            return 1;
113        }
114    
115        return 0
116    }
117    
118    # mu_exec [-retcode N][-message S][-default (FAIL | XFAIL)][-arg S...]
119    #         [PATTERN...]
120    #
121    # Executes $MU_TOOL and checks whether it returns with the given exit status
122    # and its output matches supplied PATTERN.
123    # Switches:
124    # -retcode N        Expect program to finish with exit code N instead of the
125    #                   default 0 (search for word 'Pity' below, though).
126    # -arg S            Supply additional arguments to the program.
127    # -message S        Set message to output when printing results of the test.
128    # -default          Supply the expected testcase result
129    proc mu_exec {args} {
130        global verbose
131        global MU_TOOL
132        global MU_TOOL_FLAGS
133        global expect_out
134        
135        mu_version
136    
137        if [info exists MU_TOOL_FLAGS] {
138            set sw $MU_TOOL_FLAGS
139        } else {
140            set sw ""
141        }
142        
143        set default 0
144        set message ""
145        set result 0
146        set retcode 0
147        for {set i 0} {$i < [llength $args]} {incr i} {
148            set opt [lindex $args $i]
149            if {"$opt" == "-retcode"} {
150                set retcode [lindex $args [expr $i + 1]]
151                incr i
152            } elseif {"$opt" == "-message"} {
153                set message [lindex $args [expr $i + 1]]
154                incr i
155            } elseif {"$opt" == "-default"} {
156                set default [lindex $args [expr $i + 1]]
157                incr i
158            } elseif {"$opt" == "-arg"} {
159                append sw " [lindex $args [expr $i + 1]]"
160                incr i
161            } else {
162                break
163            }
164        }  
165    
166        set args [lrange $args $i end]
167        
168        if [info exists host_board] {
169            if [board_info $host_board exists top_srcdir] {
170                append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool"
171            }
172        }
173    
174        # Pity, dejagnu provides no way to retrieve exit status of the process.
175        # This ugli construction is used to work around this. Hopefully, it
176        # should execute on any decent platform...
177        set cmd "sh -c \"$MU_TOOL $sw\; echo \$?\""
178        verbose "Executing $cmd"
179    
180        set res [remote_exec host $cmd]
181    
182        set args [concat $args "$retcode"]
183                
184        set output [lindex $res 1]
185    
186        if {[llength $args] == 0 && [string length $output] != 0} {
187            verbose "Expected \"[lindex $args 1]\" but founf EOF" 1
188            set result 1
189        }
190    
191        for {set i 0} {$result == 0 && $i < [llength $args]} {incr i} {
192            if {[string length $output] == 0} {
193                verbose "Not enough output from $cmd" 1
194                verbose "Stopped waiting for \"[lindex $args $i]\"" 1
195                set result 1
196                break
197            }
198            set regexp 0
199    
200            switch -regexp -- "[lindex $args $i]" {
201                ^-re     { set regexp 1; incr i }
202                ^-ex     -
203                ^--      { incr i }
204            }
205                
206            set pattern [lindex $args $i]
207            verbose "PATTERN $pattern"
208    
209            if {$regexp} {
210                verbose "does \"$output\" match regular expression \"$pattern\"?" 1
211                if {![regexp -- "$pattern(.*)" "$output" dummy output]} {
212                    set result 1
213                }
214            } else {
215                verbose "does \"$output\" match exact string \"$pattern\"?" 1
216                if {"$pattern" != ""} {
217                    if {[string first "$pattern" "$output"] != 0} {
218                        set result 1
219                    }
220                    set output [string range $output [string length $pattern] end]
221                }
222                if {![regexp -- "\[ \t]*\r\n(.*)" "$output" dummy output]} {
223                    set result 1
224                }
225            }
226    
227            if {$result} {
228                verbose "NO" 1
229            } else {
230                verbose "yes" 1
231            }
232        }
233    
234        if {$result == 0} {
235            pass "$message"
236        } elseif {$result == 1} {
237            if { "$default" == "" || "$default" != "FAIL" } {
238                fail "$message"
239            } else {
240                xfail "$message"
241                set result 0
242            }
243        } elseif {$result == -2} {
244            fail "$message (timeout)"
245        } elseif {$result == -3} {
246            fail "$message (eof)"
247        } else {
248            fail "$message"
249        }
250    
251        return $result
252    }
253    
254  ### Only procedures should come after this point.  ### Only procedures should come after this point.
255    
256  proc mu_prepare_spools {} {  proc mu_prepare_spools {} {
# Line 306  proc mu_expect_list {args} { Line 479  proc mu_expect_list {args} {
479  }      }    
480    
481  # mu_test COMMAND PATTERN  # mu_test COMMAND PATTERN
482  # COMMAND   - Command to send to mail  # COMMAND   - Command to send to the program
483  # PATTERN   - A list of strings to expect in return  # PATTERN   - A list of strings to expect in return
484  # Return value:  # Return value:
485  #        -3 - eof  #        -3 - eof

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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