From 11a54cb010fa27ab006f13181b40da00a4f87550 Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Mon, 8 Jul 2002 08:50:22 +0000 Subject: add file link constraint --- ChangeLog | 7 +++++++ tests/cmdAH.test | 14 ++++++++++++-- tests/fCmd.test | 12 +++++------- tests/fileName.test | 18 ++++++++++++++---- 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 + + * 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 * 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 { -- cgit v0.12