add file link constraint

4 files changed, 38 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index 922e6e7..c486328 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-07-08  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+        * tests/cmdAH.test:
+	* tests/fCmd.test:
+	* tests/fileName.test: tests which rely on 'file link' need a
+	constraint so they don't run on older Windows OS. [Bug 578158]
+	
 2002-07-06  Don Porter  <dgp@users.sourceforge.net>
 
 	* tests/pkgMkIndex.test:  Constrained tests of [load] package indexing
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index a8c20ae..b77faea 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.26 2002/07/04 21:47:59 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.27 2002/07/08 08:50:23 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -1536,7 +1536,17 @@ test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
     file delete $linkfile
     set result
 } link
-test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {
+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
+    } else {
+	tcltest::testConstraint linkDirectory 0
+    }
+} else {
+    tcltest::testConstraint linkDirectory 1
+}
+test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {
     set tempdir [makeDirectory temp]
     set linkdir [file join [temporaryDirectory] link.dir]
     file link -symbolic $linkdir $tempdir
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 8891f40..478feb7 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.18 2002/07/02 12:16:05 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.19 2002/07/08 08:50:23 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2163,8 +2163,6 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
     list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
 } {0 {} {}}
 
-tcltest::testConstraint hasLinks 1
-    
 if {[string equal $tcl_platform(platform) "windows"]} {
     if {[string index $tcl_platform(osVersion) 0] >= 5 \
       && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
@@ -2179,19 +2177,19 @@ if {[string equal $tcl_platform(platform) "windows"]} {
     tcltest::testConstraint linkDirectory 1
 }
 
-test fCmd-28.1 {file link} {hasLinks} {
+test fCmd-28.1 {file link} {
     list [catch {file link} msg] $msg
 } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
 
-test fCmd-28.2 {file link} {hasLinks} {
+test fCmd-28.2 {file link} {
     list [catch {file link a b c d} msg] $msg
 } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
 
-test fCmd-28.3 {file link} {hasLinks} {
+test fCmd-28.3 {file link} {
     list [catch {file link abc b c} msg] $msg
 } {1 {bad switch "abc": must be -symbolic or -hard}}
 
-test fCmd-28.4 {file link} {hasLinks} {
+test fCmd-28.4 {file link} {
     list [catch {file link -abc b c} msg] $msg
 } {1 {bad switch "-abc": must be -symbolic or -hard}}
 
diff --git a/tests/fileName.test b/tests/fileName.test
index 9089f93..13620a6 100644
--- a/tests/fileName.test
+++ b/tests/fileName.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: fileName.test,v 1.24 2002/07/05 10:38:42 dkf Exp $
+# RCS: @(#) $Id: fileName.test,v 1.25 2002/07/08 08:50:23 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1175,7 +1175,17 @@ test filename-11.17.1 {Tcl_GlobCmd} {pcOnly macOnly} {
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
 	[file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.17.2 {Tcl_GlobCmd} {notRoot} {
+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
+    } else {
+	tcltest::testConstraint linkDirectory 0
+    }
+} else {
+    tcltest::testConstraint linkDirectory 1
+}
+test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
     set dir [pwd]
     set ret "error in test"
     if {[catch {
@@ -1193,7 +1203,7 @@ test filename-11.17.2 {Tcl_GlobCmd} {notRoot} {
 } [list 0 [lsort [list [file join $globname a1 b1] \
   [file join $globname link b1]]]]
 # Simpler version of the above test to illustrate a given bug.
-test filename-11.17.3 {Tcl_GlobCmd} {notRoot} {
+test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} {
     set dir [pwd]
     set ret "error in test"
     if {[catch {
@@ -1214,7 +1224,7 @@ test filename-11.17.3 {Tcl_GlobCmd} {notRoot} {
   [file join $globname link]]]]
 # Make sure the bugfix isn't too simple.  We don't want
 # to break 'glob -type l'.
-test filename-11.17.4 {Tcl_GlobCmd} {notRoot} {
+test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} {
     set dir [pwd]
     set ret "error in test"
     if {[catch {