From 673569a56fe781a8d50e13bd0057ac451698a065 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 29 Nov 2016 18:46:41 +0000 Subject: Where feasible, convert concatenation panics into errors. --- generic/tclStringObj.c | 55 +++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 9 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index f7791fe..34931e0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2691,7 +2691,7 @@ TclStringCatObjv( if (objPtr->bytes == NULL) { int numBytes; - Tcl_GetByteArrayFromObj(objPtr, &numBytes); + Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (length == 0) { first = objc - oc - 1; } @@ -2707,7 +2707,7 @@ TclStringCatObjv( if ((objPtr->bytes == NULL) || (objPtr->length)) { int numChars; - Tcl_GetUnicodeFromObj(objPtr, &numChars); + Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (length == 0) { first = objc - oc - 1; } @@ -2722,7 +2722,7 @@ TclStringCatObjv( objPtr = *ov++; - Tcl_GetStringFromObj(objPtr, &numBytes); + Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ if ((length == 0) && numBytes) { first = objc - oc - 1; } @@ -2751,6 +2751,11 @@ TclStringCatObjv( /* Efficiently produce a pure byte array result */ unsigned char *dst; + /* + * Broken interface! Byte array value routines offer no way + * to handle failure to allocate enough space. Following + * stanza may panic. + */ if (inPlace && !Tcl_IsShared(*objv)) { int start; @@ -2783,14 +2788,30 @@ TclStringCatObjv( /* Ugly interface! Force resize of the unicode array. */ Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); - Tcl_SetObjLength(objResultPtr, length); + if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "concatenation failed: unable to alloc %lu bytes", + STRING_SIZE(length))); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } dst = Tcl_GetUnicode(objResultPtr) + start; } else { Tcl_UniChar ch = 0; /* Ugly interface! No scheme to init array size. */ - objResultPtr = Tcl_NewUnicodeObj(&ch, 0); - Tcl_SetObjLength(objResultPtr, length); + objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */ + if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "concatenation failed: unable to alloc %lu bytes", + STRING_SIZE(length))); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { @@ -2813,14 +2834,30 @@ TclStringCatObjv( objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); - Tcl_SetObjLength(objResultPtr, length); + if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "concatenation failed: unable to alloc %u bytes", + length)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } dst = Tcl_GetString(objResultPtr) + start; if (length > start) { TclFreeIntRep(objResultPtr); } } else { - objResultPtr = Tcl_NewObj(); - Tcl_SetObjLength(objResultPtr, length); + objResultPtr = Tcl_NewObj(); /* PANIC? */ + if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "concatenation failed: unable to alloc %u bytes", + length)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } dst = Tcl_GetString(objResultPtr); } while (objc--) { -- cgit v0.12