# -*- 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 # All rights reserved. # # RCS: @(#) $Id: pop3d_dbox.test,v 1.2 2003/05/01 22:40:17 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } 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]" # ---------------------------------------------------------------------- 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