diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclFileName.c | 52 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 17 | ||||
| -rw-r--r-- | tests/winFCmd.test | 82 | ||||
| -rw-r--r-- | win/tclWinFile.c | 9 |
5 files changed, 159 insertions, 8 deletions
@@ -1,3 +1,10 @@ +2007-02-20 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tclFileName.c: Bug #1479814. Handle extended paths + * generic/tclPathObj.c: on Windows NT and above. These have a + * win/tclWinFile.c: \\?\ prefix. + * tests/winFCmd.test: Tests for extended path handling. + 2007-02-19 Jeff Hobbs <jeffh@ActiveState.com> * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch. diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 590c180..0e2fd20 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.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: tclFileName.c,v 1.76 2006/09/27 13:49:06 msofer Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.77 2007/02/20 15:36:46 patthoyts Exp $ */ #include "tclInt.h" @@ -43,6 +43,33 @@ static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, /* *---------------------------------------------------------------------- * + * SetResultLength -- + * + * Resets the result DString for ExtractWinRoot to accommodate + * any NT extended path prefixes. + * + * Results: + * None. + * + * Side effects: + * May modify the Tcl_DString. + *---------------------------------------------------------------------- + */ + +static void +SetResultLength(Tcl_DString *resultPtr, int offset, int extended) +{ + Tcl_DStringSetLength(resultPtr, offset); + if (extended == 2) { + Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); + } else if (extended == 1) { + Tcl_DStringAppend(resultPtr, "//?/", 4); + } +} + +/* + *---------------------------------------------------------------------- + * * ExtractWinRoot -- * * Matches the root portion of a Windows path and appends it to the @@ -67,6 +94,21 @@ ExtractWinRoot( * stored. */ Tcl_PathType *typePtr) /* Where to store pathType result */ { + int extended = 0; + + if ( (path[0] == '/' || path[0] == '\\') + && (path[1] == '/' || path[1] == '\\') + && (path[2] == '?') + && (path[3] == '/' || path[3] == '\\')) { + extended = 1; + path = path + 4; + if (path[0] == 'U' && path[1] == 'N' && path[2] == 'C' + && (path[3] == '/' || path[3] == '\\')) { + extended = 2; + path = path + 4; + } + } + if (path[0] == '/' || path[0] == '\\') { /* * Might be a UNC or Vol-Relative path. @@ -76,7 +118,7 @@ ExtractWinRoot( int hlen, slen; if (path[1] != '/' && path[1] != '\\') { - Tcl_DStringSetLength(resultPtr, offset); + SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; Tcl_DStringAppend(resultPtr, "/", 1); return &path[1]; @@ -111,7 +153,7 @@ ExtractWinRoot( Tcl_DStringAppend(resultPtr, "/", 1); return &path[2]; } - Tcl_DStringSetLength(resultPtr, offset); + SetResultLength(resultPtr, offset, extended); share = &host[hlen]; /* @@ -149,7 +191,7 @@ ExtractWinRoot( * Might be a drive separator. */ - Tcl_DStringSetLength(resultPtr, offset); + SetResultLength(resultPtr, offset, extended); if (path[2] != '/' && path[2] != '\\') { *typePtr = TCL_PATH_VOLUME_RELATIVE; @@ -248,7 +290,7 @@ ExtractWinRoot( if (abs != 0) { *typePtr = TCL_PATH_ABSOLUTE; - Tcl_DStringSetLength(resultPtr, offset); + SetResultLength(resultPtr, offset, extended); Tcl_DStringAppend(resultPtr, path, abs); return path + abs; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index c73eee8..1aa5cb2 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.56 2006/08/29 00:36:57 coldstore Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.57 2007/02/20 15:36:46 patthoyts Exp $ */ #include "tclInt.h" @@ -166,6 +166,21 @@ TclFSNormalizeAbsolutePath( dirSep = TclGetString(pathPtr); if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if ( (dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended path */ + dirSep += 4; + + if ( (dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { + /* NT extended UNC path */ + dirSep += 4; + } + } if (dirSep[0] != 0 && dirSep[1] == ':' && (dirSep[2] == '/' || dirSep[2] == '\\')) { /* Do nothing */ diff --git a/tests/winFCmd.test b/tests/winFCmd.test index e2575dd..24fbf8e 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.41 2006/11/03 00:34:53 hobbs Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.42 2007/02/20 15:36:47 patthoyts Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -1152,6 +1152,86 @@ test winFCmd-18.8 {Windows reserved path names} -constraints win -body { } -result COM1 +test winFCmd-19.1 {Windows extended path names} -constraints nt -body { + file normalize //?/c:/windows/win.ini +} -result //?/c:/windows/win.ini + +test winFCmd-19.2 {Windows extended path names} -constraints nt -body { + file normalize //?/c:/windows/../windows/win.ini +} -result //?/c:/windows/win.ini + +test winFCmd-19.3 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp] + set tmpfile [file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] $res +} -cleanup { + catch {file delete $tmpfile} +} -result [list 0 {}] + +test winFCmd-19.4 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp] + set tmpfile //?/[file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] $res +} -cleanup { + catch {file delete $tmpfile} +} -result [list 0 {}] + +test winFCmd-19.5 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp] + set tmpfile [file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] errormsg ;#$res +} -cleanup { + catch {file delete $tmpfile} +} -result [list 1 errormsg] + +test winFCmd-19.6 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp] + set tmpfile //?/[file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] $res +} -cleanup { + catch {file delete $tmpfile} +} -result [list 0 {}] + +test winFCmd-19.7 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "] + set tmpfile [file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*] +} -cleanup { + catch {file delete $tmpfile} +} -result [list 0 {} [list tcl[pid].tmp]] + +test winFCmd-19.8 {Windows extended path names} -constraints nt -setup { + set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "] + set tmpfile //?/[file normalize $tmpfile] +} -body { + list [catch { + set f [open $tmpfile [list WRONLY CREAT]] + close $f + } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*] +} -cleanup { + catch {file delete $tmpfile} +} -result [list 0 {} [list "tcl[pid].tmp "]] + # 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. #foreach source {tef ted tnf tnd "" nul com1} { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 2a8a2a5..4139dac 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.90 2006/10/13 12:57:21 coldstore Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.91 2007/02/20 15:36:47 patthoyts Exp $ */ /* #define _WIN32_WINNT 0x0500 */ @@ -3277,6 +3277,13 @@ TclNativeCreateNativeRep( } str = Tcl_GetStringFromObj(validPathPtr, &len); + if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') + { + char *p; + for (p = str; p && *p; ++p) { + if (*p == '/') *p = '\\'; + } + } Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { len = Tcl_DStringLength(&ds) + sizeof(WCHAR); |