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:
*/