Small fixes to quell tests that fail on some kinds of Win systems

2 files changed, 112 insertions, 84 deletions

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 3f12dd2..031d152 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.54 2006/10/01 13:03:56 patthoyts Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.55 2007/01/18 22:09:44 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -1161,16 +1161,13 @@ test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
 test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
     # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
     # On other platforms, just use a file in the local directory.
-
     if {[testConstraint unix]} {
 	set name /tmp/tcl.test.[pid]
     } else {
 	set name [file join [temporaryDirectory] tf]
     }
-
     # Make sure that a new file's time is correct.  10 seconds variance
     # is allowed used due to slow networks or clock skew on a network drive.
-
     file delete -force $name
     close [open $name w]
     set a [expr abs([clock seconds]-[file mtime $name])<10]
@@ -1230,7 +1227,6 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
 } 1
 removeFile touch.me
 rename waitForEvenSecondForFAT {}
-
 test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
     set name [file join [temporaryDirectory] clockchange]
     file delete -force $name
@@ -1241,21 +1237,19 @@ test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
     file delete $name
     expr {$newmtime == $time ? 1 : "$newmtime != $time"}
 } {1}
-
 # bug 1420432: setting mtime fails for directories on windows.
-test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} {
+test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
     set dirname [file join [temporaryDirectory] tmp[pid]]
     file delete -force $dirname
+} -constraints tempNotWin -body {
     file mkdir $dirname
-    set res [catch {
-        set old [file mtime $dirname]
-        file mtime $dirname 0
-        set new [file mtime $dirname]
-        list $new [expr {$old != $new}]
-    } err]
+    set old [file mtime $dirname]
+    file mtime $dirname 0
+    set new [file mtime $dirname]
+    list $new [expr {$old != $new}]
+} -cleanup {
     file delete -force $dirname
-    list $res $err
-} {0 {0 1}}
+} -result {0 1}
 
 # owned
 
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 421a777..637612d 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -2,13 +2,13 @@
 # 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) 1998-1999 by Scriptics Corporation. 
+# Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.54 2006/10/09 19:15:45 msofer Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.55 2007/01/18 22:09:44 dkf Exp $
 
-# Note that there are several places where the value of 
+# Note that there are several places where the value of
 # tcltest::currentFailure is stored/reset in the -setup/-cleanup
 # of a test that has a body that runs [test] that will fail.
 # This is a workaround of using the same tcltest code that we are
@@ -16,7 +16,7 @@
 #
 # It would be better to have the -body of the tests run the tcltest
 # commands in a slave interp so the [test] being tested would not
-# interfere with the [test] doing the testing.  
+# interfere with the [test] doing the testing.
 #
 
 if {[catch {package require tcltest 2.1}]} {
@@ -53,7 +53,7 @@ testConstraint exec [llength [info commands exec]]
 test tcltest-1.1 {tcltest -help} {exec} {
     set result [catch {exec [interpreter] test.tcl -help} msg]
     list $result [regexp Usage $msg]
-} {1 1} 
+} {1 1}
 test tcltest-1.2 {tcltest -help -something} {exec} {
     set result [catch {exec [interpreter] test.tcl -help -something} msg]
     list $result [regexp Usage $msg]
@@ -61,7 +61,7 @@ test tcltest-1.2 {tcltest -help -something} {exec} {
 test tcltest-1.3 {tcltest -h} {exec} {
     set result [catch {exec [interpreter] test.tcl -h} msg]
     list $result [regexp Usage $msg]
-} {1 0} 
+} {1 0}
 
 # -verbose, implicit & explicit testing of [verbose]
 proc slave {msgVar args} {
@@ -528,29 +528,28 @@ set normaldirectory [makeDirectory normaldirectory]
 normalizePath normaldirectory
 
 # -tmpdir, [temporaryDirectory]
-test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
+test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup {
     file delete -force thisdirectorydoesnotexist
+} -body {
     slave msg $a -tmpdir thisdirectorydoesnotexist
-    list [file exists [file join thisdirectorydoesnotexist a.tmp]] \
-	    [file delete -force thisdirectorydoesnotexist] 
-} {1 {}}
+    file exists [file join thisdirectorydoesnotexist a.tmp]
+} -cleanup {
+    file delete -force thisdirectorydoesnotexist
+} -result 1
 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
     -constraints unixOrPc
     -body {
 	slave msg $a -tmpdir $tdiaf
-	set msg
+	return $msg
     }
     -result {*not a directory*}
     -match glob
 }
