Rebase to TIP #689 branch

1 files changed, 54 insertions, 0 deletions

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 43f003b..38ef79a 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2074,6 +2074,60 @@ DictSizeCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclDictObjSmartRef --
+ *
+ *	This function returns new tcl-object with the smart reference to
+ *	dictionary object.
+ *
+ *	Object returned with this function is a smart reference (pointer),
+ *	so new object of type tclDictType, that directly references given
+ *	dictionary object (with internally increased refCount).
+ *
+ *	The usage of such pointer objects allows to hold more as one
+ *	reference to the same real dictionary object, allows to make a pointer
+ *	to part of another dictionary, allows to change the dictionary without
+ *	regarding of the "shared" state of the dictionary object.
+ *
+ *	Prevents "called with shared object" exception if object is multiple
+ *	referenced.
+ *
+ * Results:
+ *	The newly create object (contains smart reference) is returned.
+ *	The returned object has a ref count of 0.
+ *
+ * Side effects:
+ *	Increases ref count of the referenced dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDictObjSmartRef(
+    Tcl_Interp *interp,
+    Tcl_Obj    *dictPtr)
+{
+    Tcl_Obj *result;
+    Dict    *dict;
+
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return NULL;
+    }
+
+    DictGetInternalRep(dictPtr, dict);
+
+    result = Tcl_NewObj();
+    DictSetInternalRep(result, dict);
+    dict->refCount++;
+    result->internalRep.twoPtrValue.ptr2 = NULL;
+    result->typePtr = &tclDictType;
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * DictExistsCmd --
  *
  *	This function implements the "dict exists" Tcl command. See the user