fix to small filesystem bugs

FossilOrigin-Name: d6e4847a47e5bbf348c1feb2dc00152162e49889

3 files changed, 38 insertions, 12 deletions

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 06ad91a..2ecb291 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.43 2004/06/23 15:46:45 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.44 2004/09/27 15:00:40 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -358,15 +358,21 @@ test cmdAH-8.44 {Tcl_FileObjCmd: dirname} testsetplatform {
     set env(HOME) $temp
     set result
 } {0 ~}
-test cmdAH-8.45 {Tcl_FileObjCmd: dirname} testsetplatform {
-    global env
-    set temp $env(HOME)
-    set env(HOME) "/homewontexist/test"
-    testsetplatform windows
-    set result [list [catch {file dirname ~} msg] $msg]
-    set env(HOME) $temp
-    set result
-} {0 /homewontexist}
+test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
+    -constraints {Tcltest testsetplatform}
+    -match regexp
+    -body {
+	global env
+	set temp $env(HOME)
+	set env(HOME) "/homewontexist/test"
+	testsetplatform windows
+	set result [list [catch {file dirname ~} msg] $msg]
+	set env(HOME) $temp
+	set result
+    }
+    -result {{0 ([a-zA-Z]:?)/homewontexist}}
+}
+
 test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
     set f [file normalize [info nameof]]
     file exists $f
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index fd4918a..a56e56d 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -539,7 +539,7 @@ test filesystem-5.1 {cache and ~} {
 	set ::env(HOME) $orig
 	list $res1 $res2
     }
-    -result {{Parent of ~ \(/foo/bar/blah\) is (/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is (/a/b|a:b)}}
+    -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
 }
 
 test filesystem-6.1 {empty file name} {
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index dc0edd9..891925e 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.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: winFCmd.test,v 1.33 2004/06/23 21:32:03 patthoyts Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.34 2004/09/27 15:00:42 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1044,6 +1044,26 @@ test winFCmd-16.12 {Windows file normalization} -constraints win -setup {
     cd $oldwd
 } -result ok
 
+test winFCmd-16.13 {Windows bad permissions cd} -constraints win -setup {
+    set oldwd [pwd]
+} -body {
+    set d {}
+    foreach dd {c:/ d:/ e:/} {
+	eval lappend d [glob -nocomplain \
+	  -types hidden -dir $dd "System Volume Information"]
+    }
+    # Old versions of Tcl gave a misleading error that the 
+    # directory in question didn't exist.
+    if {[llength $d] && [catch {cd [lindex $d 0]} err]} {
+	regsub ".*: " $err "" err
+	set err
+    } else {
+        set err "permission denied"
+    }
+} -cleanup {
+    cd $oldwd
+} -result "permission denied"
+
 cd $pwd
 unset d dd pwd