From 7eb1cb2081fb90765972c1a12f0ef5886655b888 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 15 Nov 2012 10:33:35 +0000
Subject: Fix 2 failing tests on Windows 7. Fix backported from Tcl 8.6

---
 tests/winFCmd.test | 64 +++++++++++++++++++++++++++++-------------------------
 1 file 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:
-- 
cgit v0.12