summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2004-12-02 18:49:21 (GMT)
committervincentdarley <vincentdarley>2004-12-02 18:49:21 (GMT)
commite05bd52770456e6db2d99f2112bb78fae3619235 (patch)
tree81352b7f5a8f339ceca27e7930069261d4b1712e
parentdaaaa7768cb634eed14f66460b8fdf6d85d719c1 (diff)
downloadtcl-e05bd52770456e6db2d99f2112bb78fae3619235.zip
tcl-e05bd52770456e6db2d99f2112bb78fae3619235.tar.gz
tcl-e05bd52770456e6db2d99f2112bb78fae3619235.tar.bz2
filesystem, glob, tilde fix
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclPathObj.c18
-rw-r--r--tests/fileSystem.test51
3 files changed, 74 insertions, 1 deletions
diff --git a/ChangeLog b/ChangeLog
index a1f37f0..cf54053 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-12-02 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclPathObj.c: fix and new tests for [Bug 1074671] to
+ * tests/fileSystem.test: ensure tilde paths are not returned
+ specially by 'glob'.
+
2004-12-02 Kevin B. Kenny <kennykb@acm.org>
* win/Makefile.in: Added a 'sed' in the setting of ROOT_DIR_NATIVE
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 2ed8eed..54116a9 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -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: tclPathObj.c,v 1.38 2004/11/22 12:53:06 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.39 2004/12/02 18:49:21 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -1232,6 +1232,12 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
* inside the directory. Returns a Tcl_Obj representing filename
* of the path relative to the directory.
*
+ * In the case where the resulting path would start with a '~', we
+ * take special care to return an ordinary string. This means to
+ * use that path (and not have it interpreted as a user name),
+ * one must prepend './'. This may seem strange, but that is how
+ * 'glob' is currently defined.
+ *
* Results:
* NULL on error, otherwise a valid object, typically with
* refCount of zero, which it is assumed the caller will
@@ -1273,6 +1279,16 @@ TclFSMakePathRelative(interp, pathPtr, cwdPtr)
}
TclFreeIntRep(pathPtr);
}
+ /* Now pathPtr is a string object */
+
+ if (Tcl_GetString(pathPtr)[0] == '~') {
+ /*
+ * If the first character of the path is a tilde,
+ * we must just return the path as is, to agree
+ * with the defined behaviour of 'glob'.
+ */
+ return pathPtr;
+ }
fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 17cc0dd..47526de 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -920,6 +920,57 @@ test filesystem-9.6 {path objects and file tail and object rep} {winOnly} {
file isdirectory $p
lappend res [file join $p toto]
} {C:/toto/toto C:/toto/toto}
+test filesystem-9.7 {path objects and glob and file tail and tilde} {
+ set res {}
+ set origdir [pwd]
+ cd [tcltest::temporaryDirectory]
+ file mkdir tilde
+ close [open tilde/~testNotExist w]
+ cd tilde
+ set file [lindex [glob *test*] 0]
+ lappend res [file exists $file] [catch {file tail $file} r] $r
+ lappend res $file
+ lappend res [file exists $file] [catch {file tail $file} r] $r
+ lappend res [catch {file tail $file} r] $r
+ cd ..
+ file delete -force tilde
+ cd $origdir
+ set res
+} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.8 {path objects and glob and file tail and tilde} {
+ set res {}
+ set origdir [pwd]
+ cd [tcltest::temporaryDirectory]
+ file mkdir tilde
+ close [open tilde/~testNotExist w]
+ cd tilde
+ set file1 [lindex [glob *test*] 0]
+ set file2 "~testNotExist"
+ lappend res $file1 $file2
+ lappend res [catch {file tail $file1} r] $r
+ lappend res [catch {file tail $file2} r] $r
+ cd ..
+ file delete -force tilde
+ cd $origdir
+ set res
+} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.9 {path objects and glob and file tail and tilde} {
+ set res {}
+ set origdir [pwd]
+ cd [tcltest::temporaryDirectory]
+ file mkdir tilde
+ close [open tilde/~testNotExist w]
+ cd tilde
+ set file1 [lindex [glob *test*] 0]
+ set file2 "~testNotExist"
+ lappend res [catch {file exists $file1} r] $r
+ lappend res [catch {file exists $file2} r] $r
+ lappend res [string equal $file1 $file2]
+ cd ..
+ file delete -force tilde
+ cd $origdir
+ set res
+} {0 0 0 0 1}
cleanupTests
unset -nocomplain drive