summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-11-15 10:33:35 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-11-15 10:33:35 (GMT)
commit7eb1cb2081fb90765972c1a12f0ef5886655b888 (patch)
treeea2c043f66b1ea90cc560a55911fab2cbcc41589
parente7c0967baa5b79e41a0476c37c81cfb9b6c0c5e9 (diff)
downloadtcl-7eb1cb2081fb90765972c1a12f0ef5886655b888.zip
tcl-7eb1cb2081fb90765972c1a12f0ef5886655b888.tar.gz
tcl-7eb1cb2081fb90765972c1a12f0ef5886655b888.tar.bz2
Fix 2 failing tests on Windows 7. Fix backported from Tcl 8.6
-rw-r--r--tests/winFCmd.test64
1 files changed, 35 insertions, 29 deletions
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 6461693..34a9b16 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -15,6 +15,21 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Initialise the test constraints
+
+testConstraint winVista 0
+testConstraint win2000orXP 0
+testConstraint winOlderThan2000 0
+testConstraint testvolumetype [llength [info commands testvolumetype]]
+testConstraint testfile [llength [info commands testfile]]
+testConstraint testchmod [llength [info commands testchmod]]
+testConstraint cdrom 0
+testConstraint exdev 0
+testConstraint longFileNames 0
+
proc createfile {file {string a}} {
set f [open $file w]
puts -nonewline $f $string
@@ -41,23 +56,19 @@ proc cleanup {args} {
}
}
-if {[string equal $tcl_platform(platform) "windows"]} {
- if {[string equal $tcl_platform(os) "Windows NT"] \
- && [string equal [string index $tcl_platform(osVersion) 0] "5"]} {
- tcltest::testConstraint win2000orXP 1
- tcltest::testConstraint winOlderThan2000 0
+if {[testConstraint winOnly]} {
+ set major [string index $tcl_platform(osVersion) 0]
+ if {[testConstraint nt] && $major > 4} {
+ if {$major > 5} {
+ testConstraint winVista 1
+ } elseif {$major == 5} {
+ testConstraint win2000orXP 1
+ }
} else {
- tcltest::testConstraint win2000orXP 0
- tcltest::testConstraint winOlderThan2000 1
+ testConstraint winOlderThan2000 1
}
-} else {
- tcltest::testConstraint win2000orXP 0
- tcltest::testConstraint winOlderThan2000 0
}
-set ::tcltest::testConstraints(cdrom) 0
-set ::tcltest::testConstraints(exdev) 0
-
# find a CD-ROM so we can test read-only filesystems.
set cdrom {}
@@ -737,11 +748,15 @@ test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {pcOnly 95}
file mkdir td1
list [catch {testfile cpdir td1 /} msg] $msg
} {1 {/ EEXIST}}
-test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {pcOnly nt} {
+test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
cleanup
+} -constraints {pcOnly nt} -body {
file mkdir td1
- list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {/ EACCES}}
+ testfile cpdir td1 /
+} -cleanup {
+ cleanup
+ # Windows7 returns EEXIST, XP returns EACCES
+} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} {
cleanup
file mkdir td1
@@ -1069,55 +1084,42 @@ unset d dd pwd
test winFCmd-18.1 {Windows reserved path names} -constraints win -body {
file pathtype com1
} -result "absolute"
-
test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body {
file pathtype com4
} -result "absolute"
-
test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body {
file pathtype com5
} -result "relative"
-
test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body {
file pathtype lpt3
} -result "absolute"
-
test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body {
file pathtype lpt4
} -result "relative"
-
test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body {
file pathtype nul
} -result "absolute"
-
test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body {
file pathtype null
} -result "relative"
-
test winFCmd-18.2 {Windows reserved path names} -constraints win -body {
file pathtype com1:
} -result "absolute"
-
test winFCmd-18.3 {Windows reserved path names} -constraints win -body {
file pathtype COM1
} -result "absolute"
-
test winFCmd-18.4 {Windows reserved path names} -constraints win -body {
file pathtype CoM1:
} -result "absolute"
-
test winFCmd-18.5 {Windows reserved path names} -constraints win -body {
file normalize com1:
} -result COM1
-
test winFCmd-18.6 {Windows reserved path names} -constraints win -body {
file normalize COM1:
} -result COM1
-
test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
file normalize cOm1
} -result COM1
-
test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
file normalize cOm1:
} -result COM1
@@ -1153,3 +1155,7 @@ test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: