Tcl Source Code

Artifact [50d1944836]
Login

Artifact 50d1944836df161a30577cdf9e0b7a7a8a2719a4:

Attachment "rootname.patch" to ticket [2918610fff] added by ferrieux 2009-12-22 17:47:29.
Index: generic/tclPathObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPathObj.c,v
retrieving revision 1.84
diff -u -p -r1.84 tclPathObj.c
--- generic/tclPathObj.c	27 Oct 2009 20:31:08 -0000	1.84
+++ generic/tclPathObj.c	22 Dec 2009 10:46:01 -0000
@@ -688,6 +688,28 @@ TclPathPart(
 			root->length -= strlen(extension);
 			root->bytes[root->length] = 0;
 		    }
+
+                    /*
+                     * Must also invalidate native and translated since we
+                     * inherited them from the longer input path.
+                     */
+
+                    if (fsDupPtr->translatedPathPtr != NULL) {
+                        Tcl_DecrRefCount(fsDupPtr->translatedPathPtr);
+                        fsDupPtr->translatedPathPtr = NULL;
+                    }
+
+                    if (fsDupPtr->nativePathPtr != NULL) {
+                        if (fsDupPtr->fsRecPtr != NULL) {
+                            Tcl_FSFreeInternalRepProc *freeProc =
+                                fsDupPtr->fsRecPtr->fsPtr->freeInternalRepProc;
+                            
+                            if (freeProc != NULL) {
+                                freeProc(fsDupPtr->nativePathPtr);
+                            }
+                        }
+                        fsDupPtr->nativePathPtr = NULL;
+                    }
 		    return root;
 		}
 	    }
@@ -2778,5 +2800,7 @@ TclNativePathInFilesystem(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */