Added to repository

+mailutils.exp

+# -*- tcl -*-
+# This file is part of Mailutils testsuite.
+# Copyright (C) 2002, Free Software Foundation
+#  
+# This program 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.
+#   
+# This program 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 this program; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 
+
+verbose "STARTED" 1
+
+proc mu_init {} {
+    global TOOL_EXECUTABLE
+    global MU_TOOL
+    global MU_SPOOL_SOURCE 
+    global MU_FOLDER_SOURCE
+    global MU_SPOOL_DIR 
+    global MU_FOLDER_DIR
+    global MU_RC_DIR 
+    global MU_MAKESPOOL
+    global TOOL_NAME
+    global MU_TOOL_ARGS
+    global base_dir
+    global top_srcdir
+    global objdir
+    global host_board
+    
+    if [info exists TOOL_EXECUTABLE] {
+	set MU_TOOL $TOOL_EXECUTABLE
+    }
+
+    if ![info exists MU_TOOL] {
+	if ![is_remote host] {
+	    set MU_TOOL [findfile $base_dir/../$TOOL_NAME "$base_dir/../$TOOL_NAME" [transform $TOOL_NAME]]
+	    set MU_SPOOL_SOURCE "$top_srcdir/testsuite/spool"
+	    set MU_FOLDER_SOURCE "$top_srcdir/testsuite/folder"
+	    set MU_SPOOL_DIR "$objdir/data/spool"
+	    set MU_FOLDER_DIR "$objdir/data/folder"
+	    set MU_RC_DIR "$top_srcdir/testsuite/etc"
+	    set MU_MAKESPOOL "$top_srcdir/testsuite/makespool"
+	} else {
+	    if [info exists host_board] {
+		if [board_info $host_board exists top_builddir] {
+		    append MU_TOOL "[board_info $host_board top_builddir]/$TOOL_NAME/$TOOL_NAME"
+		} elseif [board_info $host_board exists top_srcdir] {
+		    append MU_TOOL "[board_info $host_board top_srcdir]/$TOOL_NAME/$TOOL_NAME"
+	        }
+	    }
+
+	    if ![info exists MU_TOOL] {
+		perror "The test suite is not set up for the remote testing"
+	        perror "Please, read file README in $TOOL_NAME/testsuite subdirectory"
+	        perror "for instructions on how to set up it."
+	        exit 1
+	    }
+	    set MU_RC_DIR "[board_info $host_board top_srcdir]/etc"
+	    set MU_SPOOL_SOURCE "[board_info $host_board top_srcdir]/spool"
+	    set MU_FOLDER_SOURCE "[board_info $host_board top_srcdir]/folder" 
+	    set MU_SPOOL_DIR "[board_info $host_board objdir]/data/spool"
+	    set MU_FOLDER_DIR "[board_info $host_board objdir]/data/folder"
+	    set MU_MAKESPOOL "[board_info $host_board top_srcdir]/makespool"
+	}
+    }
+}
+    
+### Only procedures should come after this point.
+
+proc mu_prepare_spools {} {
+    global MU_SPOOL_SOURCE
+    global MU_SPOOL_DIR
+    global MU_FOLDER_SOURCE
+    global MU_FOLDER_DIR
+    global MU_MAKESPOOL
+
+    set output [remote_exec host "$MU_MAKESPOOL \
+		    $MU_SPOOL_SOURCE $MU_SPOOL_DIR\
+	            $MU_FOLDER_SOURCE $MU_FOLDER_DIR"]
+}
+
+proc mu_cleanup_spools {} {
+    global MU_SPOOL_SOURCE
+    global MU_SPOOL_DIR
+    global MU_FOLDER_SOURCE
+    global MU_FOLDER_DIR
+    global MU_MAKESPOOL
+
+    if { $MU_SPOOL_SOURCE != $MU_SPOOL_DIR } {
+	set output [remote_exec host "$MU_MAKESPOOL -r \
+		    $MU_SPOOL_DIR $MU_FOLDER_DIR"]
+    }
+}
+	    
+proc mu_version {} {
+    global MU_TOOL
+    global MU_TOOL_FLAGS
+    global MU_TOOL_VERSION
+
+    if [info exists MU_TOOL_VERSION] {
+	return
+    }
+    
+    set output [remote_exec host "$MU_TOOL --version"]
+    regexp " \[0-9\]\[^ \t\n\r\]+" "$output" MU_TOOL_VERSION
+}
+
+##
+
+proc mu_send { string } {
+    global suppress_flag;
+    if {[info exists suppress_flag] && $suppress_flag} {
+	return "suppressed";
+    }
+    return [remote_send host "$string"]
+}
+
+proc mu_command { cmd } {
+    set res [mu_send "$cmd\n"]
+    mu_expect 30 {
+	-ex "\r\n" { }
+	default {
+	    perror "mu_command for target failed";
+	    return -1
+	}
+    }
+    return $res
+}
+
+proc mu_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 mailutils,timeout] {
+	    if [info exists timeout] {
+		if { $timeout < [target_info mailutils,timeout] } {
+		    set gtimeout [target_info mailutils,timeout];
+		} else {
+		    set gtimeout $timeout;
+		}
+	    } else {
+		set gtimeout [target_info mailutils,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
+    }
+}
+
+# mu_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 mu_test { args } {
+    global verbose
+    global suppress_flag
+    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 { [mu_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
+	mu_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
+		}
+		mu_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
+}
+
+proc mu_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 [mu_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
+}
+    
+