Tcl Source Code

Artifact [d0b8219393]
Login

Artifact d0b821939396e5bffd0f3f3453b8505efae66256:

Attachment "1522803.patch" to ticket [1522803fff] added by dgp 2006-07-21 00:17:35.
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.238
diff -u -r1.238 tclExecute.c
--- generic/tclExecute.c	20 Jul 2006 06:17:38 -0000	1.238
+++ generic/tclExecute.c	20 Jul 2006 17:09:16 -0000
@@ -1791,7 +1791,7 @@
 	     */
 
 	    DECACHE_STACK_INFO();
-	    Tcl_ResetResult(interp);
+	    /*Tcl_ResetResult(interp);*/
 	    result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
 	    CACHE_STACK_INFO();
 
@@ -1890,7 +1890,7 @@
 
 	objPtr = *tosPtr;
 	DECACHE_STACK_INFO();
-	Tcl_ResetResult(interp);
+	/*Tcl_ResetResult(interp);*/
 	result = Tcl_ExprObj(interp, objPtr, &valuePtr);
 	CACHE_STACK_INFO();
 	if (result != TCL_OK) {
@@ -5205,17 +5205,21 @@
     }
 
     case INST_BREAK:
+	/*
 	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
 	CACHE_STACK_INFO();
+	*/
 	result = TCL_BREAK;
 	cleanup = 0;
 	goto processExceptionReturn;
 
     case INST_CONTINUE:
+	/*
 	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
 	CACHE_STACK_INFO();
+	*/
 	result = TCL_CONTINUE;
 	cleanup = 0;
 	goto processExceptionReturn;
@@ -5411,6 +5415,7 @@
 
     case INST_END_CATCH:
 	catchTop--;
+	Tcl_ResetResult(interp);
 	result = TCL_OK;
 	TRACE(("=> catchTop=%d\n", (catchTop - initCatchTop - 1)));
 	NEXT_INST_F(1, 0, 0);
@@ -5474,7 +5479,7 @@
 	    goto checkForCatch;
 	}
 	if (objResultPtr == NULL) {
-	    Tcl_ResetResult(interp);
+	    /*Tcl_ResetResult(interp);*/
 	    Tcl_AppendResult(interp, "key \"", TclGetString(*tosPtr),
 		    "\" not known in dictionary", NULL);
 	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
Index: tests/execute.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/execute.test,v
retrieving revision 1.22
diff -u -r1.22 execute.test
--- tests/execute.test	21 Mar 2006 11:12:29 -0000	1.22
+++ tests/execute.test	20 Jul 2006 17:09:18 -0000
@@ -760,6 +760,20 @@
      interp recursionlimit {} $limit
  } -result {too many nested evaluations (infinite loop?)}
 
+test execute-9.1 {Interp result resetting [Bug 1522803]} {
+    set c 0
+    catch {
+	catch {set foo}
+	expr {1/$c}
+    }
+    if {[string match *foo* $::errorInfo]} {
+	set result "Bad errorInfo: $::errorInfo"
+    } else {
+	set result SUCCESS
+    }
+    set result
+} SUCCESS
+
 # cleanup
 if {[info commands testobj] != {}} {
    testobj freeallvars