Assorted improvements to make better use of tcltest2

1 files changed, 128 insertions, 124 deletions

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 44316c5..79d7b4f 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.57 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.58 2008/04/23 15:44:37 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -30,75 +30,89 @@ global env
 set cmdAHwd [pwd]
 catch {set platform [testgetplatform]}
 
-test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
-    list [catch {break foo} msg] $msg
-} {1 {wrong # args: should be "break"}}
+test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
+    break foo
+} -returnCodes error -result {wrong # args: should be "break"}
 test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
     list [catch {break} msg] $msg
 } {3 {}}
 
 # Tcl_CaseObjCmd is tested in case.test
 
-test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
-    list [catch {catch} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
+    catch
+} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
 test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
     list [catch {catch foo bar baz} msg] $msg
 } {0 1}
-test cmdAH-1.3 {Tcl_CatchObjCmd, errors} {
-    list [catch {catch foo bar baz spaz} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
+    catch foo bar baz spaz
+} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
 
-test cmdAH-2.1 {Tcl_CdObjCmd} {
-    list [catch {cd foo bar} msg] $msg
-} {1 {wrong # args: should be "cd ?dirName?"}}
+test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd foo bar
+} -result {wrong # args: should be "cd ?dirName?"}
 set foodir [file join [temporaryDirectory] foo]
-test cmdAH-2.2 {Tcl_CdObjCmd} {
+test cmdAH-2.2 {Tcl_CdObjCmd} -setup {
     file delete -force $foodir
+    set oldpwd [pwd]
+} -body {
     file mkdir $foodir
     cd $foodir
-    set result [file tail [pwd]]
-    cd ..
+    file tail [pwd]
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
-    set result
-} foo
-test cmdAH-2.3 {Tcl_CdObjCmd} {
+} -result foo
+test cmdAH-2.3 {Tcl_CdObjCmd} -setup {
     global env
     set oldpwd [pwd]
     set temp $env(HOME)
-    set env(HOME) $oldpwd
     file delete -force $foodir
+} -body {
+    set env(HOME) $oldpwd
     file mkdir $foodir
     cd $foodir
     cd ~
-    set result [string equal [pwd] $oldpwd]
+    string equal [pwd] $oldpwd
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
     set env(HOME) $temp
-    set result
-} 1
-test cmdAH-2.4 {Tcl_CdObjCmd} {
+} -result 1
+test cmdAH-2.4 {Tcl_CdObjCmd} -setup {
     global env
     set oldpwd [pwd]
     set temp $env(HOME)
-    set env(HOME) $oldpwd
     file delete -force $foodir
+} -body {
+    set env(HOME) $oldpwd
     file mkdir $foodir
     cd $foodir
     cd
-    set result [string equal [pwd] $oldpwd]
+    string equal [pwd] $oldpwd
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
     set env(HOME) $temp
-    set result
-} 1
-test cmdAH-2.5 {Tcl_CdObjCmd} {
-    list [catch {cd ~~} msg] $msg
-} {1 {user "~" doesn't exist}}
-test cmdAH-2.6 {Tcl_CdObjCmd} {
-    list [catch {cd _foobar} msg] $msg
-} {1 {couldn't change working directory to "_foobar": no such file or directory}}
-test cmdAH-2.6.1 {Tcl_CdObjCmd} {
-    list [catch {cd ""} msg] $msg
-} {1 {couldn't change working directory to "": no such file or directory}}
+} -result 1
+test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd ~~
+} -result {user "~" doesn't exist}
+test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd _foobar
+} -result {couldn't change working directory to "_foobar": no such file or directory}
+test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd ""
+} -result {couldn't change working directory to "": no such file or directory}
+test cmdAH-2.7 {cd} -constraints {unix nonPortable} -setup {
+    set dir [pwd]
+} -body {
+    cd /
+    pwd
+} -cleanup {
+    cd $dir
+} -result {/}
 
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
@@ -110,99 +124,98 @@ test cmdAH-2.9 {Tcl_ConcatObjCmd} {
     concat a {b c}
 } {a b c}
 
-test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
-    list [catch {continue foo} msg] $msg
-} {1 {wrong # args: should be "continue"}}
+test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
+    continue foo
+} -result {wrong # args: should be "continue"}
 test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
     list [catch {continue} msg] $msg
 } {4 {}}
 
-test cmdAH-4.1 {Tcl_EncodingObjCmd} {
-    list [catch {encoding} msg] $msg
-} {1 {wrong # args: should be "encoding option ?arg ...?"}}
-test cmdAH-4.2 {Tcl_EncodingObjCmd} {
-    list [catch {encoding foo} msg] $msg
-} {1 {bad option "foo": must be convertfrom, convertto, dirs, names, or system}}
-test cmdAH-4.3 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertto} msg] $msg
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
-test cmdAH-4.4 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertto foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.5 {Tcl_EncodingObjCmd} {
+test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding
+} -result {wrong # args: should be "encoding option ?arg ...?"}
+test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding foo
+} -result {bad option "foo": must be convertfrom, convertto, dirs, names, or system}
+test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertto
+} -result {wrong # args: should be "encoding convertto ?encoding? data"}
+test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertto foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system jis0208
-    set x [encoding convertto \u4e4e]
+    encoding convertto \u4e4e
+} -cleanup {
     encoding system $system
-    set x
-} 8C
-test cmdAH-4.6 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding convertto jis0208 \u4e4e]
+    encoding convertto jis0208 \u4e4e
+} -cleanup {
     encoding system $system
-    set x
-} 8C
-test cmdAH-4.7 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertfrom} msg] $msg
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
-test cmdAH-4.8 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertfrom foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.9 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertfrom
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
+test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertfrom foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system jis0208
-    set x [encoding convertfrom 8C]
+    encoding convertfrom 8C
+} -cleanup {
     encoding system $system
-    set x
-} \u4e4e
-test cmdAH-4.10 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding convertfrom jis0208 8C]
+    encoding convertfrom jis0208 8C
+} -cleanup {
     encoding system $system
-    set x
-} \u4e4e
-test cmdAH-4.11 {Tcl_EncodingObjCmd} {
-    list [catch {encoding names foo} msg] $msg
-} {1 {wrong # args: should be "encoding names"}}
-test cmdAH-4.12 {Tcl_EncodingObjCmd} {
-    list [catch {encoding system foo bar} msg] $msg
-} {1 {wrong # args: should be "encoding system ?encoding?"}}
-test cmdAH-4.13 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding names foo
+} -result {wrong # args: should be "encoding names"}
+test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding system foo bar
+} -result {wrong # args: should be "encoding system ?encoding?"}
+test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding system]
+    encoding system
+} -cleanup {
     encoding system $system
-    set x
-} identity
-
-test cmdAH-5.1 {Tcl_FileObjCmd} {
-    list [catch file msg] $msg
-} {1 {wrong # args: should be "file option ?arg ...?"}}
-test cmdAH-5.2 {Tcl_FileObjCmd} {
-    list [catch {file x} msg] $msg
-} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-5.3 {Tcl_FileObjCmd} {
-    list [catch {file exists} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
+} -result identity
+
+test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
+    file
+} -result {wrong # args: should be "file option ?arg ...?"}
+test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
+    file x
+} -result {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}
+test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
+    file exists
+} -result {wrong # args: should be "file exists name"}
 test cmdAH-5.4 {Tcl_FileObjCmd} {
-    list [catch {file exists ""} msg] $msg
-} {0 0}
-
-#volume
-
-test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
-    list [catch {file volumes x} msg] $msg
-} {1 {wrong # args: should be "file volumes"}}
-test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
-	set volumeList [file volumes]
-	if { [llength $volumeList] == 0 } {
-		set result 0
-	} else {
-		set result 1
-	}
-} {1}
+    file exists ""
+} 0
+
+# volume
+test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body {
+    file volumes x
+} -result {wrong # args: should be "file volumes"}
+test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body {
+    lindex [file volumes] 0
+} -match glob -result ?*
 test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
     set volumeList [file volumes]
     catch [list glob -nocomplain [lindex $volumeList 0]*]
@@ -212,28 +225,19 @@ test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
     list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
 } {0 1 0}
 
-test cmdAH-6.5 {cd} {unix nonPortable} {
-    set dir [pwd]
-    cd /
-    set res [pwd]
-    cd $dir
-    set res
-} {/}
-
 # attributes
-
-test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {
+test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
     set foofile [makeFile abcde foo.file]
     catch {file delete -force $foofile}
+} -body {
     close [open $foofile w]
-    set res [catch {file attributes $foofile}]
+    catch {file attributes $foofile}
+} -cleanup {
     # We used [makeFile] so we undo with [removeFile]
     removeFile $foofile
-    set res
-} {0}
+} -result {0}
 
 # dirname
-
 test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
     list [catch {file dirname a b} msg] $msg