Attachment "925620.patch" to
ticket [925620ffff]
added by
dgp
2004-10-02 03:04:13.
Index: generic/tclFileSystem.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileSystem.h,v
retrieving revision 1.8
diff -u -r1.8 tclFileSystem.h
--- generic/tclFileSystem.h 27 Sep 2004 15:00:39 -0000 1.8
+++ generic/tclFileSystem.h 1 Oct 2004 20:01:31 -0000
@@ -87,7 +87,7 @@
/*
* Private shared functions for use by tclIOUtil.c, tclPathObj.c
- * and tclFileName.c
+ * and tclFileName.c, and any platform-specific filesystem code.
*/
Tcl_PathType TclFSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_Filesystem **filesystemPtrPtr,
@@ -99,4 +99,8 @@
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
int TclFSEpochOk _ANSI_ARGS_((int filesystemEpoch));
+int TclFSCwdIsNative _ANSI_ARGS_((void));
+Tcl_Obj* TclWinVolumeRelativeNormalize _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *path, Tcl_Obj **useThisCwdPtr));
Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
+Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.109
diff -u -r1.109 tclIOUtil.c
--- generic/tclIOUtil.c 27 Sep 2004 15:00:39 -0000 1.109
+++ generic/tclIOUtil.c 1 Oct 2004 20:01:31 -0000
@@ -295,7 +295,6 @@
*/
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
@@ -343,7 +342,7 @@
&TclNativeDupInternalRep,
&NativeFreeInternalRep,
&TclpNativeToNormalized,
- &NativeCreateNativeRep,
+ &TclNativeCreateNativeRep,
&TclpObjNormalizePath,
&TclpFilesystemPathType,
&NativeFilesystemSeparator,
@@ -466,6 +465,18 @@
}
}
+int
+TclFSCwdIsNative()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+
+ if (tsdPtr->cwdClientData != NULL) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -4141,179 +4152,6 @@
/*
*---------------------------------------------------------------------------
*
- * NativeCreateNativeRep --
- *
- * Create a native representation for the given path.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static ClientData
-NativeCreateNativeRep(pathPtr)
- Tcl_Obj* pathPtr;
-{
- char *nativePathPtr;
- Tcl_DString ds;
- Tcl_Obj* validPathPtr;
- int len;
- char *str;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
- if (tsdPtr->cwdClientData != NULL) {
- /* The cwd is native */
- validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- } else {
- /* Make sure the normalized path is set */
- validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- Tcl_IncrRefCount(validPathPtr);
- }
-
- str = Tcl_GetStringFromObj(validPathPtr, &len);
-#ifdef __WIN32__
- Tcl_WinUtfToTChar(str, len, &ds);
- if (tclWinProcs->useWide) {
- len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
- } else {
- len = Tcl_DStringLength(&ds) + sizeof(char);
- }
-#else
- Tcl_UtfToExternalDString(NULL, str, len, &ds);
- len = Tcl_DStringLength(&ds) + sizeof(char);
-#endif
- Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
- memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
-
- Tcl_DStringFree(&ds);
- return (ClientData)nativePathPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpNativeToNormalized --
- *
- * Convert native format to a normalized path object, with refCount
- * of zero.
- *
- * Currently assumes all native paths are actually normalized
- * already, so if the path given is not normalized this will
- * actually just convert to a valid string path, but not
- * necessarily a normalized one.
- *
- * Results:
- * A valid normalized path.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-Tcl_Obj*
-TclpNativeToNormalized(clientData)
- ClientData clientData;
-{
- Tcl_DString ds;
- Tcl_Obj *objPtr;
- int len;
-
-#ifdef __WIN32__
- char *copy;
- char *p;
- Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
-#else
- CONST char *copy;
- Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
-#endif
-
- copy = Tcl_DStringValue(&ds);
- len = Tcl_DStringLength(&ds);
-
-#ifdef __WIN32__
- /*
- * Certain native path representations on Windows have this special
- * prefix to indicate that they are to be treated specially. For
- * example extremely long paths, or symlinks
- */
- if (*copy == '\\') {
- if (0 == strncmp(copy,"\\??\\",4)) {
- copy += 4;
- len -= 4;
- } else if (0 == strncmp(copy,"\\\\?\\",4)) {
- copy += 4;
- len -= 4;
- }
- }
- /*
- * Ensure we are using forward slashes only.
- */
- for (p = copy; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
-#endif
-
- objPtr = Tcl_NewStringObj(copy,len);
- Tcl_DStringFree(&ds);
-
- return objPtr;
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclNativeDupInternalRep --
- *
- * Duplicate the native representation.
- *
- * Results:
- * The copied native representation, or NULL if it is not possible
- * to copy the representation.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-ClientData
-TclNativeDupInternalRep(clientData)
- ClientData clientData;
-{
- char *copy;
- size_t len;
-
- if (clientData == NULL) {
- return NULL;
- }
-
-#ifdef __WIN32__
- if (tclWinProcs->useWide) {
- /* unicode representation when running on NT/2K/XP */
- len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
- } else {
- /* ansi representation when running on 95/98/ME */
- len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
- }
-#else
- /* ansi representation when running on Unix */
- len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
-#endif
-
- copy = (char *) ckalloc(len);
- memcpy((VOID*)copy, (VOID*)clientData, len);
- return (ClientData)copy;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* NativeFreeInternalRep --
*
* Free a native internal representation, which will be non-NULL.
Index: generic/tclPathObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPathObj.c,v
retrieving revision 1.35
diff -u -r1.35 tclPathObj.c
--- generic/tclPathObj.c 29 Sep 2004 22:17:30 -0000 1.35
+++ generic/tclPathObj.c 1 Oct 2004 20:01:32 -0000
@@ -1704,76 +1704,11 @@
/* We have a refCount on the cwd */
#ifdef __WIN32__
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
- /*
- * Only Windows has volume-relative paths. These
- * paths are rather rare, but it 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.
- *
- * We do not let this block compile on non-Windows
- * platforms because the test suite's manual forcing
- * of tclPlatform can otherwise cause this code path
- * to be executed, causing various errors because
- * volume-relative paths really do not exist.
- */
- 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.
- */
- int cwdLen;
- CONST char *drive = Tcl_GetStringFromObj(useThisCwd,
- &cwdLen);
- char drive_cur = path[0];
- if (drive_cur >= 'a') {
- drive_cur -= ('a' - 'A');
- }
- if (drive[0] == drive_cur) {
- absolutePath = Tcl_DuplicateObj(useThisCwd);
- /*
- * We have a refCount on the cwd, which we
- * will release later.
- */
-
- if (drive[cwdLen-1] != '/' && (path[2] != '\0')) {
- /*
- * Only add a trailing '/' if needed, which
- * is if there isn't one already, and if we
- * are going to be adding some more
- * characters.
- */
- Tcl_AppendToObj(absolutePath, "/", 1);
- }
- } else {
- Tcl_DecrRefCount(useThisCwd);
- useThisCwd = NULL;
- /*
- * The path is not in the current drive, but
- * is volume-relative. The way Tcl 8.3 handles
- * this is that it treats such a path as
- * relative to the root of the drive. We
- * therefore behave the same here.
- */
- absolutePath = Tcl_NewStringObj(path, 2);
- Tcl_AppendToObj(absolutePath, "/", 1);
- }
- Tcl_IncrRefCount(absolutePath);
- Tcl_AppendToObj(absolutePath, path+2, -1);
+ /* Only Windows has volume-relative paths */
+ absolutePath = TclWinVolumeRelativeNormalize(interp, path,
+ &useThisCwd);
+ if (absolutePath == NULL) {
+ return NULL;
}
#endif /* __WIN32__ */
}
@@ -1839,7 +1774,7 @@
*---------------------------------------------------------------------------
*/
-ClientData
+ClientData
Tcl_FSGetInternalRep(pathPtr, fsPtr)
Tcl_Obj* pathPtr;
Tcl_Filesystem *fsPtr;
Index: tests/fileName.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileName.test,v
retrieving revision 1.43
diff -u -r1.43 fileName.test
--- tests/fileName.test 23 Jun 2004 15:36:56 -0000 1.43
+++ tests/fileName.test 1 Oct 2004 20:01:34 -0000
@@ -1484,6 +1484,18 @@
test filename-16.16 {windows specific globbing} {win} {
file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
} {..}
+test filename-16.17 {windows specific globbing} {win} {
+ cd C:/
+ # Ensure correct trimming of tails with absolute and
+ # volume relative globbing.
+ set res1 [glob -nocomplain -tails -dir C:/ *]
+ set res2 [glob -nocomplain -tails -dir C: *]
+ if {$res1 eq $res2} {
+ concat ok
+ } else {
+ concat $res1 ne $res2
+ }
+} {ok}
test filename-17.1 {windows specific special files} {testsetplatform} {
testsetplatform win
Index: tests/winFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winFCmd.test,v
retrieving revision 1.34
diff -u -r1.34 winFCmd.test
--- tests/winFCmd.test 27 Sep 2004 15:00:42 -0000 1.34
+++ tests/winFCmd.test 1 Oct 2004 20:01:34 -0000
@@ -1023,17 +1023,34 @@
# Must not crash
set result "no crash"
} -cleanup {
- cd ${d}:
+ cd $pwd
} -result {no crash}
-test winFCmd-16.12 {Windows file normalization} -constraints win -setup {
- set oldwd [pwd]
+
+test winFCmd-16.12 {Windows file normalization - no crash} \
+ -constraints win -setup {
set oldhome ""
catch {set oldhome $::env(HOME)}
} -body {
set expectedResult [file normalize ${d}:]
set ::env(HOME) ${d}:
cd
+ # At one point this led to an infinite recursion in Tcl
set result [pwd]; # <- Must not crash
+ set result "no crash"
+} -cleanup {
+ set ::env(HOME) $oldhome
+ cd $pwd
+} -result {no crash}
+
+test winFCmd-16.13 {Windows file normalization} -constraints win -setup {
+ set oldhome ""
+ catch {set oldhome $::env(HOME)}
+} -body {
+ # Test 'cd' normalization when HOME is absolute
+ set expectedResult [file normalize ${d}:/]
+ set ::env(HOME) ${d}:/
+ cd
+ set result [pwd]
if { [string equal $result $expectedResult] } {
concat ok
} else {
@@ -1041,12 +1058,28 @@
}
} -cleanup {
set ::env(HOME) $oldhome
- cd $oldwd
+ cd $pwd
} -result ok
-test winFCmd-16.13 {Windows bad permissions cd} -constraints win -setup {
- set oldwd [pwd]
+test winFCmd-16.14 {Windows file normalization} -constraints win -setup {
+ set oldhome ""
+ catch {set oldhome $::env(HOME)}
} -body {
+ # Test 'cd' normalization when HOME is relative
+ set ::env(HOME) ${d}:
+ cd
+ set result [pwd]
+ if { [string equal $result $pwd] } {
+ concat ok
+ } else {
+ list $result != $pwd
+ }
+} -cleanup {
+ set ::env(HOME) $oldhome
+ cd $pwd
+} -result ok
+
+test winFCmd-17.1 {Windows bad permissions cd} -constraints win -body {
set d {}
foreach dd {c:/ d:/ e:/} {
eval lappend d [glob -nocomplain \
@@ -1061,7 +1094,7 @@
set err "permission denied"
}
} -cleanup {
- cd $oldwd
+ cd $pwd
} -result "permission denied"
cd $pwd
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.41
diff -u -r1.41 tclUnixFile.c
--- unix/tclUnixFile.c 20 Jul 2004 10:12:29 -0000 1.41
+++ unix/tclUnixFile.c 1 Oct 2004 20:01:34 -0000
@@ -13,6 +13,7 @@
*/
#include "tclInt.h"
+#include "tclFileSystem.h"
static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
@@ -903,6 +904,132 @@
/*
*---------------------------------------------------------------------------
*
+ * TclpNativeToNormalized --
+ *
+ * Convert native format to a normalized path object, with refCount
+ * of zero.
+ *
+ * Currently assumes all native paths are actually normalized
+ * already, so if the path given is not normalized this will
+ * actually just convert to a valid string path, but not
+ * necessarily a normalized one.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpNativeToNormalized(clientData)
+ ClientData clientData;
+{
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+ int len;
+
+ CONST char *copy;
+ Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
+
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+
+ objPtr = Tcl_NewStringObj(copy,len);
+ Tcl_DStringFree(&ds);
+
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeCreateNativeRep --
+ *
+ * Create a native representation for the given path.
+ *
+ * Results:
+ * The nativePath representation.
+ *
+ * Side effects:
+ * Memory will be allocated. The path may need to be normalized.
+ *
+ *---------------------------------------------------------------------------
+ */
+ClientData
+TclNativeCreateNativeRep(pathPtr)
+ Tcl_Obj* pathPtr;
+{
+ char *nativePathPtr;
+ Tcl_DString ds;
+ Tcl_Obj* validPathPtr;
+ int len;
+ char *str;
+
+ if (TclFSCwdIsNative()) {
+ /*
+ * The cwd is native, which means we can use the translated
+ * path without worrying about normalization (this will also
+ * usually be shorter so the utf-to-external conversion will
+ * be somewhat faster).
+ */
+ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ } else {
+ /* Make sure the normalized path is set */
+ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ Tcl_IncrRefCount(validPathPtr);
+ }
+
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
+ Tcl_UtfToExternalDString(NULL, str, len, &ds);
+ len = Tcl_DStringLength(&ds) + sizeof(char);
+ Tcl_DecrRefCount(validPathPtr);
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
+
+ Tcl_DStringFree(&ds);
+ return (ClientData)nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeDupInternalRep --
+ *
+ * Duplicate the native representation.
+ *
+ * Results:
+ * The copied native representation, or NULL if it is not possible
+ * to copy the representation.
+ *
+ * Side effects:
+ * Memory will be allocated for the copy.
+ *
+ *---------------------------------------------------------------------------
+ */
+ClientData
+TclNativeDupInternalRep(clientData)
+ ClientData clientData;
+{
+ char *copy;
+ size_t len;
+
+ if (clientData == NULL) {
+ return NULL;
+ }
+
+ /* ascii representation when running on Unix */
+ len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
+
+ copy = (char *) ckalloc(len);
+ memcpy((VOID*)copy, (VOID*)clientData, len);
+ return (ClientData)copy;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpUtime --
*
* Set the modification date for a file.
Index: win/tclWinFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFile.c,v
retrieving revision 1.66
diff -u -r1.66 tclWinFile.c
--- win/tclWinFile.c 30 Jun 2004 14:46:11 -0000 1.66
+++ win/tclWinFile.c 1 Oct 2004 20:01:34 -0000
@@ -17,6 +17,7 @@
//#define _WIN32_WINNT 0x0500
#include "tclWinInt.h"
+#include "tclFileSystem.h"
#include <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
@@ -2642,6 +2643,265 @@
/*
*---------------------------------------------------------------------------
*
+ * TclWinVolumeRelativeNormalize --
+ *
+ * Only Windows has volume-relative paths. These paths are rather
+ * rare, but it 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.
+ *
+ * We do not let this block compile on non-Windows platforms
+ * because the test suite's manual forcing of tclPlatform can
+ * otherwise cause this code path to be executed, causing various
+ * errors because volume-relative paths really do not exist.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclWinVolumeRelativeNormalize(interp, path, useThisCwdPtr)
+ Tcl_Interp *interp;
+ CONST char *path;
+ Tcl_Obj **useThisCwdPtr;
+{
+ Tcl_Obj *absolutePath, *useThisCwd;
+
+ 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.
+ */
+ int cwdLen;
+ CONST char *drive = Tcl_GetStringFromObj(useThisCwd,
+ &cwdLen);
+ char drive_cur = path[0];
+ if (drive_cur >= 'a') {
+ drive_cur -= ('a' - 'A');
+ }
+ if (drive[0] == drive_cur) {
+ absolutePath = Tcl_DuplicateObj(useThisCwd);
+ /*
+ * We have a refCount on the cwd, which we
+ * will release later.
+ */
+
+ if (drive[cwdLen-1] != '/' && (path[2] != '\0')) {
+ /*
+ * Only add a trailing '/' if needed, which
+ * is if there isn't one already, and if we
+ * are going to be adding some more
+ * characters.
+ */
+ Tcl_AppendToObj(absolutePath, "/", 1);
+ }
+ } else {
+ Tcl_DecrRefCount(useThisCwd);
+ useThisCwd = NULL;
+ /*
+ * The path is not in the current drive, but
+ * is volume-relative. The way Tcl 8.3 handles
+ * this is that it treats such a path as
+ * relative to the root of the drive. We
+ * therefore behave the same here. This
+ * behaviour is, however, different to that
+ * of the windows command-line. If we want
+ * to fix this at some point in the future
+ * (at the expense of a behaviour change to
+ * Tcl), we could use the '_dgetdcwd' Win32
+ * API to get the drive's cwd.
+ */
+ absolutePath = Tcl_NewStringObj(path, 2);
+ Tcl_AppendToObj(absolutePath, "/", 1);
+ }
+ Tcl_IncrRefCount(absolutePath);
+ Tcl_AppendToObj(absolutePath, path+2, -1);
+ }
+ *useThisCwdPtr = useThisCwd;
+ return absolutePath;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpNativeToNormalized --
+ *
+ * Convert native format to a normalized path object, with refCount
+ * of zero.
+ *
+ * Currently assumes all native paths are actually normalized
+ * already, so if the path given is not normalized this will
+ * actually just convert to a valid string path, but not
+ * necessarily a normalized one.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpNativeToNormalized(clientData)
+ ClientData clientData;
+{
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+ int len;
+
+ char *copy;
+ char *p;
+ Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
+
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+
+ /*
+ * Certain native path representations on Windows have this special
+ * prefix to indicate that they are to be treated specially. For
+ * example extremely long paths, or symlinks
+ */
+ if (*copy == '\\') {
+ if (0 == strncmp(copy,"\\??\\",4)) {
+ copy += 4;
+ len -= 4;
+ } else if (0 == strncmp(copy,"\\\\?\\",4)) {
+ copy += 4;
+ len -= 4;
+ }
+ }
+ /*
+ * Ensure we are using forward slashes only.
+ */
+ for (p = copy; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+
+ objPtr = Tcl_NewStringObj(copy,len);
+ Tcl_DStringFree(&ds);
+
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeCreateNativeRep --
+ *
+ * Create a native representation for the given path.
+ *
+ * Results:
+ * The nativePath representation.
+ *
+ * Side effects:
+ * Memory will be allocated. The path may need to be normalized.
+ *
+ *---------------------------------------------------------------------------
+ */
+ClientData
+TclNativeCreateNativeRep(pathPtr)
+ Tcl_Obj* pathPtr;
+{
+ char *nativePathPtr;
+ Tcl_DString ds;
+ Tcl_Obj* validPathPtr;
+ int len;
+ char *str;
+
+ if (TclFSCwdIsNative()) {
+ /*
+ * The cwd is native, which means we can use the translated
+ * path without worrying about normalization (this will also
+ * usually be shorter so the utf-to-external conversion will
+ * be somewhat faster).
+ */
+ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ } else {
+ /* Make sure the normalized path is set */
+ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ Tcl_IncrRefCount(validPathPtr);
+ }
+
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
+ Tcl_WinUtfToTChar(str, len, &ds);
+ if (tclWinProcs->useWide) {
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
+ } else {
+ len = Tcl_DStringLength(&ds) + sizeof(char);
+ }
+ Tcl_DecrRefCount(validPathPtr);
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
+
+ Tcl_DStringFree(&ds);
+ return (ClientData)nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNativeDupInternalRep --
+ *
+ * Duplicate the native representation.
+ *
+ * Results:
+ * The copied native representation, or NULL if it is not possible
+ * to copy the representation.
+ *
+ * Side effects:
+ * Memory allocation for the copy.
+ *
+ *---------------------------------------------------------------------------
+ */
+ClientData
+TclNativeDupInternalRep(clientData)
+ ClientData clientData;
+{
+ char *copy;
+ size_t len;
+
+ if (clientData == NULL) {
+ return NULL;
+ }
+
+ if (tclWinProcs->useWide) {
+ /* unicode representation when running on NT/2K/XP */
+ len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
+ } else {
+ /* ansi representation when running on 95/98/ME */
+ len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
+ }
+
+ copy = (char *) ckalloc(len);
+ memcpy((VOID*)copy, (VOID*)clientData, len);
+ return (ClientData)copy;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpUtime --
*
* Set the modification date for a file.
