* generic/tclResult.c: Added optimization case to TclTransferResult

        to cover common case where there's big savings over the fully general
        path.  Thanks to Peter MacDonald.  [Bug 1626518].

1 files changed, 17 insertions, 5 deletions

diff --git a/generic/tclResult.c b/generic/tclResult.c
index 37f037b..1d56e6f 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclResult.c,v 1.32 2005/11/02 00:55:06 dkf Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.33 2007/01/29 18:55:50 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1542,15 +1542,27 @@ TclTransferResult(
 				 * should be stored. If source and target are
 				 * the same, nothing is done. */
 {
-    Interp *iPtr = (Interp *) targetInterp;
+    Interp *tiPtr = (Interp *) targetInterp;
+    Interp *siPtr = (Interp *) sourceInterp;
 
     if (sourceInterp == targetInterp) {
 	return;
     }
 
-    Tcl_SetReturnOptions(targetInterp,
-	    Tcl_GetReturnOptions(sourceInterp, result));
-    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
+    if (result == TCL_OK && siPtr->returnOpts == NULL) {
+	/*
+	 * Special optimization for the common case of normal
+	 * command return code and no explicit return options.
+	 */
+	if (tiPtr->returnOpts) {
+	    Tcl_DecrRefCount(tiPtr->returnOpts);
+	    tiPtr->returnOpts = NULL;
+	}
+    } else {
+	Tcl_SetReturnOptions(targetInterp,
+		Tcl_GetReturnOptions(sourceInterp, result));
+	tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
+    }
     Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
     Tcl_ResetResult(sourceInterp);
 }