From 027921a39965b6319c9ebc373d9a41de26086e4b Mon Sep 17 00:00:00 2001
From: "dgp@users.sourceforge.net" <dgp>
Date: Tue, 24 Jan 2012 22:50:46 +0000
Subject: 3475569 Add value-sharing checks before calls that demand unshared
 arguments.

---
 generic/tclPathObj.c | 26 ++++++++++++++++++++------
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index eb19096..c32202d 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -269,6 +269,14 @@ TclFSNormalizeAbsolutePath(
 		}
 		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
 		    link = Tcl_FSLink(retVal, NULL, 0);
+
+		    /* Safety check in case driver caused sharing */
+		    if (Tcl_IsShared(retVal)) {
+			TclDecrRefCount(retVal);
+			retVal = Tcl_DuplicateObj(retVal);
+			Tcl_IncrRefCount(retVal);
+		    }
+
 		    if (link != NULL) {
 			/*
 			 * Got a link. Need to check if the link is relative
@@ -292,11 +300,6 @@ TclFSNormalizeAbsolutePath(
 				    break;
 				}
 			    }
-			    if (Tcl_IsShared(retVal)) {
-				TclDecrRefCount(retVal);
-				retVal = Tcl_DuplicateObj(retVal);
-				Tcl_IncrRefCount(retVal);
-			    }
 
 			    /*
 			     * We want the trailing slash.
@@ -312,7 +315,12 @@ TclFSNormalizeAbsolutePath(
 			     */
 
 			    TclDecrRefCount(retVal);
-			    retVal = link;
+			    if (Tcl_IsShared(link)) {
+				retVal = Tcl_DuplicateObj(link);
+				TclDecrRefCount(link);
+			    } else {
+				retVal = link;
+			    }
 			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
 
 			    /*
@@ -1073,6 +1081,12 @@ Tcl_FSJoinPath(
 		if (sep != NULL) {
 		    separator = TclGetString(sep)[0];
 		}
+		/* Safety check in case the VFS driver caused sharing */
+		if (Tcl_IsShared(res)) {
+		    TclDecrRefCount(res);
+		    res = Tcl_DuplicateObj(res);
+		    Tcl_IncrRefCount(res);
+		}
 	    }
 
 	    if (length > 0 && ptr[length -1] != '/') {
-- 
cgit v0.12


From ff2c0a865f01e1e4f13edc2ac576d469da91c1c3 Mon Sep 17 00:00:00 2001
From: "dgp@users.sourceforge.net" <dgp>
Date: Thu, 26 Jan 2012 16:26:38 +0000
Subject: yank back debugging code

---
 generic/tclObj.c | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/generic/tclObj.c b/generic/tclObj.c
index a30ba6e..5c17df2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -384,9 +384,6 @@ typedef struct ResolvedCmdName {
 void
 TclInitObjSubsystem(void)
 {
-    ObjInitDeletionContext(context);
-    ObjDeletionLock(context);
-
     Tcl_MutexLock(&tableMutex);
     typeTableInitialized = 1;
     Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
@@ -488,9 +485,6 @@ TclFinalizeThreadObjects(void)
 void
 TclFinalizeObjects(void)
 {
-    ObjInitDeletionContext(context);
-    ObjDeletionUnlock(context);
-
     Tcl_MutexLock(&tableMutex);
     if (typeTableInitialized) {
 	Tcl_DeleteHashTable(&typeTable);
-- 
cgit v0.12