From 87224fa4f1851fd60e1bf4435f17069759f6f389 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 14 Apr 2025 08:10:56 +0000
Subject: Error-message cleanup

---
 generic/tclProc.c | 38 +++++++++++++++++---------------------
 1 file changed, 17 insertions(+), 21 deletions(-)

diff --git a/generic/tclProc.c b/generic/tclProc.c
index 7694908..2cd47d8 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -399,6 +399,8 @@ Tcl_ProcObjCmd(
  *----------------------------------------------------------------------
  */
 
+static const char TOOMANYARGS[] = "TOOMANYARGS";
+
 int
 TclCreateProc(
     Tcl_Interp *interp,		/* Interpreter containing proc. */
@@ -414,7 +416,8 @@ TclCreateProc(
     Tcl_Size i, numArgs;
     CompiledLocal *localPtr = NULL;
     Tcl_Obj **argArray;
-    int precompiled = 0, memoryerror = 0, result;
+    int precompiled = 0, result;
+    const char *errorCode = NULL;
 
     ProcGetInternalRep(bodyPtr, procPtr);
     if (procPtr != NULL) {
@@ -502,8 +505,7 @@ TclCreateProc(
 		    "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "d entries, "
 		    "precompiled header expects %" TCL_SIZE_MODIFIER "d", procName, numArgs,
 		    procPtr->numArgs));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "BYTECODELIES", (char *)NULL);
+	    errorCode = "BYTECODELIES";
 	    goto procError;
 	}
 	localPtr = procPtr->firstLocalPtr;
@@ -532,15 +534,12 @@ TclCreateProc(
 	    Tcl_AppendObjToObj(errorObj, argArray[i]);
 	    Tcl_AppendToObj(errorObj, "\"", -1);
 	    Tcl_SetObjResult(interp, errorObj);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "FORMALARGUMENTFORMAT", (char *)NULL);
-	    goto procError;
+	    errorCode = "FORMALARGUMENTFORMAT";
 	}
 	if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "argument with no name", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "FORMALARGUMENTFORMAT", (char *)NULL);
+	    errorCode = "FORMALARGUMENTFORMAT";
 	    goto procError;
 	}
 
@@ -558,8 +557,7 @@ TclCreateProc(
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			    "formal parameter \"%s\" is an array element",
 			    TclGetString(fieldValues[0])));
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			    "FORMALARGUMENTFORMAT", (char *)NULL);
+		    errorCode = "FORMALARGUMENTFORMAT";
 		    goto procError;
 		}
 	    } else if (argnamei[0] == ':' && argnamei[1] == ':') {
@@ -568,8 +566,7 @@ TclCreateProc(
 		Tcl_AppendObjToObj(errorObj, fieldValues[0]);
 		Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
 		Tcl_SetObjResult(interp, errorObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			"FORMALARGUMENTFORMAT", (char *)NULL);
+		errorCode = "FORMALARGUMENTFORMAT";
 		goto procError;
 	    }
 	    argnamei++;
@@ -596,8 +593,7 @@ TclCreateProc(
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "d is "
 			"inconsistent with precompiled body", procName, i));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			"BYTECODELIES", (char *)NULL);
+		errorCode = "BYTECODELIES";
 		goto procError;
 	    }
 
@@ -618,8 +614,7 @@ TclCreateProc(
 		    Tcl_AppendToObj(errorObj, "\" has "
 			"default value inconsistent with precompiled body", -1);
 		    Tcl_SetObjResult(interp, errorObj);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			    "BYTECODELIES", (char *)NULL);
+		    errorCode = "BYTECODELIES";
 		    goto procError;
 		}
 	    }
@@ -642,10 +637,9 @@ TclCreateProc(
 	    if (!localPtr) {
 		/* Don't set the interp result here. Since a malloc just failed,
 		 * first clean up some memory before doing that */
-		memoryerror = 1;
+		errorCode = TOOMANYARGS;
 		goto procError;
 	    }
-
 	    if (procPtr->firstLocalPtr == NULL) {
 		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	    } else {
@@ -694,12 +688,14 @@ TclCreateProc(
 	}
 	Tcl_Free(procPtr);
     }
-    if (memoryerror) {
+    if (errorCode) {
+	if (errorCode == TOOMANYARGS) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "procedure \"%s\": arg list contains too many (%"
 		    TCL_SIZE_MODIFIER "d) entries", procName, numArgs));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "TOOMANYARGS", (char *)NULL);
+	}
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		errorCode, (char *)NULL);
     }
     return TCL_ERROR;
 }
-- 
cgit v0.12