-
 # Test non-writeable directories, non-readable directories with directory flags
 set notReadableDir [file join [temporaryDirectory] notreadable]
 set notWriteableDir [file join [temporaryDirectory] notwriteable]
-
 makeDirectory notreadable
 makeDirectory notwriteable
-
 switch -- $::tcl_platform(platform) {
     "unix" {
 	file attributes $notReadableDir -permissions 00333
@@ -561,25 +560,44 @@ switch -- $::tcl_platform(platform) {
 	catch {testchmod 000 $notWriteableDir}
     }
 }
-
-test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unix notRoot} {
-    slave msg $a -tmpdir $notReadableDir 
-    string match {*not readable*} $msg
-} {1}
-
-test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc notRoot} {
-    slave msg $a -tmpdir $notWriteableDir
-    string match {*not writeable*} $msg
-} {1}
-
-test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
-    slave msg $a -tmpdir $normaldirectory
-    # The join is necessary because the message can be split on multiple lines
-    list [file exists [file join $normaldirectory a.tmp]] \
-	    [file delete [file join $normaldirectory a.tmp]] 
-} {1 {}}   
+test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
+    -constraints {unix notRoot}
+    -body {
+	slave msg $a -tmpdir $notReadableDir
+	return $msg
+    }
+    -result {*not readable*}
+    -match glob
+}
+# This constraint doesn't go at the top of the file so that it doesn't
+# interfere with tcltest-5.5
+testConstraint notFAT [expr {
+    ![string match "FAT*" [lindex [file system $notWriteableDir] 1]]
+}]
+# FAT permissions are fairly hopeless; ignore this test if that FS is used
+test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
+    -constraints {unixOrPc notRoot notFAT}
+    -body {
+	slave msg $a -tmpdir $notWriteableDir
+	return $msg
+    }
+    -result {*not writeable*}
+    -match glob
+}
+test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -tmpdir $normaldirectory
+	# The join is necessary because the message can be split on multiple
+	# lines
+	file exists [file join $normaldirectory a.tmp]
+    }
+    -cleanup {
+	catch {file delete [file join $normaldirectory a.tmp]}
+    }
+    -result 1
+}
 cd [workingDirectory]
-
 test tcltest-8.6 {temporaryDirectory}  {
     -setup {
 	set old $::tcltest::temporaryDirectory
@@ -596,7 +614,6 @@ test tcltest-8.6 {temporaryDirectory}  {
 	set ::tcltest::temporaryDirectory $old
     }
 }
-
 test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
     set old $::tcltest::temporaryDirectory
     set ::tcltest::temporaryDirectory $normaldirectory
@@ -608,35 +625,53 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
 } -cleanup {
     set ::tcltest::temporaryDirectory $old
 } -result [list $normaldirectory [workingDirectory] [workingDirectory]]
-
 cd [temporaryDirectory]
 # -testdir, [testsDirectory]
