# -*- tcl -*-
# pop3_dbox.test: tests for the simple pop3 mail database.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2002 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# RCS: @(#) $Id: pop3d_dbox.test,v 1.4 2004/02/11 07:48:41 andreas_kupries Exp $
if {![package vsatisfies [package provide Tcl] 8.3]} {
return
}
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
if {[catch {source [file join [file dirname [file dirname [info script]]] mime mime.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
if {[catch {source [file join [file dirname [file dirname [info script]]] md5 md5.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
package forget pop3d::dbox
catch {namespace delete ::pop3d::dbox}
if {[catch {source [file join [file dirname [info script]] pop3d_dbox.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
puts "- pop3d::dbox [package present pop3d::dbox]"
puts "- mime [package present mime]"
puts "- md5 [package present md5]"
# Reduce output generated by the server objects
::log::lvSuppress info
::log::lvSuppress notice
::log::lvSuppress debug
::log::lvSuppress warning
# ----------------------------------------------------------------------
test pop3-dbox-1.0 {anon create/destroy} {
set dbox [::pop3d::dbox::new]
$dbox destroy
regsub {[0-9]+$} $dbox {} dbox
set dbox
} p3dbox
test pop3-dbox-1.1 {named create/destroy} {
set dbox [::pop3d::dbox::new foo]
$dbox destroy
set dbox
} foo
test pop3-dbox-1.2 {multiple create} {
::pop3d::dbox::new foo
catch {::pop3d::dbox::new foo} msg
foo destroy
set msg
} {command "foo" already exists, unable to create mailbox database}
test pop3-dbox-1.3 {correct creation, destruction} {
::pop3d::dbox::new foo
set res [list [info exists ::pop3d::dbox::dbox::foo::dir]]
foo destroy
lappend res [info exists ::pop3d::dbox::dbox::foo::dir]
} {1 0}
test pop3-dbox-1.4 {unknown method} {
set dbox [::pop3d::dbox::new]
catch {$dbox foo} res
$dbox destroy
set res
} {bad option "foo": must be add, base, dele, destroy, exists, get, list, lock, locked, move, remove, size, stat, or unlock}
test pop3-dbox-2.0 {initialization} {
set dbox [::pop3d::dbox::new]
catch {$dbox base {}} res
$dbox destroy
set res
} {directory not specified}
test pop3-dbox-2.1 {initialization} {
set dbox [::pop3d::dbox::new]
catch {$dbox base foo} res
$dbox destroy
set res
} {base: "foo" does not exist}
makeFile {} __bar__
test pop3-dbox-2.2 {initialization} {
set dbox [::pop3d::dbox::new]
catch {$dbox base __bar__} res
$dbox destroy
set res
} {base: "__bar__" not a directory}
makeDirectory __dbox__
test pop3-dbox-2.3 {initialization} {
set dbox [::pop3d::dbox::new]
set res [list [$dbox base __dbox__]]
lappend res [$dbox list]
$dbox destroy
set res
} {{} {}}
makeDirectory [file join __dbox__ known]
test pop3-dbox-3.0 {adding mailboxes} {
set dbox [::pop3d::dbox::new]
catch {$dbox add known} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-3.1 {adding mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox add known} res
$dbox destroy
set res
} {cannot add "known", mailbox already in existence}
test pop3-dbox-3.2 {adding mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [file exists [file join __dbox__ usr0]]
$dbox add usr0
lappend res [file exists [file join __dbox__ usr0]]
lappend res [lsort [$dbox list]]
$dbox destroy
set res
} {0 1 {known usr0}}
test pop3-dbox-4.0 {removing mailboxes} {
set dbox [::pop3d::dbox::new]
catch {$dbox remove known} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-4.1 {removing mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox remove usr1} res
$dbox destroy
set res
} {cannot remove "usr1", mailbox does not exist}
test pop3-dbox-4.2 {removing mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [file exists [file join __dbox__ usr0]]
$dbox remove usr0
lappend res [file exists [file join __dbox__ usr0]]
$dbox destroy
set res
} {1 0}
test pop3-dbox-5.0 {renaming mailboxes} {
set dbox [::pop3d::dbox::new]
catch {$dbox move usr0 usr1} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-5.1 {renaming mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox move usr0 usr1} res
$dbox destroy
set res
} {cannot move "usr0", mailbox does not exist}
test pop3-dbox-5.2 {renaming mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
catch {$dbox move usr0 known} res
$dbox remove usr0
$dbox destroy
set res
} {cannot move "usr0", destination "known" already exists}
test pop3-dbox-5.3 {renaming mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
set res {}
lappend res [file exists [file join __dbox__ usr0]]
$dbox move usr0 usr1
lappend res [file exists [file join __dbox__ usr0]]
lappend res [file exists [file join __dbox__ usr1]]
$dbox remove usr1
$dbox destroy
set res
} {1 0 1}
test pop3-dbox-6.0 {existence of mailboxes} {
set dbox [::pop3d::dbox::new]
catch {$dbox exists foo} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-6.1 {existence of mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [$dbox exists foo]
$dbox destroy
set res
} 0
test pop3-dbox-6.2 {existence of mailboxes} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [$dbox exists known]
$dbox destroy
set res
} 1
test pop3-dbox-7.0 {locking} {
set dbox [::pop3d::dbox::new]
catch {$dbox locked foo} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-7.1 {locking} {
set dbox [::pop3d::dbox::new]
catch {$dbox lock foo} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-7.2 {locking} {
set dbox [::pop3d::dbox::new]
catch {$dbox unlock foo} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-7.3 {locking} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [$dbox locked known]
$dbox destroy
set res
} 0
test pop3-dbox-7.4 {locking} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [$dbox locked known]
lappend res [$dbox lock known]
lappend res [$dbox locked known]
$dbox unlock known
lappend res [$dbox locked known]
$dbox destroy
set res
} {0 1 1 0}
test pop3-dbox-7.5 {locking} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
set res [$dbox lock known]
lappend res [$dbox lock known]
$dbox unlock known
lappend res [$dbox locked known]
$dbox destroy
set res
} {1 0 0}
test pop3-dbox-7.6 {locking} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
$dbox lock usr0
catch {$dbox remove usr0} res
$dbox unlock usr0
$dbox remove usr0
$dbox destroy
set res
} {cannot remove "usr0", mailbox is locked}
test pop3-dbox-8.0 {stat} {
set dbox [::pop3d::dbox::new]
catch {$dbox stat known} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-8.1 {stat} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox stat known} res
$dbox destroy
set res
} {mailbox "known" is not locked}
test pop3-dbox-8.2 {stat} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox lock known
set res [$dbox stat known]
$dbox unlock known
$dbox destroy
set res
} 0
test pop3-dbox-8.3 {stat} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {abc} [file join __dbox__ usr0 d]
makeFile {abcdef} [file join __dbox__ usr0 c]
$dbox lock usr0
set res [$dbox stat usr0]
$dbox unlock usr0
$dbox remove usr0
$dbox destroy
set res
} 3
test pop3-dbox-9.0 {size} {
set dbox [::pop3d::dbox::new]
catch {$dbox size known 0} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-9.1 {size} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox size known 0} res
$dbox destroy
set res
} {id "0" out of range}
test pop3-dbox-9.2 {size} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {abc} [file join __dbox__ usr0 d]
makeFile {abcdef} [file join __dbox__ usr0 c]
catch {$dbox size usr0 1} res
$dbox remove usr0
$dbox destroy
set res
} {id "1" out of range}
test pop3-dbox-9.3 {size} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {abc} [file join __dbox__ usr0 b]
makeFile {abcdef} [file join __dbox__ usr0 c]
$dbox lock usr0
set res [$dbox stat usr0]
lappend res [$dbox size usr0 1]
lappend res [$dbox size usr0 2]
lappend res [$dbox size usr0 3]
catch {$dbox size usr0 4} resb
lappend res $resb
$dbox unlock usr0
$dbox remove usr0
$dbox destroy
set res
} {3 1 4 7 {id "4" out of range}}
test pop3-dbox-10.0 {get} {
set dbox [::pop3d::dbox::new]
catch {$dbox get known 0} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-10.1 {get} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox get known 0} res
$dbox destroy
set res
} {id "0" out of range}
test pop3-dbox-10.2 {get} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {abc} [file join __dbox__ usr0 d]
makeFile {abcdef} [file join __dbox__ usr0 c]
catch {$dbox get usr0 1} res
$dbox remove usr0
$dbox destroy
set res
} {id "1" out of range}
test pop3-dbox-10.3 {get} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {} [file join __dbox__ usr0 b]
makeFile {} [file join __dbox__ usr0 c]
$dbox lock usr0
set res [$dbox stat usr0]
lappend res [$dbox get usr0 1]
lappend res [$dbox get usr0 2]
lappend res [$dbox get usr0 3]
catch {$dbox get usr0 4} resb
lappend res $resb
$dbox unlock usr0
$dbox remove usr0
$dbox destroy
regsub -all {::mime::[0-9]+} $res {X} res
set res
} {3 X X X {id "4" out of range}}
test pop3-dbox-11.0 {dele} {
set dbox [::pop3d::dbox::new]
catch {$dbox dele known 0} res
$dbox destroy
set res
} {base directory not specified}
test pop3-dbox-11.1 {dele} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox dele known {}} res
$dbox destroy
set res
} {nothing to delete}
test pop3-dbox-11.2 {dele} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
catch {$dbox dele known 0} res
$dbox destroy
set res
} {id "0" out of range}
test pop3-dbox-11.3 {dele} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {abc} [file join __dbox__ usr0 d]
makeFile {abcdef} [file join __dbox__ usr0 c]
catch {$dbox dele usr0 1} res
$dbox remove usr0
$dbox destroy
set res
} {id "1" out of range}
test pop3-dbox-11.4 {dele} {
set dbox [::pop3d::dbox::new]
$dbox base __dbox__
$dbox add usr0
makeFile {} [file join __dbox__ usr0 a]
makeFile {} [file join __dbox__ usr0 b]
makeFile {} [file join __dbox__ usr0 c]
set res {}
foreach f {a b c} {
lappend res [file exists [file join __dbox__ usr0 $f]]
}
$dbox lock usr0
lappend res [$dbox stat usr0]
$dbox dele usr0 {1 2 3}
foreach f {a b c} {
lappend res [file exists [file join __dbox__ usr0 $f]]
}
# unusable state, wrong information
lappend res [$dbox stat usr0]
catch {$dbox dele usr0 4} resb
lappend res $resb
$dbox unlock usr0
$dbox remove usr0
$dbox destroy
set res
} {1 1 1 3 0 0 0 3 {id "4" out of range}}
# ----------------------------------------------------------------------
::tcltest::cleanupTests
