diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/filename.n | 15 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 65 | ||||
| -rw-r--r-- | tests/winFCmd.test | 46 |
4 files changed, 117 insertions, 17 deletions
@@ -1,3 +1,11 @@ +2003-09-16 Vince Darley <vincentdarley@users.sourceforge.net> + + * doc/filename.n: documentation of Windows-specific feature as + discussed in [Bug 541989] + * generic/tclPathObj.c: fix for normalization of volume-relative + paths [Bug 767834] + * tests/winFCmd.test: new tests for both of the above. + 2003-09-13 Donal K. Fellows <fellowsd@cs.man.ac.uk> TIP#123 IMPLEMENTATION BASED ON WORK BY ARJEN MARKUS diff --git a/doc/filename.n b/doc/filename.n index c0e2a68..de77d8c 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: filename.n,v 1.7 2001/09/04 18:06:34 vincentdarley Exp $ +'\" RCS: @(#) $Id: filename.n,v 1.8 2003/09/16 14:56:08 vincentdarley Exp $ '\" .so man.macros .TH filename n 7.5 Tcl "Tcl Built-In Commands" @@ -200,15 +200,22 @@ Not all file systems are case sensitive, so scripts should avoid code that depends on the case of characters in a file name. In addition, the character sets allowed on different devices may differ, so scripts should choose file names that do not contain special characters like: -\fB<>:"/\e|\fR. The safest approach is to use names consisting of -alphanumeric characters only. Also Windows 3.1 only supports file +\fB<>:?"/\e|\fR. The safest approach is to use names consisting of +alphanumeric characters only. Care should be taken with filenames +which contain spaces (common on Windows and MacOS systems) and +filenames where the backslash is the directory separator (Windows +native path names). Also Windows 3.1 only supports file names with a root of no more than 8 characters and an extension of no more than 3 characters. .PP On Windows platforms there are file and path length restrictions. Complete paths or filenames longer than about 260 characters will lead to errors in most file operations. - +.PP +Another Windows peculiarity is that any number of trailing dots '.' in +filenames are totally ignored, so, for example, attempts to create a +file or directory with a name "foo." will result in the creation of a +file/directory with name "foo". .SH KEYWORDS current directory, absolute file name, relative file name, volume-relative file name, portability diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 87ec24b..e7718b1 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.6 2003/08/23 12:16:49 vasiljevic Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.7 2003/09/16 14:56:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -1177,6 +1177,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) */ Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr; char *path = Tcl_GetString(absolutePath); + int type; /* * We have to be a little bit careful here to avoid infinite loops @@ -1184,17 +1185,61 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * that call can actually result in a lot of other filesystem * action, which might loop back through here. */ - if ((path[0] != '\0') && - (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) { - useThisCwd = Tcl_FSGetCwd(interp); + if (path[0] != '\0') { + type = Tcl_FSGetPathType(pathObjPtr); + if (type == TCL_PATH_RELATIVE) { + useThisCwd = Tcl_FSGetCwd(interp); - if (useThisCwd == NULL) { - return NULL; - } + if (useThisCwd == NULL) return NULL; - absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); - Tcl_IncrRefCount(absolutePath); - /* We have a refCount on the cwd */ + absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); + Tcl_IncrRefCount(absolutePath); + /* We have a refCount on the cwd */ + } else if (type == TCL_PATH_VOLUME_RELATIVE) { + /* + * Only Windows has volume-relative paths. These + * paths are rather rare, but is is nice if Tcl can + * handle them. It is much better if we can + * handle them here, rather than in the native fs code, + * because we really need to have a real absolute path + * just below. + */ + useThisCwd = Tcl_FSGetCwd(interp); + if (useThisCwd == NULL) return NULL; + + if (path[0] == '/') { + /* + * Path of form /foo/bar which is a path in the + * root directory of the current volume. + */ + CONST char *drive = Tcl_GetString(useThisCwd); + absolutePath = Tcl_NewStringObj(drive,2); + Tcl_AppendToObj(absolutePath, path, -1); + Tcl_IncrRefCount(absolutePath); + /* We have a refCount on the cwd */ + } else { + /* + * Path of form C:foo/bar, but this only makes + * sense if the cwd is also on drive C. + */ + CONST char *drive = Tcl_GetString(useThisCwd); + char drive_c = path[0]; + if (drive_c >= 'a') { + drive_c -= ('a' - 'A'); + } + if (drive[0] == drive_c) { + absolutePath = Tcl_DuplicateObj(useThisCwd); + Tcl_IncrRefCount(absolutePath); + Tcl_AppendToObj(absolutePath, "/", 1); + Tcl_AppendToObj(absolutePath, path+2, -1); + /* We have a refCount on the cwd */ + } else { + /* We just can't handle it correctly here */ + Tcl_DecrRefCount(useThisCwd); + useThisCwd = NULL; + } + } + } } /* Already has refCount incremented */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 52c470c..2829fb6 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.21 2003/07/08 15:09:50 vincentdarley Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.22 2003/09/16 14:56:08 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -606,8 +606,11 @@ test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {pcOnly 95} { } {1 {nul EACCES}} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} { cleanup - list [catch {testfile rmdir /} msg] $msg -} {1 {/ EACCES}} + set res [list [catch {testfile rmdir /} msg] $msg] + # WinXP returns EEXIST, WinNT seems to return EACCES. No policy + # decision has been made as to which is correct. + regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST" +} {1 {C:/ EACCES or EEXIST}} test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} { cleanup createfile tf1 @@ -982,6 +985,43 @@ test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} { test winFCmd-16.1 {Windows file normalization} {pcOnly} { list [file normalize c:/] [file normalize C:/] } {C:/ C:/} +test winFCmd-16.2 {Windows file normalization} {pcOnly} { + close [open td1... w] + set res [file tail [file normalize td1]] + file delete td1... + set res +} {td1} + +set pwd [pwd] +set d [string index $pwd 0] + +test winFCmd-16.3 {Windows file normalization} {pcOnly} { + file norm ${d}:foo +} [file join $pwd foo] +test winFCmd-16.4 {Windows file normalization} {pcOnly} { + file norm [string tolower ${d}]:foo +} [file join $pwd foo] +test winFCmd-16.5 {Windows file normalization} {pcOnly} { + file norm ${d}:foo/bar +} [file join $pwd foo/bar] +test winFCmd-16.6 {Windows file normalization} {pcOnly} { + file norm ${d}:foo\\bar +} [file join $pwd foo/bar] +test winFCmd-16.7 {Windows file normalization} {pcOnly} { + file norm /bar +} "${d}:/bar" +test winFCmd-16.8 {Windows file normalization} {pcOnly} { + file norm ///bar +} "${d}:/bar" +test winFCmd-16.9 {Windows file normalization} {pcOnly} { + file norm /bar/foo +} "${d}:/bar/foo" +test winFCmd-16.10 {Windows file normalization} {pcOnly knownBug} { + if {$d eq "C"} { set dd "D" } else { set dd "C" } + file norm ${dd}:foo +} {Tcl doesn't know about a drive-specific cwd} + +unset d pwd # This block of code used to occur after the "return" call, so I'm # commenting it out and assuming that this code is still under construction. |