-test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
-    file delete -force thisdirectorydoesnotexist
-    slave msg $a -testdir thisdirectorydoesnotexist
-    string match "*does not exist*" $msg
-} {1}
-
-test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
-    slave msg $a -testdir $tdiaf
-    string match "*not a directory*" $msg 
-} {1}
-
-test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unix notRoot} {
-    slave msg $a -testdir $notReadableDir 
-    string match {*not readable*} $msg
-} {1}
-
-
-test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} {
-    slave msg $a -testdir $normaldirectory
-    # The join is necessary because the message can be split on multiple lines
-    list [string first "testdir: $normaldirectory" [join $msg]] \
-	    [file exists [file join [temporaryDirectory] a.tmp]] \
-	    [file delete [file join [temporaryDirectory] a.tmp]] 
-} {0 1 {}} 
+test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
+    -constraints unixOrPc
+    -setup {
+	file delete -force thisdirectorydoesnotexist
+    }
+    -body {
+	slave msg $a -testdir thisdirectorydoesnotexist
+	return $msg
+    }
+    -match glob
+    -result {*does not exist*}
+}
+test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -testdir $tdiaf
+	return $msg
+    }
+    -match glob
+    -result {*not a directory*}
+}
+test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
+    -constraints {unix notRoot}
+    -body {
+	slave msg $a -testdir $notReadableDir
+	return $msg
+    }
+    -match glob
+    -result {*not readable*}
+}
+test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -testdir $normaldirectory
+	# The join is necessary because the message can be split on multiple
+	# lines
+	list [string first "testdir: $normaldirectory" [join $msg]] \
+	    [file exists [file join [temporaryDirectory] a.tmp]]
+    }
+    -cleanup {
+	file delete [file join [temporaryDirectory] a.tmp]
+    }
+    -result {0 1}
+}
 cd [workingDirectory]
-
 set current [pwd]
 test tcltest-8.14 {testsDirectory} {
     -setup {
@@ -654,7 +689,6 @@ test tcltest-8.14 {testsDirectory} {
 	set ::tcltest::testsDirectory $old
     }
 }
-
 # [workingDirectory]
 test tcltest-8.60 {::workingDirectory}  {
     -setup {
@@ -667,7 +701,7 @@ test tcltest-8.60 {::workingDirectory}  {
 	set f1 [workingDirectory]
 	set f2 [pwd]
 	set f3 [workingDirectory $current]
-	set f4 [pwd] 
+	set f4 [pwd]
 	set f5 [workingDirectory]
 	list $f1 $f2 $f3 $f4 $f5
     }
@@ -705,7 +739,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
     testsDirectory [file dirname [info script]]
 } -body {
     slave msg [file join [testsDirectory] all.tcl] -file d*.test
-    set msg
+    return $msg
 } -cleanup {
     testsDirectory $old
 } -match regexp -result {dstring\.test}
@@ -814,17 +848,17 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
 removeFile makecore.tcl
 
 # -load, -loadfile, [loadScript], [loadFile]
-set contents { 
+set contents {
     package require tcltest
     namespace import tcltest::*
     puts [outputChannel] $::tcltest::loadScript
     exit
-} 
+}
 set loadfile [makeFile $contents load.tcl]
 
 test tcltest-12.1 {-load xxx} {unixOrPc} {
     slave msg $loadfile -load xxx
-    set msg
+    return $msg
 } {xxx}
 
 # Using child process because of -debug usage.
@@ -915,7 +949,7 @@ test tcltest-14.1 {-singleproc - single process} {
     -constraints {unixOrPc}
     -body {
 	slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
-	set msg
+	return $msg
     }
     -result {Test file error: can't unset .foo.: no such variable}
     -match regexp
@@ -925,7 +959,7 @@ test tcltest-14.2 {-singleproc - multiple process} {
     -constraints {unixOrPc}
     -body {
 	slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
-	set msg
+	return $msg
     }
     -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
     -match regexp
@@ -1769,7 +1803,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
     } test.tcl
 } -body {
     slave msg [file join [temporaryDirectory] test.tcl]
-    set msg
+    return $msg
 } -cleanup {
     removeFile test.tcl
 } -match glob -result {*
@@ -1789,7 +1823,7 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
     } test.tcl
 } -body {
     slave msg [file join [temporaryDirectory] test.tcl]
-    set msg
+    return $msg
 } -cleanup {
     removeFile test.tcl
 } -match glob -result {*