TIP #353 IMPLEMENTATION

        * doc/NRE.3:            New public routine Tcl_NRExprObj() permits
        * generic/tcl.decls:    extension commands to evaluate Tcl expressions
        * generic/tclBasic.c:   in NR-enabled command procedures.
        * generic/tclCmdAH.c:
        * generic/tclExecute.c:
        * generic/tclInt.h:
        * generic/tclObj.c:
        * tests/expr.test:

        * generic/tclDecls.h:           make genstubs
        * generic/tclStubInit.c:

1 files changed, 35 insertions, 18 deletions

diff --git a/generic/tclObj.c b/generic/tclObj.c
index 46758fa..8052028 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.154 2009/08/02 13:03:47 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.155 2009/08/12 16:06:44 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1133,30 +1133,47 @@ TclObjBeingDeleted(
  *----------------------------------------------------------------------
  */
 
+#define SetDuplicateObj(dupPtr, objPtr)					\
+    {									\
+	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
+	const char *bytes = (objPtr)->bytes;				\
+	if (bytes) {							\
+	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
+	} else {							\
+	    (dupPtr)->bytes = NULL;					\
+	}								\
+	if (typePtr) {							\
+	    if (typePtr->dupIntRepProc) {				\
+		typePtr->dupIntRepProc((objPtr), (dupPtr));		\
+	    } else {							\
+		(dupPtr)->internalRep = (objPtr)->internalRep;		\
+		(dupPtr)->typePtr = typePtr;				\
+	    }								\
+	}								\
+    }
+
 Tcl_Obj *
 Tcl_DuplicateObj(
-    register Tcl_Obj *objPtr)		/* The object to duplicate. */
+    Tcl_Obj *objPtr)		/* The object to duplicate. */
 {
-    register const Tcl_ObjType *typePtr = objPtr->typePtr;
-    register Tcl_Obj *dupPtr;
+    Tcl_Obj *dupPtr;
 
     TclNewObj(dupPtr);
+    SetDuplicateObj(dupPtr, objPtr);
+    return dupPtr;
+}
 
-    if (objPtr->bytes == NULL) {
-	dupPtr->bytes = NULL;
-    } else if (objPtr->bytes != tclEmptyStringRep) {
-	TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
-    }
-
-    if (typePtr != NULL) {
-	if (typePtr->dupIntRepProc == NULL) {
-	    dupPtr->internalRep = objPtr->internalRep;
-	    dupPtr->typePtr = typePtr;
-	} else {
-	    typePtr->dupIntRepProc(objPtr, dupPtr);
-	}
+void
+TclSetDuplicateObj(
+    Tcl_Obj *dupPtr,
+    Tcl_Obj *objPtr)
+{
+    if (Tcl_IsShared(dupPtr)) {
+	Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
     }
-    return dupPtr;
+    TclInvalidateStringRep(dupPtr);
+    TclFreeIntRep(dupPtr);
+    SetDuplicateObj(dupPtr, objPtr);
 }
 
 /*