summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2004-09-27 15:00:25 (GMT)
committervincentdarley <vincentdarley>2004-09-27 15:00:25 (GMT)
commit6fcff1d789f4f9d4fb6336668edfaba407b4dddb (patch)
tree4703373dd878abf4d2fcb6ee0fed5febf8af8046 /tests
parentb2ddd5afb45d64091bc8d01b2b113523ffd74d45 (diff)
downloadtcl-6fcff1d789f4f9d4fb6336668edfaba407b4dddb.zip
tcl-6fcff1d789f4f9d4fb6336668edfaba407b4dddb.tar.gz
tcl-6fcff1d789f4f9d4fb6336668edfaba407b4dddb.tar.bz2
fix to small filesystem bugs
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdAH.test26
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/winFCmd.test22
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