From e41988bdf21c8f8cd4088031e67e4fdd1793b7b7 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Mon, 10 Jun 2002 10:41:29 +0000
Subject: small fs fixes

---
 ChangeLog           |  7 +++++++
 generic/tclIOUtil.c | 54 ++++++++++++++++++++++++++++++++++++++++++-----------
 unix/tclUnixFCmd.c  |  6 ++++--
 3 files changed, 54 insertions(+), 13 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 2e39d55..5ceed2f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-06-10  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* unix/tclUnixFCmd.c: fixed [Bug #566669]
+	* generic/tclIOUtil.c: improved and sped up handling of
+	native paths (duplication and conversion to normalized paths),
+	particularly on Windows.
+
 2002-06-07  Don Porter  <dgp@users.sourceforge.net>
 
 	* tests/tcltest.test:  More corrections to test suite so that tests
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index e59f244..c44687b 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.45 2002/05/28 15:05:22 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.46 2002/06/10 10:41:29 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -25,6 +25,10 @@
 #ifdef MAC_TCL
 #include "tclMacInt.h"
 #endif
+#ifdef __WIN32__
+/* For 'file link' */
+#include "tclWinInt.h"
+#endif
 
 /*
  * Prototypes for procedures defined later in this file.
@@ -4417,13 +4421,31 @@ TclpNativeToNormalized(clientData)
 {
     Tcl_DString ds;
     Tcl_Obj *objPtr;
+    CONST char *copy;
+    int len;
     
 #ifdef __WIN32__
     Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
 #else
     Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
 #endif
-    objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+    
+    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 (0 == strncmp(copy,"\\??\\",4)) {
+	copy += 4;
+	len -= 4;
+    }
+#endif
+
+    objPtr = Tcl_NewStringObj(copy,len);
     Tcl_DStringFree(&ds);
     
     return objPtr;
@@ -4450,19 +4472,29 @@ static ClientData
 NativeDupInternalRep(clientData)
     ClientData clientData;
 {
-#ifdef __WIN32__
-    /* Copying internal representations is complicated with multi-byte TChars */
-    return NULL;
-#else
+    ClientData copy;
+    size_t len;
+
     if (clientData == NULL) {
-        return 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 {
-	char *native = (char*)clientData;
-	char *copy = ckalloc((unsigned)(1+strlen(native)));
-	strcpy(copy,native);
-	return (ClientData)copy;
+	/* ansi representation when running on 95/98/ME */
+	len = sizeof(CHAR) + (strlen((CONST CHAR*)clientData) * sizeof(CHAR));
     }
+#else
+    /* ansi representation when running on Unix/MacOS */
+    len = sizeof(CHAR) + (strlen((CONST CHAR*)clientData) * sizeof(CHAR));
 #endif
+    
+    copy = (ClientData) ckalloc(len);
+    memcpy((VOID*)copy, (VOID*)clientData, len);
+    return copy;
 }
 
 /*
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index f70d008..7a62bc7 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.21 2002/04/07 05:44:11 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.22 2002/06/10 10:41:29 vincentdarley Exp $
  *
  * Portions of this code were derived from NetBSD source code which has
  * the following copyright notice:
@@ -1675,7 +1675,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
     while (1) {
 	cur = *currentPathEndPosition;
 	if ((cur == '/') && (path != currentPathEndPosition)) {
-	    /* Reached directory separator, or end of string */
+	    /* Reached directory separator */
 	    Tcl_DString ds;
 	    CONST char *nativePath;
 	    int accessOk;
@@ -1691,6 +1691,8 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
 	    /* Update the acceptable point */
 	    nextCheckpoint = currentPathEndPosition - path;
 	} else if (cur == 0) {
+	    /* Reached end of string */
+	    nextCheckpoint = pathLen;
 	    break;
 	}
 	currentPathEndPosition++;
-- 
cgit v0.12