[Bug #1536227]: Cygwin network pathname supoort

1 files changed, 96 insertions, 145 deletions

diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index a6bb932..07757d9 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -32,8 +32,8 @@ static const char *	ExtractWinRoot(const char *path,
 			    Tcl_DString *resultPtr, int offset,
 			    Tcl_PathType *typePtr);
 static int		SkipToChar(char **stringPtr, int match);
-static Tcl_Obj*		SplitWinPath(const char *path);
-static Tcl_Obj*		SplitUnixPath(const char *path);
+static Tcl_Obj *	SplitWinPath(const char *path);
+static Tcl_Obj *	SplitUnixPath(const char *path);
 static int		DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
 			    const char *separators, Tcl_Obj *pathPtr, int flags,
 			    char *pattern, Tcl_GlobTypeData *types);
@@ -199,7 +199,7 @@ ExtractWinRoot(
 	    Tcl_DStringAppend(resultPtr, path, 2);
 	    return &path[2];
 	} else {
-	    char *tail = (char*)&path[3];
+	    const char *tail = &path[3];
 
 	    /*
 	     * Skip separators.
@@ -377,7 +377,7 @@ TclpGetNativePathType(
 {
     Tcl_PathType type = TCL_PATH_ABSOLUTE;
     int pathLen;
-    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
 
     if (path[0] == '~') {
 	/*
@@ -386,7 +386,7 @@ TclpGetNativePathType(
 	 */
 
 	if (driveNameLengthPtr != NULL) {
-	    char *end = path + 1;
+	    const char *end = path + 1;
 	    while ((*end != '\0') && (*end != '/')) {
 		end++;
 	    }
@@ -395,31 +395,34 @@ TclpGetNativePathType(
     } else {
 	switch (tclPlatform) {
 	case TCL_PLATFORM_UNIX: {
-	    char *origPath = path;
+	    const char *origPath = path;
 
 	    /*
 	     * Paths that begin with / are absolute.
 	     */
 
-#ifdef __QNX__
-	    /*
-	     * Check for QNX //<node id> prefix
-	     */
-	    if (*path && (pathLen > 3) && (path[0] == '/')
-		    && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
-		path += 3;
-		while (isdigit(UCHAR(*path))) {
-		    ++path;
-		}
-	    }
-#endif
 	    if (path[0] == '/') {
-#ifdef __CYGWIN__
+		++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
 		/*
-		 * Check for Cygwin // network path prefix
+		 * Check for "//" network path prefix
 		 */
-		if (path[1] == '/') {
-		    path++;
+		if ((*path == '/') && path[1] && (path[1] != '/')) {
+		    path += 2;
+		    while (*path && *path != '/') {
+			++path;
+		    }
+#if defined(__CYGWIN__)
+		    /* UNC paths need to be followed by a share name */
+		    if (*path++ && (*path && *path != '/')) {
+			++path;
+			while (*path && *path != '/') {
+			    ++path;
+			}
+		    } else {
+			path = origPath + 1;
+		    }
+#endif
 		}
 #endif
 		if (driveNameLengthPtr != NULL) {
@@ -427,7 +430,7 @@ TclpGetNativePathType(
 		     * We need this addition in case the QNX or Cygwin code was used.
 		     */
 
-		    *driveNameLengthPtr = (1 + path - origPath);
+		    *driveNameLengthPtr = (path - origPath);
 		}
 	    } else {
 		type = TCL_PATH_RELATIVE;
@@ -546,7 +549,8 @@ Tcl_SplitPath(
     Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
     Tcl_Obj *tmpPtr, *eltPtr;
     int i, size, len;
-    char *p, *str;
+    char *p;
+    const char *str;
 
     /*
      * Perform the splitting, using objectified, vfs-aware code.
@@ -631,40 +635,43 @@ SplitUnixPath(
     const char *path)		/* Pointer to string containing a path. */
 {
     int length;
-    const char *p, *elementStart;
+    const char *origPath = path, *elementStart;
     Tcl_Obj *result = Tcl_NewObj();
 
     /*
      * Deal with the root directory as a special case.
      */
 
-#ifdef __QNX__
-    /*
-     * Check for QNX //<node id> prefix
-     */
-    if ((path[0] == '/') && (path[1] == '/')
-	    && isdigit(UCHAR(path[2]))) { /* INTL: digit */
-	path += 3;
-	while (isdigit(UCHAR(*path))) { /* INTL: digit */
-	    ++path;
-	}
-    }
-#endif
-
-    p = path;
-    if (*p == '/') {
-	Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1);
-	p++;
-#ifdef __CYGWIN__
+    if (*path == '/') {
+	Tcl_Obj *rootElt;
+	++path;
+#if defined(__CYGWIN__) || defined(__QNX__)
 	/*
-	 * Check for Cygwin // network path prefix
+	 * Check for "//" network path prefix
 	 */
-	if (*p == '/') {
-	    Tcl_AppendToObj(rootElt, "/", 1);
-	    p++;
+	if ((*path == '/') && path[1] && (path[1] != '/')) {
+	    path += 2;
+	    while (*path && *path != '/') {
+		++path;
+	    }
+#if defined(__CYGWIN__)
+	    /* UNC paths need to be followed by a share name */
+	    if (*path++ && (*path && *path != '/')) {
+		++path;
+		while (*path && *path != '/') {
+		    ++path;
+		}
+	    } else {
+		path = origPath + 1;
+	    }
+#endif
 	}
 #endif
+	rootElt = Tcl_NewStringObj(origPath, path - origPath);
 	Tcl_ListObjAppendElement(NULL, result, rootElt);
+	while (*path == '/') {
+	    ++path;
+	}
     }
 
     /*
@@ -673,14 +680,14 @@ SplitUnixPath(
      */
 
     for (;;) {
-	elementStart = p;
-	while ((*p != '\0') && (*p != '/')) {
-	    p++;
+	elementStart = path;
+	while ((*path != '\0') && (*path != '/')) {
+	    path++;
 	}
-	length = p - elementStart;
+	length = path - elementStart;
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
-	    if ((elementStart[0] == '~') && (elementStart != path)) {
+	    if ((elementStart[0] == '~') && (elementStart != origPath)) {
 		TclNewLiteralStringObj(nextElt, "./");
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
@@ -688,7 +695,7 @@ SplitUnixPath(
 	    }
 	    Tcl_ListObjAppendElement(NULL, result, nextElt);
 	}
-	if (*p++ == '\0') {
+	if (*path++ == '\0') {
 	    break;
 	}
     }
@@ -843,8 +850,9 @@ TclpNativeJoinPath(
     const char *joining)
 {
     int length, needsSep;
+    char *dest;
     const char *p;
-    char *dest, *start;
+    const char *start;
 
     start = Tcl_GetStringFromObj(prefix, &length);
 
@@ -968,7 +976,7 @@ Tcl_JoinPath(
     int i, len;
     Tcl_Obj *listObj = Tcl_NewObj();
     Tcl_Obj *resultObj;
-    char *resultStr;
+    const char *resultStr;
 
     /*
      * Build the list of paths.
@@ -1338,8 +1346,8 @@ Tcl_GlobObjCmd(
 
     if (dir == PATH_GENERAL) {
 	int pathlength;
-	char *last;
-	char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+	const char *last;
+	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
 
 	/*
 	 * Find the last path separator in the path
@@ -1440,7 +1448,7 @@ Tcl_GlobObjCmd(
 
 	while (--length >= 0) {
 	    int len;
-	    char *str;
+	    const char *str;
 
 	    Tcl_ListObjIndex(interp, typePtr, length, &look);
 	    str = Tcl_GetStringFromObj(look, &len);
@@ -1496,10 +1504,10 @@ Tcl_GlobObjCmd(
 		Tcl_IncrRefCount(look);
 
 	    } else {
-		Tcl_Obj* item;
+		Tcl_Obj *item;
 
-		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
-			(len == 3)) {
+		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
+			&& (len == 3)) {
 		    Tcl_ListObjIndex(interp, look, 0, &item);
 		    if (!strcmp("macintosh", Tcl_GetString(item))) {
 			Tcl_ListObjIndex(interp, look, 1, &item);
@@ -1831,7 +1839,7 @@ TclGlob(
 		if (tail[0] == '/') {
 		    tail++;
 		} else {
-		    tail+=2;
+		    tail += 2;
 		}
 		Tcl_IncrRefCount(pathPrefix);
 		break;
@@ -1902,27 +1910,29 @@ TclGlob(
 
     if (*tail == '\0' && pathPrefix != NULL) {
 	/*
-	 * An empty pattern.  This means 'pathPrefix' is actually
-	 * a full path of a file/directory we want to simply check
-	 * for existence and type.
+	 * An empty pattern. This means 'pathPrefix' is actually a full path
+	 * of a file/directory we want to simply check for existence and type.
 	 */
+
 	if (types == NULL) {
 	    /*
-	     * We just want to check for existence.  In this case we
-	     * make it easy on Tcl_FSMatchInDirectory and its
-	     * sub-implementations by not bothering them (even though
-	     * they should support this situation) and we just use the
-	     * simple existence check with Tcl_FSAccess.
+	     * We just want to check for existence. In this case we make it
+	     * easy on Tcl_FSMatchInDirectory and its sub-implementations by
+	     * not bothering them (even though they should support this
+	     * situation) and we just use the simple existence check with
+	     * Tcl_FSAccess.
 	     */
+
 	    if (Tcl_FSAccess(pathPrefix, F_OK) == 0) {
 		Tcl_ListObjAppendElement(interp, filenamesObj, pathPrefix);
 	    }
 	    result = TCL_OK;
 	} else {
 	    /*
-	     * We want to check for the correct type.  Tcl_FSMatchInDirectory
+	     * We want to check for the correct type. Tcl_FSMatchInDirectory
 	     * is documented to do this for us, if we give it a NULL pattern.
 	     */
+
 	    result = Tcl_FSMatchInDirectory(interp, filenamesObj, pathPrefix,
 		    NULL, types);
 	}
@@ -1987,20 +1997,20 @@ TclGlob(
 	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
 	for (i = 0; i< objc; i++) {
 	    int len;
-	    char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
-	    Tcl_Obj* elems[1];
+	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+	    Tcl_Obj *elem;
 
 	    if (len == prefixLen) {
 		if ((pattern[0] == '\0')
 			|| (strchr(separators, pattern[0]) == NULL)) {
-		    TclNewLiteralStringObj(elems[0], ".");
+		    TclNewLiteralStringObj(elem, ".");
 		} else {
-		    TclNewLiteralStringObj(elems[0], "/");
+		    TclNewLiteralStringObj(elem, "/");
 		}
 	    } else {
-		elems[0] = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
+		elem = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
 	    }
-	    Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, elems);
+	    Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, &elem);
 	}
     }
 
@@ -2115,7 +2125,7 @@ DoGlob(
 				 * resulting filenames. Caller allocates and
 				 * deallocates; DoGlob must not touch the
 				 * refCount of this object. */
-    const char *separators, /* String containing separator characters that
+    const char *separators,	/* String containing separator characters that
 				 * should be used to identify globbing
 				 * boundaries. */
     Tcl_Obj *pathPtr,		/* Completely expanded prefix. */
@@ -2159,67 +2169,6 @@ DoGlob(
     }
 
     /*
-     * This block of code is not exercised by the Tcl test suite as of Tcl
-     * 8.5a0. Simplifications to the calling paths suggest it may not be
-     * necessary any more, since path separators are handled elsewhere. It is
-     * left in place in case new bugs are reported.
-     */
-
-#if 0 /* PROBABLY_OBSOLETE */
-    /*
-     * Deal with path separators.
-     */
-
-    if (pathPtr == NULL) {
-	/*
-	 * Length used to be the length of the prefix, and lastChar the
-	 * lastChar of the prefix. But, none of this is used any more.
-	 */
-
-	int length = 0;
-	char lastChar = 0;
-
-	switch (tclPlatform) {
-	case TCL_PLATFORM_WINDOWS:
-	    /*
-	     * If this is a drive relative path, add the colon and the
-	     * trailing slash if needed. Otherwise add the slash if this is
-	     * the first absolute element, or a later relative element. Add an
-	     * extra slash if this is a UNC path.
-	     */
-
-	    if (*name == ':') {
-		Tcl_DStringAppend(&append, ":", 1);
-		if (count > 1) {
-		    Tcl_DStringAppend(&append, "/", 1);
-		}
-	    } else if ((*pattern != '\0') && (((length > 0)
-		    && (strchr(separators, lastChar) == NULL))
-		    || ((length == 0) && (count > 0)))) {
-		Tcl_DStringAppend(&append, "/", 1);
-		if ((length == 0) && (count > 1)) {
-		    Tcl_DStringAppend(&append, "/", 1);
-		}
-	    }
-
-	    break;
-	case TCL_PLATFORM_UNIX:
-	    /*
-	     * Add a separator if this is the first absolute element, or a
-	     * later relative element.
-	     */
-
-	    if ((*pattern != '\0') && (((length > 0)
-		    && (strchr(separators, lastChar) == NULL))
-		    || ((length == 0) && (count > 0)))) {
-		Tcl_DStringAppend(&append, "/", 1);
-	    }
-	    break;
-	}
-    }
-#endif /* PROBABLY_OBSOLETE */
-
-    /*
      * Look for the first matching pair of braces or the first directory
      * separator that is not inside a pair of braces.
      */
@@ -2273,8 +2222,8 @@ DoGlob(
 
     if (openBrace != NULL) {
 	char *element;
-
 	Tcl_DString newName;
+
 	Tcl_DStringInit(&newName);
 
 	/*
@@ -2323,12 +2272,13 @@ DoGlob(
      */
 
     if (*p != '\0') {
+	char savedChar = *p;
+
 	/*
 	 * Note that we are modifying the string in place. This won't work if
 	 * the string is a static.
 	 */
 
-	char savedChar = *p;
 	*p = '\0';
 	firstSpecialChar = strpbrk(pattern, "*[]?\\");
 	*p = savedChar;
@@ -2347,7 +2297,7 @@ DoGlob(
 	    TCL_GLOB_TYPE_DIR, 0, NULL, NULL
 	};
 	char save = *p;
-	Tcl_Obj* subdirsPtr;
+	Tcl_Obj *subdirsPtr;
 
 	if (*p == '\0') {
 	    return Tcl_FSMatchInDirectory(interp, matchesObj, pathPtr,
@@ -2393,6 +2343,7 @@ DoGlob(
 			const char *bytes;
 			int numBytes;
 			Tcl_Obj *fixme, *newObj;
+
 			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
 			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
 			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
@@ -2413,6 +2364,9 @@ DoGlob(
      */
 
     if (*p == '\0') {
+	int length;
+	Tcl_DString append;
+
 	/*
 	 * This is the code path reached by a command like 'glob foo'.
 	 *
@@ -2425,9 +2379,6 @@ DoGlob(
 	 * approach).
 	 */
 
-	int length;
-	Tcl_DString append;
-
 	Tcl_DStringInit(&append);
 	Tcl_DStringAppend(&append, pattern, p-pattern);