From 0e3bef140229f3634ae322b472705dbe25a237e0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Apr 2025 14:22:57 +0000 Subject: First attempt at fixing [92aeb847f9]: proc with more than 2**31 variables. At least, prevent the crash. --- generic/tclProc.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index d0f4cb9..7493934 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -637,8 +637,17 @@ TclCreateProc( * local variables for the argument. */ - localPtr = (CompiledLocal *)Tcl_Alloc( + localPtr = (CompiledLocal *)Tcl_AttemptAlloc( offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length); + if (!localPtr) { + 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); + goto procError; + } + if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { -- cgit v0.12 From 68f3bddbba217e20a6bbda89911ba8d7df1e621b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Apr 2025 14:43:12 +0000 Subject: Slight improvement: Cleanup before creating error-message --- generic/tclProc.c | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index 7493934..7694908 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -414,7 +414,7 @@ TclCreateProc( Tcl_Size i, numArgs; CompiledLocal *localPtr = NULL; Tcl_Obj **argArray; - int precompiled = 0, result; + int precompiled = 0, memoryerror = 0, result; ProcGetInternalRep(bodyPtr, procPtr); if (procPtr != NULL) { @@ -640,11 +640,9 @@ TclCreateProc( localPtr = (CompiledLocal *)Tcl_AttemptAlloc( offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length); if (!localPtr) { - 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); + /* Don't set the interp result here. Since a malloc just failed, + * first clean up some memory before doing that */ + memoryerror = 1; goto procError; } @@ -696,6 +694,13 @@ TclCreateProc( } Tcl_Free(procPtr); } + if (memoryerror) { + 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); + } return TCL_ERROR; } -- cgit v0.12 From 87224fa4f1851fd60e1bf4435f17069759f6f389 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" 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