Test improvements (tcltest2, clarify)

1 files changed, 43 insertions, 47 deletions

diff --git a/tests/winFile.test b/tests/winFile.test
index 0cefcb5..1c33004 100644
--- a/tests/winFile.test
+++ b/tests/winFile.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: winFile.test,v 1.20 2007/12/14 13:52:55 patthoyts Exp $
+# RCS: @(#) $Id: winFile.test,v 1.21 2008/04/10 00:21:02 dkf Exp $
 
 if {[catch {package require tcltest 2.0.2}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -29,65 +29,63 @@ if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
     testConstraint win2000 1
 }
 
-test winFile-1.1 {TclpGetUserHome} {win} {
-    list [catch {glob ~nosuchuser} msg] $msg
-} {1 {user "nosuchuser" doesn't exist}}
-test winFile-1.2 {TclpGetUserHome} {win nt nonPortable} {
+test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
+    glob ~nosuchuser
+} -returnCodes error -result {user "nosuchuser" doesn't exist}
+test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
     # The administrator account should always exist.
-
-    catch {glob ~administrator}
-} {0}
-test winFile-1.3 {TclpGetUserHome} {win 95} {
+    glob ~administrator
+} -match glob -result *
+test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body {
     # Find some user in system.ini and then see if they have a home.
 
     set f [open $::env(windir)/system.ini]
-    set x 0
-    while {![eof $f]} {
-	set line [gets $f]
-	if {$line == "\[Password Lists]"} {
-	    gets $f
-	    set name [lindex [split [gets $f] =] 0]
-	    if {$name != ""} {
-		set x [catch {glob ~$name}]
-		break
-	    }
+    while {[gets $f line] >= 0} {
+	if {$line ne {[Password Lists]}} {
+	    continue
+	}
+	gets $f
+	set name [lindex [split [gets $f] =] 0]
+	if {$name ne ""} {
+	    return [catch {glob ~$name}]
 	}
     }
-    close $f
-    set x
-} {0}
+    return 0 ;# didn't find anything...
+} -cleanup {
+    catch {close $f}
+} -result {0}
 test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
     catch {glob ~stanton@workgroup}
 } {0}
 
-test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
+test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
     makeFile {} GlobCapS
-    set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
+    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]
+} -cleanup {
     removeFile GlobCapS
-    set result
-} {GlobCapS GlobCapS}
-test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
+} -result {GlobCapS GlobCapS}
+test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
     makeFile {} globlower
-    set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
+    list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]
+} -cleanup {
     removeFile globlower
-    set result
-} {globlower globlower}
+} -result {globlower globlower}
 
-test winFile-3.1 {file system} {win testvolumetype} {
-    set res "volume types ok"
+test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
+    set res ""
+} -body {
     foreach vol [file volumes] {
 	# Have to catch in case there is a removable drive (CDROM, floppy)
 	# with nothing in it.
 	catch {
-	    if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
-		set res "For $vol, we found [file system $vol]\
-		  and [testvolumetype $vol] are different"
-		break
+	    if {[lindex [file system $vol] 1] ne [testvolumetype $vol]} {
+		append res "For $vol, we found [file system $vol]\
+			and [testvolumetype $vol] are different\n"
 	    }
 	}
     }
     set res
-} {volume types ok}
+} -result {}
 
 proc cacls {fname args} {
     string trim [eval [list exec cacls [file nativename $fname]] $args <<y]
@@ -107,7 +105,7 @@ proc getuser {fname} {
     }
     set owner ""
     set tail [file tail $tryname]
-    if {[info exists env(OSTYPE)] && [string equal $env(OSTYPE) "msys"]} {
+    if {[info exists env(OSTYPE)] && $env(OSTYPE) eq "msys"} {
         set dirtext [exec ls -l $fname]
         foreach line [split $dirtext "\n"] {
             set owner [lindex $line 2]
@@ -116,21 +114,20 @@ proc getuser {fname} {
         set dirtext [exec cmd /c dir /q [file nativename $fname]]
         foreach line [split $dirtext "\n"] {
             if {[string match -nocase "*$tail" $line]} {
-                set attrs [string range $line \
-                               0 end-[string length $tail]]
+                set attrs [string range $line 0 end-[string length $tail]]
                 regexp { [^ \\]+\\.*$} $attrs owner
                 set owner [string trim $owner]
             }
         }
     }
-    if {[string length $owner] == 0} {
+    if {$owner eq ""} {
 	error "getuser: Owner not found in output of dir/q"
     }
     return $owner
 }
 
 proc test_read {fname} {
-    if {[catch {set ifs [open $fname r]}]} {
+    if {[catch {open $fname r} ifs]} {
 	return 0
     }
     set readfailed [catch {read $ifs}]
@@ -138,7 +135,7 @@ proc test_read {fname} {
 }
 
 proc test_writ {fname} {
-    if {[catch {set ofs [open $fname w]}]} {
+    if {[catch {open $fname w} ofs]} {
 	return 0
     }
     set writefailed [catch {puts $ofs "Hello"}]
@@ -155,11 +152,10 @@ proc test_access {fname read writ} {
 	    lappend problem "[set $type] != \[test_${type} $fname\]"
 	}
     }
-    if {[llength $problem]} {
-	return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
-    } else {
-	return ""
+    if {![llength $problem]} {
+	return
     }
+    return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
 }
 
 # Create the test file