Use test constraints properly instead of looking in tcl_platform

Consistent method of calling test constraints, and (try to) move constraint
setup to the top of the test file

1 files changed, 83 insertions, 87 deletions

diff --git a/tests/fCmd.test b/tests/fCmd.test
index 6d2abc0..00e442a 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.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: fCmd.test,v 1.52 2006/03/20 11:39:03 dkf Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.53 2006/03/21 11:12:29 dkf Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -25,9 +25,26 @@ testConstraint notNetworkFilesystem 0
 testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
 testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
 
+# Find a group that exists on this Unix system, or else skip tests that
+# require Unix groups.
+testConstraint foundGroup [expr {![textConstraint unix]}]
+if {[testConstraint unix]} {
+    catch {
+	set groupList [exec groups]
+	set group [lindex $groupList 0]
+	testConstraint foundGroup 1
+    }
+}
+
+testConstraint fileSharing 0
+testConstraint notFileSharing 1
+testConstraint xdev 0
+testConstraint linkFile 1
+testConstraint linkDirectory 1
+
 # Several tests require need to match results against the unix username
 set user {}
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
     catch {set user [exec whoami]}
     if {$user == ""} {
 	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
@@ -44,7 +61,7 @@ proc createfile {file {string a}} {
     return $string
 }
 
-# 
+#
 # checkcontent --
 #
 #  Ensures that file "file" contains only the string "matchString"
@@ -54,7 +71,7 @@ proc checkcontent {file matchString} {
     if {[catch {
 	set f [open $file]
 	set fileString [read $f]
-	close $f 
+	close $f
     }]} {
 	return 0
     }
@@ -99,12 +116,8 @@ proc contents {file} {
 }
 
 cd [temporaryDirectory]
-testConstraint fileSharing 0
-testConstraint notFileSharing 1
 
-testConstraint xdev 0
-
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
     if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
 	set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
 	set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
@@ -221,10 +234,10 @@ test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
 } {1 {error renaming "/" to "td1": file already exists}}
 test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
     cleanup
-    createfile tf1 
-    createfile tf2 
-    createfile tf3 
-    createfile tf4 
+    createfile tf1
+    createfile tf2
+    createfile tf3
+    createfile tf4
     file mkdir td1
     createfile [file join td1 tf3]
     list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
@@ -359,7 +372,7 @@ test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot}
     set x [file exists tf1]
     file delete tf1
     list $x [file exists tf1]
-} {0 0}    
+} {0 0}
 test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
     cleanup
     file mkdir td1
@@ -533,7 +546,7 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
     file attributes td1 -permissions 0000
     set msg [list [catch {file rename td1 /tmp} msg] $msg]
     file attributes td1 -permissions 0755
-    set msg 
+    set msg
 } {1 {error renaming "td1": permission denied}}
 test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
 	{unix notRoot} {
@@ -687,7 +700,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod}
     file rename tf1 tf3
     file rename tf2 tf4
     list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
-} {{tf3 tf4} 1 0}    
+} {{tf3 tf4} 1 0}
 test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
     cleanup
     file mkdir td1 td2
@@ -695,7 +708,7 @@ test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot te
     file rename td1 td3
     file rename td2 td4
     list [lsort [glob td*]] [file writable td3] [file writable td4]
-} {{td3 td4} 1 0}    
+} {{td3 td4} 1 0}
 test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
     cleanup
     createfile tf1 tf1
@@ -704,7 +717,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
     file rename -force tf1 tf1
     file rename -force tf2 tf2
     list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}    
+} {tf1 tf2 1 0}
 test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
     cleanup
     file mkdir td1
@@ -713,7 +726,7 @@ test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testch
     file rename -force td1 .
     file rename -force td2 .
     list [lsort [glob td*]] [file writable td1] [file writable td2]
-} {{td1 td2} 1 0}    
+} {{td1 td2} 1 0}
 test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
     cleanup
     createfile tf1
@@ -735,7 +748,7 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testc
     file rename -force tfs2 tfd2
     file rename -force tfs3 tfd3
     file rename -force tfs4 tfd4
-    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
 } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
 test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     cleanup
@@ -753,7 +766,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     file mkdir [file join tdd2 tds2]
     file mkdir [file join tdd3 tds3]
     file mkdir [file join tdd4 tds4]
