filesystem generic/platform code splitting

4 files changed, 40 insertions, 261 deletions

diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 785769a..aba17d7 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.59 2004/10/06 23:44:06 dkf Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.60 2004/10/07 14:50:21 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1788,8 +1788,19 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
 
 	/* If this length has never been set, set it here */
 	CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
-	if (prefixLen > 0) {
-	    if (strchr(separators, pre[prefixLen-1]) == NULL) {
+	if (prefixLen > 0 
+	  && (strchr(separators, pre[prefixLen-1]) == NULL)) {
+	      
+	    /* 
+	     * If we're on Windows and the prefix is a volume
+	     * relative one like 'C:', then there won't be
+	     * a path separator in between, so no need to
+	     * skip it here.
+	     */
+	    
+	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) 
+		|| (prefixLen != 2) 
+		|| (pre[1] != ':')) {
 		prefixLen++;
 	    }
 	}
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 2fe4bd6..a9a9245 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclFileSystem.h,v 1.8 2004/09/27 15:00:39 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileSystem.h,v 1.9 2004/10/07 14:50:22 vincentdarley Exp $
  */
 
 /* 
@@ -87,7 +87,7 @@ extern Tcl_ThreadDataKey tclFsDataKey;
 
 /* 
  * 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_PathType     TclGetPathType  _ANSI_ARGS_((Tcl_Obj *pathPtr,
 			    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;
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index fce520e..0f31689 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.110 2004/10/06 23:44:07 dkf Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.111 2004/10/07 14:50:22 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -296,7 +296,6 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
  */
 static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
 static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
 static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
 static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
 static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
@@ -344,7 +343,7 @@ Tcl_Filesystem tclNativeFilesystem = {
     &TclNativeDupInternalRep,
     &NativeFreeInternalRep,
     &TclpNativeToNormalized,
-    &NativeCreateNativeRep,
+    &TclNativeCreateNativeRep,
     &TclpObjNormalizePath,
     &TclpFilesystemPathType,
     &NativeFilesystemSeparator,
@@ -467,6 +466,18 @@ FsThrExitProc(cd)
     }
 }
 
+int
+TclFSCwdIsNative() 
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+
+    if (tsdPtr->cwdClientData != NULL) {
+	return 1;
+    } else {
+	return 0;
+    }
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -4127,179 +4138,6 @@ Tcl_FSGetNativePath(pathPtr)
 /*
  *---------------------------------------------------------------------------
  *
- * 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.
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 57dc048..26d5e70 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.36 2004/10/06 12:09:14 dkf Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.37 2004/10/07 14:50:23 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1238,7 +1238,7 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
 Tcl_Obj*
 TclFSMakePathRelative(interp, pathPtr, cwdPtr)
     Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
-    Tcl_Obj *pathPtr;		/* The object we have. */
+    Tcl_Obj *pathPtr;		/* The path we have. */
     Tcl_Obj *cwdPtr;		/* Make it relative to this. */
 {
     int cwdLen, len;
@@ -1789,86 +1789,12 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
 		/* 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) {
+		/* Only Windows has volume-relative paths */
+		absolutePath = TclWinVolumeRelativeNormalize(interp, path, 
+							     &useThisCwd);
+		if (absolutePath == 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 = TclGetString(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 {
-			TclDecrRefCount(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);
-		}
 #endif /* __WIN32__ */
 	    }
 	}