win: fix several test-cases for windows platform

3 files changed, 47 insertions, 23 deletions

diff --git a/tests/fileName.test b/tests/fileName.test
index d224011..0851e94 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -770,6 +770,7 @@ test filename-11.16 {Tcl_GlobCmd} {
 
 set globname "globTest"
 set horribleglobname "glob\[\{Test"
+set tildeglobname "./~test.txt"
 
 test filename-11.17 {Tcl_GlobCmd} {unix} {
     list [catch {lsort [glob -directory $globname *]} msg] $msg
@@ -940,11 +941,11 @@ test filename-11.21.1 {Tcl_GlobCmd} {
 
 # Get rid of file/dir if it exists, since it will have
 # been left behind by a previous failed run.
-if {[file exists $horribleglobname]} {
-    file delete -force $horribleglobname
-}
+file delete -force $horribleglobname
 file rename globTest $horribleglobname
 set globname $horribleglobname
+file delete -force $tildeglobname
+close [open $tildeglobname w]
 
 test filename-11.22 {Tcl_GlobCmd} {unix} {
     list [catch {lsort [glob -dir $globname *]} msg] $msg
@@ -1067,7 +1068,9 @@ test filename-11.41 {Tcl_GlobCmd} {
 test filename-11.42 {Tcl_GlobCmd} {
     set res [list]
     foreach f [glob -dir [pwd] *] {
-	lappend res [file tail $f]
+	set f [file tail $f]
+	regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention).
+	lappend res $f
     }
     expr {$res == [glob *]}
 } {1}
@@ -1109,8 +1112,9 @@ test filename-11.49 {Tcl_GlobCmd} {
 } {1 {bad argument to "-types": abcde}}
 
 file rename $horribleglobname globTest
+file delete -force $tildeglobname
 set globname globTest
-unset horribleglobname
+unset horribleglobname tildeglobname
 
 test filename-12.1 {simple globbing} {unixOrPc} {
     list [catch {glob {}} msg] $msg
diff --git a/tests/tcltest.test b/tests/tcltest.test
index ce8d617..d513856 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -549,8 +549,9 @@ switch -- $::tcl_platform(platform) {
 	file attributes $notWriteableDir -permissions 00555
     }
     default {
+	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
 	catch {file attributes $notWriteableDir -readonly 1}
-	catch {testchmod 000 $notWriteableDir}
+	catch {testchmod 0 $notWriteableDir}
     }
 }
 test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
@@ -565,9 +566,10 @@ test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
 # This constraint doesn't go at the top of the file so that it doesn't
 # interfere with tcltest-5.5
 testConstraint notFAT [expr {
-    ![string match "FAT*" [lindex [file system $notWriteableDir] 1]]
+       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
+    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
 }]
-# FAT permissions are fairly hopeless; ignore this test if that FS is used
+# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
 test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
     -constraints {unixOrPc notRoot notFAT}
     -body {
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index f0cb406..b3fd921 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -17,6 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 # Initialise the test constraints
 
+testConstraint winVista 0
+testConstraint winXP 0
 testConstraint testvolumetype [llength [info commands testvolumetype]]
 testConstraint testfile       [llength [info commands testfile]]
 testConstraint testchmod      [llength [info commands testchmod]]
@@ -50,20 +52,25 @@ proc cleanup {args} {
     }
 }
 
+if {[testConstraint win]} {
+    set major [string index $tcl_platform(osVersion) 0]
+    if {$major > 5} {
+	testConstraint winVista 1
+    } elseif {$major == 5} {
+	testConstraint winXP 1
+    }
+}
+
 # find a CD-ROM so we can test read-only filesystems.
 
 proc findfile {dir} {
-    foreach p [glob -directory $dir *] {
-        if {[file type $p] == "file"} {
-	    return $p
-	}
+    foreach p [glob -nocomplain -type f -directory $dir *] {
+	return $p
     }
-    foreach p [glob -directory $dir *] {
-        if {[file type $p] == "directory"} {
-	    set f [findfile $p]
-	    if {$f != ""} {
-	        return $f
-	    }
+    foreach p [glob -nocomplain -type d -directory $dir *] {
+	set f [findfile $p]
+	if {$f ne ""} {
+	    return $f
 	}
     }
     return ""
@@ -71,7 +78,7 @@ proc findfile {dir} {
 
 if {[testConstraint testvolumetype]} {
     foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
-        if {![catch {testvolumetype ${p}:} result] && $result eq "CDFS"} {
+        if {![catch {testvolumetype ${p}:} result] && $result in {CDFS UDF}} {
             set cdrom ${p}:
 	    set cdfile [findfile $cdrom]
 	    testConstraint cdrom 1
@@ -893,11 +900,22 @@ test winFCmd-12.4 {ConvertFileNameFormat} {win} {
 test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {win} {
     list [file attributes / -longname] [file attributes \\ -longname]
 } {/ /}
-test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {win} {
+test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
     catch {file delete -force -- c:/td1}
-    close [open c:/td1 w]
-    list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
-} {0 c:/td1 {}}
+} -constraints {win winXP} -body {
+    createfile c:/td1 {}
+    string tolower [file attributes c:/td1 -longname]
+} -cleanup {
+    file delete -force -- c:/td1
+} -result {c:/td1}
+test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
+    catch {file delete -force -- $::env(TEMP)/td1}
+} -constraints {win} -body {
+    createfile $::env(TEMP)/td1 {}
+    string tolower [file attributes $::env(TEMP)/td1 -longname]
+} -cleanup {
+    file delete -force -- $::env(TEMP)/td1
+} -result [string tolower [file normalize $::env(TEMP)]/td1]
 test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable win} {
     string tolower [file attributes //bisque/tcl/ws -longname]
 } {//bisque/tcl/ws}