Tcl Source Code

Artifact 5f06390a5717620d93180a4d5728e9aa2e9e55be:

Attachment "tcl-cygwin" to ticket [1536227fff] added by nobody 2006-08-08 01:48:19.

---

2006-08-07  Thiemo Seufer  <[email protected]>
            Maciej W. Rozycki  <[email protected]>

	* generic/tclFileName.c (TclpGetNativePathType): Handle Cygwin //
	network path prefix.
	(SplitUnixPath): Likewise.
	(TclDoGlob): Likewise.


Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.74
diff -u -p -r1.74 tclFileName.c
--- generic/tclFileName.c	19 Mar 2006 23:04:23 -0000	1.74
+++ generic/tclFileName.c	7 Aug 2006 18:27:15 -0000
@@ -371,9 +371,17 @@ TclpGetNativePathType(
 	    }
 #endif
 	    if (path[0] == '/') {
+#ifdef __CYGWIN__
+		/*
+		 * Check for Cygwin // network path prefix
+		 */
+		if (path[1] == '/')
+		    path++;
+#endif
 		if (driveNameLengthPtr != NULL) {
 		    /*
-		     * We need this addition in case the QNX code was used.
+		     * We need this addition in case the QNX or Cygwin
+		     * code was used.
 		     */
 
 		    *driveNameLengthPtr = (1 + path - origPath);
@@ -600,11 +608,20 @@ SplitUnixPath(
     }
 #endif
 
+    p = path;
     if (path[0] == '/') {
-	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
-	p = path+1;
-    } else {
-	p = path;
+	Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1);
+	p++;
+#ifdef __CYGWIN__
+	/*
+	 * Check for Cygwin // network path prefix
+	 */
+	if (path[1] == '/') {
+	    Tcl_AppendToObj(rootElt, "/", 1);
+	    p++;
+	}
+#endif
+	Tcl_ListObjAppendElement(NULL, result, rootElt);
     }
 
     /*
@@ -2142,6 +2159,11 @@ DoGlob(
 		    && (strchr(separators, lastChar) == NULL))
 		    || ((length == 0) && (count > 0)))) {
 		Tcl_DStringAppend(&append, "/", 1);
+#ifdef __CYGWIN__
+		if ((length == 0) && (count > 1)) {
+		    Tcl_DStringAppend(&append, "/", 1);
+		}
+#endif
 	    }
 	    break;
 	}