Tcl Source Code

Artifact [9a347b7d48]
Login

Artifact 9a347b7d484ae3215e8021b4a05d9561735296b8:

Attachment "proc.patch3" to ticket [536955ffff] added by dgp 2002-04-06 04:52:25.
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.36
diff -u -u -r1.36 tclProc.c
--- generic/tclProc.c	25 Jan 2002 20:40:55 -0000	1.36
+++ generic/tclProc.c	5 Apr 2002 21:50:41 -0000
@@ -1283,33 +1283,32 @@
     int returnCode;		/* The unexpected result code. */
 {
     Interp *iPtr = (Interp *) interp;
+    char msg[100 + TCL_INTEGER_SPACE];
+    char *ellipsis = "";
 
+    if (returnCode == TCL_OK) {
+	return TCL_OK;
+    }
+    if (returnCode > TCL_CONTINUE) {
+	return returnCode;
+    }
     if (returnCode == TCL_RETURN) {
-	returnCode = TclUpdateReturnInfo(iPtr);
-    } else if (returnCode == TCL_ERROR) {
-	char msg[100 + TCL_INTEGER_SPACE];
-	char *ellipsis = "";
-	int numChars = nameLen;
-
-	if (numChars > 60) {
-	    numChars = 60;
-	    ellipsis = "...";
-	}
-	sprintf(msg, "\n    (procedure \"%.*s%s\" line %d)",
-		numChars, procName, ellipsis, iPtr->errorLine);
-	Tcl_AddObjErrorInfo(interp, msg, -1);
-    } else if (returnCode == TCL_BREAK) {
+	return TclUpdateReturnInfo(iPtr);
+    } 
+    if (returnCode != TCL_ERROR) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"invoked \"break\" outside of a loop", -1);
-	returnCode = TCL_ERROR;
-    } else if (returnCode == TCL_CONTINUE) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "invoked \"continue\" outside of a loop", -1);
-	returnCode = TCL_ERROR;
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK) 
+		? "invoked \"break\" outside of a loop"
+		: "invoked \"continue\" outside of a loop"), -1);
+    }
+    if (nameLen > 60) {
+	nameLen = 60;
+	ellipsis = "...";
     }
-    return returnCode;
+    sprintf(msg, "\n    (procedure \"%.*s%s\" line %d)", nameLen, procName,
+	    ellipsis, iPtr->errorLine);
+    Tcl_AddObjErrorInfo(interp, msg, -1);
+    return TCL_ERROR;
 }
 
 /*
Index: tests/proc-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/proc-old.test,v
retrieving revision 1.8
diff -u -u -r1.8 proc-old.test
--- tests/proc-old.test	31 Jul 2001 19:12:07 -0000	1.8
+++ tests/proc-old.test	5 Apr 2002 21:50:41 -0000
@@ -332,7 +332,8 @@
     catch tproc msg
     set errorInfo
 } {invoked "break" outside of a loop
-    while executing
+    (procedure "tproc" line 1)
+    invoked from within
 "tproc"}
 test proc-old-5.15 {error conditions} {
     proc tproc {} {
@@ -343,7 +344,8 @@
     catch tproc msg
     set errorInfo
 } {invoked "continue" outside of a loop
-    while executing
+    (procedure "tproc" line 1)
+    invoked from within
 "tproc"}
 test proc-old-5.16 {error conditions} {
     proc foo args {