Skip to content

John McEleney / mailutils

Go to a project
Toggle navigation
Toggle navigation pinning
Commit 41c1f08b 41c1f08b9ffcedc1b97d06cd41b9acc96ce6fbd9 by Sergey Poznyakoff
Options

Added to repository

1 parent 1e3acbf9
Inline Side-by-side
Showing 2 changed files with 365 additions and 0 deletions
# -*- 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
}