-    if {$tcl_platform(platform) != "unix"} {
+    if {![testConstraint unix]} {
 	testchmod 555 tds3
 	testchmod 555 tds4
     }
@@ -764,12 +777,12 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     file rename -force tds2 tdd2
     file rename -force tds3 tdd3
     file rename -force tds4 tdd4
-    if {$tcl_platform(platform) != "unix"} {
-	set w3 [file writable [file join tdd3 tds3]]
-	set w4 [file writable [file join tdd4 tds4]]
-    } else {
+    if {[testConstraint unix]} {
 	set w3 0
 	set w4 0
+    } else {
+	set w3 [file writable [file join tdd3 tds3]]
+	set w4 [file writable [file join tdd4 tds4]]
     }
     list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
     [file writable [file join tdd2 tds2]] $w3 $w4
@@ -782,15 +795,15 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
     file mkdir tds2
     file mkdir [file join tdd1 tds1 xxx]
     file mkdir [file join tdd2 tds2 xxx]
-    if {$tcl_platform(platform) != "unix"} {
+    if {![testConstraint unix]} {
 	testchmod 555 tds2
     }
     set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
     set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
-    if {$tcl_platform(platform) != "unix"} {
-	set w2 [file writable tds2]
-    } else {
+    if {[testConstraint unix]} {
 	set w2 0
+    } else {
+	set w2 [file writable tds2]
     }
     list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
 } -match glob -result \
@@ -811,15 +824,15 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot te
     file mkdir td1
     file mkdir td2
     file mkdir td3
-    if {$tcl_platform(platform) != "unix"} {
+    if {![testConstraint unix]} {
 	testchmod 555 td2
     }
     file rename td1 [file join td3 td3]
     file rename td2 [file join td3 td4]
-    if {$tcl_platform(platform) != "unix"} {
-	set w4 [file writable [file join td3 td4]]
-    } else {
+    if {[testConstraint unix]} {
         set w4 0
+    } else {
+	set w4 [file writable [file join td3 td4]]
     }
     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
     [file writable [file join td3 td3]] $w4
@@ -950,7 +963,7 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testch
     file copy -force tfs2 tfd2
     file copy -force tfs3 tfd3
     file copy -force tfs4 tfd4
-    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
 } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
 test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
     cleanup
@@ -973,7 +986,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod}
     set a3 [catch {file copy -force tds2 tdd2}]
     set a4 [catch {file copy -force tds3 tdd3}]
     set a5 [catch {file copy -force tds4 tdd4}]
-    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 
+    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
 } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
 test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
 	{notRoot unixOrPc testchmod} {
@@ -1047,9 +1060,9 @@ test fCmd-10.12 {file rename: rename to empty file name} {
     createfile tf1
     list [catch {file rename tf1 ""} msg] $msg
 } {1 {error renaming "tf1" to "": no such file or directory}}
-cleanup    
+cleanup
 
-# old tests    
+# old tests
 
 test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
     catch {file delete -force -- -tfa1}
@@ -1080,9 +1093,9 @@ test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot}
  } {1}
 test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
     set result [catch {file rename tfa1 tfa2 tfa3}]
     file delete tfa1 tfa2 tfa3
     set result
@@ -1104,7 +1117,7 @@ test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
     file rename tfa1 tfa2 tfad
     set r1 [checkcontent tfad/tfa1 $s1]
     set r2 [checkcontent tfad/tfa2 $s2]
-    
+
     set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
 
     file delete -force tfad
@@ -1188,7 +1201,7 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
     file mkdir tfad
     file mkdir tfad/dir
     set result [catch {file rename tfad tfad/dir}]
-    file delete -force tfad 
+    file delete -force tfad
     set result
 } {1}
 test fCmd-12.8 {renamefile: generic error} {unix notRoot} {
@@ -1260,9 +1273,9 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
  } {1}
 test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
     set result [catch {file copy tfa1 tfa2 tfa3}]
     file delete tfa1 tfa2 tfa3
     set result
@@ -1306,7 +1319,7 @@ test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
 
 #
 # Coverage tests for copyfile()
-# 
+#
 test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
     global env
     set temp $env(HOME)
