diff options
Diffstat (limited to 'generic/tclProc.c')
| -rw-r--r-- | generic/tclProc.c | 40 |
1 files changed, 32 insertions, 8 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 96bdcf3..5c68e17 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -343,7 +343,7 @@ Tcl_ProcObjCmd( * The argument list is just "args"; check the body */ - procBody = TclGetStringFromObj(objv[3], &numBytes); + procBody = Tcl_GetStringFromObj(objv[3], &numBytes); if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) { goto done; } @@ -500,8 +500,7 @@ TclCreateProc( } for (i = 0; i < numArgs; i++) { - int fieldCount, nameLength; - size_t valueLength; + int fieldCount, nameLength, valueLength; const char **fieldValues; /* @@ -603,11 +602,12 @@ TclCreateProc( */ if (localPtr->defValuePtr != NULL) { - const char *tmpPtr = TclGetString(localPtr->defValuePtr); - size_t tmpLength = localPtr->defValuePtr->length; + int tmpLength; + const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, + &tmpLength); if ((valueLength != tmpLength) || - strncmp(fieldValues[1], tmpPtr, tmpLength)) { + strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"%s\" has " "default value inconsistent with precompiled body", @@ -2083,7 +2083,7 @@ MakeProcError( * messages and trace information. */ { int overflow, limit = 60, nameLen; - const char *procName = TclGetStringFromObj(procNameObj, &nameLen); + const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -2654,6 +2654,30 @@ TclNRApplyObjCmd( procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; } +#define JOE_EXTENSION 0 +/* + * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT + * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt + * the code. (MS) + */ + +#if JOE_EXTENSION + else { + /* + * Joe English's suggestion to allow cmdNames to function as lambdas. + */ + + Tcl_Obj *elemPtr; + int numElem; + + if ((lambdaPtr->typePtr == &tclCmdNameType) || + (TclListObjGetElements(interp, lambdaPtr, &numElem, + &elemPtr) == TCL_OK && numElem == 1)) { + return Tcl_EvalObjv(interp, objc-1, objv+1, 0); + } + } +#endif + if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) { result = SetLambdaFromAny(interp, lambdaPtr); if (result != TCL_OK) { @@ -2740,7 +2764,7 @@ MakeLambdaError( * messages and trace information. */ { int overflow, limit = 60, nameLen; - const char *procName = TclGetStringFromObj(procNameObj, &nameLen); + const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( |