summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclFileName.c52
-rw-r--r--generic/tclPathObj.c17
-rw-r--r--tests/winFCmd.test82
-rw-r--r--win/tclWinFile.c9
5 files changed, 159 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 470b2f4..b6c8209 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);