diff options
author | hobbs <hobbs> | 1999-09-02 16:26:33 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-09-02 16:26:33 (GMT) |
commit | dda9412829471d1e8b6666f67ad5f9e6b74f37cf (patch) | |
tree | 4fa94ab0ae4f915245091718248d0bcce74f1e22 /generic/tclProc.c | |
parent | 8de7074c8b742a0793dfabbe010cd53d4616f0b1 (diff) | |
download | tcl-dda9412829471d1e8b6666f67ad5f9e6b74f37cf.zip tcl-dda9412829471d1e8b6666f67ad5f9e6b74f37cf.tar.gz tcl-dda9412829471d1e8b6666f67ad5f9e6b74f37cf.tar.bz2 |
1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
* generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD
happy [Bug: 2625]
* generic/tclProc.c: moved static buf to better location and
changed static msg that would overflow in ProcessProcResultCode
[Bug: 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd.
Also reworked size of static buffers.
* tests/stringObj.test: added test 9.11
* generic/tclStringObj.c: changed Tcl_AppendObjToObj to
properly handle the 1-byte dest and mixed src case where
both had had Unicode string len checks made on them. [Bug: 2678]
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 25 |
1 files changed, 17 insertions, 8 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 3609d16..ac07cae 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.19 1999/04/16 00:46:52 stanton Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.20 1999/09/02 16:26:33 hobbs Exp $ */ #include "tclInt.h" @@ -135,6 +135,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv) cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc); + Tcl_DStringFree(&ds); /* * Now initialize the new procedure's cmdPtr field. This will be used * later when the procedure is called to determine what namespace the @@ -265,7 +266,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr) if (precompiled) { if (numArgs > procPtr->numArgs) { - char buf[128]; + char buf[64 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE]; sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d", numArgs, procPtr->numArgs); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -351,7 +352,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr) && (fieldCount == 2)) || ((localPtr->defValuePtr != NULL) && (fieldCount != 2))) { - char buf[128]; + char buf[80 + TCL_INTEGER_SPACE]; sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body", i); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -1087,7 +1088,6 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) } } if (bodyPtr->typePtr != &tclByteCodeType) { - char buf[100]; int numChars; char *ellipsis; @@ -1133,6 +1133,8 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) if (result != TCL_OK) { if (result == TCL_ERROR) { + char buf[100 + TCL_INTEGER_SPACE]; + numChars = strlen(procName); ellipsis = ""; if (numChars > 50) { @@ -1201,13 +1203,20 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode) int returnCode; /* The unexpected result code. */ { Interp *iPtr = (Interp *) interp; - char msg[100 + TCL_INTEGER_SPACE]; - + if (returnCode == TCL_RETURN) { returnCode = TclUpdateReturnInfo(iPtr); } else if (returnCode == TCL_ERROR) { - sprintf(msg, "\n (procedure \"%.*s\" line %d)", - nameLen, procName, iPtr->errorLine); + 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) { Tcl_ResetResult(interp); |