diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 18 | ||||
| -rw-r--r-- | tests/fileSystem.test | 51 |
3 files changed, 74 insertions, 1 deletions
@@ -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 |