@@ -1392,7 +1405,7 @@ test fCmd-14.8 {copyfile: copy directory failing} {unix notRoot} {
 test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
     global env
     set temp $env(HOME)
-    unset env(HOME) 
+    unset env(HOME)
     set result [catch {file mkdir ~/tfa}]
     set env(HOME) $temp
     set result
@@ -1515,7 +1528,7 @@ test fCmd-16.9 {error while deleting file } {unix notRoot} {
     file attributes tfa -permissions 0555
     set result [catch  {file delete tfa/a }]
     #######
-    #######  If any directory in a tree that is being removed does not 
+    #######  If any directory in a tree that is being removed does not
     #######  have write permission, the process will fail!
     #######  This is also the case with "rm -rf"
     #######
@@ -1710,7 +1723,7 @@ test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
 
     file mkdir tfa1/a/b/c/d
     file mkdir tfa2
-    set f [file join [pwd] tfa1/a/b] 
+    set f [file join [pwd] tfa1/a/b]
     set f2 [file join [pwd] {tfa2/b alias}]
     file link -symbolic $f2 $f
     file rename {tfa2/b alias/c} tfa3
@@ -1738,7 +1751,7 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unix notRoot} {
 
     file mkdir tfa1
     file link -symbolic tfalink tfa1
-    file delete tfa1 
+    file delete tfa1
     file rename tfalink tfa2
     set result [expr [string compare [file type tfa2] "link"] == 0]
     file delete tfa2
@@ -1773,7 +1786,7 @@ test fCmd-19.3 {recursive remove} {notRoot} {
 } {0}
 
 #
-# TclUnixDeleteFile and TraversalDelete are covered by tests from the 
+# TclUnixDeleteFile and TraversalDelete are covered by tests from the
 # TclDeleteFilesCmd suite
 #
 #
@@ -1806,7 +1819,7 @@ test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034
 
 #
 # Feature testing for TclCopyFilesCmd
-# 
+#
 test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
     catch {file delete -force -- tfa1 tfa2}
     set s [createfile tfa1]
@@ -1835,9 +1848,9 @@ test fCmd-21.3 {copy : single file into directory  } {notRoot} {
 test fCmd-21.4 {copy : more than one source and target is not a directory} \
 	{notRoot} {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
     set result [catch {file copy tfa1 tfa2 tfa3}]
     file delete tfa1 tfa2 tfa3
     set result
@@ -1874,7 +1887,7 @@ test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unix notRoot dontCopyL
     file link -symbolic tfalink tfad1
     file delete tfad1
     set result [list [catch {file copy tfalink tfalink2} msg] $msg]
-    file delete -force tfalink tfalink2 
+    file delete -force tfalink tfalink2
     set result
 } {1 {error copying "tfalink": the target of this link doesn't exist}}
 test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
@@ -1883,7 +1896,7 @@ test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
     file delete tfad1
     file copy tfalink tfalink2
     set result [string match [file type tfalink2] link]
-    file delete tfalink tfalink2 
+    file delete tfalink tfalink2
     set result
 } {1}
 test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unix notRoot dontCopyLinks} {
@@ -1959,10 +1972,10 @@ test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot}
 } {1}
 test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {unix notRoot} {
     catch {file delete -force -- tfa1}
-    set s [createfile tfa1]	
+    set s [createfile tfa1]
     file rename -force tfa1 tfa1
     set result [checkcontent tfa1 $s]
-    file delete tfa1 
+    file delete tfa1
     set result
 } {1}
 test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
@@ -2012,12 +2025,12 @@ test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
     file mkdir [file join tfad dir]
 
     set result [catch {file delete tfad}]
-    file delete -force tfad 
+    file delete -force tfad
     set result
 } {1}
 
 #
-# TclMacDeleteFile	
+# TclMacDeleteFile
 # Error cases are not covered.
 #
 test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
@@ -2089,7 +2102,7 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unix notRoot} {
 
     set r1 [file isdir tfad1]
     set r2 [file exists tfad2]
-    
+
     set result [expr $r1 && !$r2]
     file delete tfad1
     set result
@@ -2104,7 +2117,7 @@ test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unix notRoot} {
 
     set r1 [file exists tfad1]
     set r2 [file exists tfad2]
-    
+
     set result [expr !$r1 && !$r2]
     set result
 } {1}
@@ -2125,18 +2138,6 @@ test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
     set attrs [file attributes foo.tmp]
     list [catch {file attributes foo.tmp {expand}[lindex $attrs 0]}] [file delete -force -- foo.tmp]
 } {0 {}}
-# Find a group that exists on this Unix system, or else skip tests that
-# require Unix groups.
-if {$tcl_platform(platform) == "unix"} {
-    ::tcltest::testConstraint foundGroup 0
-    catch {
-	set groupList [exec groups]
-	set group [lindex $groupList 0]
-	::tcltest::testConstraint foundGroup 1
-    }
-} else {
-    ::tcltest::testConstraint foundGroup 1
-}
 test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
     catch {file delete -force -- foo.tmp}
     createfile foo.tmp
@@ -2150,18 +2151,13 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
     list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
 } {0 {} {}}
 
-if {[string equal $tcl_platform(platform) "windows"]} {
-    if {[string index $tcl_platform(osVersion) 0] >= 5 \
-      && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
-	tcltest::testConstraint linkDirectory 1
-	tcltest::testConstraint linkFile 1
-    } else {
-	tcltest::testConstraint linkDirectory 0
-	tcltest::testConstraint linkFile 0
-    }
-} else {
-    tcltest::testConstraint linkFile 1
-    tcltest::testConstraint linkDirectory 1
+if {
+    [testConstraint win] &&
+    ([string index $tcl_platform(osVersion) 0] < 5
+     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
+} then {
+    testConstraint linkDirectory 0
+    testConstraint linkFile 0
 }
 
 test fCmd-28.1 {file link} {