diff options
Diffstat (limited to 'generic/tclProc.c')
| -rw-r--r-- | generic/tclProc.c | 54 |
1 files changed, 24 insertions, 30 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 0de0dd6..f4d2210 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -408,11 +408,8 @@ TclCreateProc( register Proc *procPtr = NULL; int i, result, numArgs; - size_t plen; - const char *bytes, *argname, *argnamei; - char argnamelast; register CompiledLocal *localPtr = NULL; - Tcl_Obj *defPtr, *errorObj, **argArray; + Tcl_Obj **argArray; int precompiled = 0; ProcGetIntRep(bodyPtr, procPtr); @@ -449,6 +446,7 @@ TclCreateProc( */ if (Tcl_IsShared(bodyPtr)) { + const char *bytes; size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; @@ -511,8 +509,8 @@ TclCreateProc( } for (i = 0; i < numArgs; i++) { + const char *argname, *argnamei, *argnamelast; int fieldCount, nameLength; - size_t valueLength; Tcl_Obj **fieldValues; /* @@ -525,7 +523,7 @@ TclCreateProc( goto procError; } if (fieldCount > 2) { - errorObj = Tcl_NewStringObj( + Tcl_Obj *errorObj = Tcl_NewStringObj( "too many fields in argument specifier \"", -1); Tcl_AppendObjToObj(errorObj, argArray[i]); Tcl_AppendToObj(errorObj, "\"", -1); @@ -542,24 +540,17 @@ TclCreateProc( goto procError; } - argname = TclGetStringFromObj(fieldValues[0], &plen); - nameLength = Tcl_NumUtfChars(argname, plen); - if (fieldCount == 2) { - const char * value = TclGetString(fieldValues[1]); - valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length); - } else { - valueLength = 0; - } + argname = TclGetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. */ argnamei = argname; - argnamelast = argname[plen-1]; - while (plen--) { - if (argnamei[0] == '(') { - if (argnamelast == ')') { /* We have an array element. */ + argnamelast = Tcl_UtfPrev(argname + nameLength, argname); + while (argnamei < argnamelast) { + if (*argnamei == '(') { + if (*argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", Tcl_GetString(fieldValues[0]))); @@ -567,8 +558,9 @@ TclCreateProc( "FORMALARGUMENTFORMAT", NULL); goto procError; } - } else if ((argnamei[0] == ':') && (argnamei[1] == ':')) { - errorObj = Tcl_NewStringObj("formal parameter \"", -1); + } else if (*argnamei == ':' && *(argnamei+1) == ':') { + Tcl_Obj *errorObj = Tcl_NewStringObj( + "formal parameter \"", -1); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); Tcl_SetObjResult(interp, errorObj); @@ -592,7 +584,7 @@ TclCreateProc( */ if ((localPtr->nameLength != nameLength) - || (Tcl_UtfNcmp(localPtr->name, argname, nameLength)) + || (memcmp(localPtr->name, argname, nameLength) != 0) || (localPtr->frameIndex != i) || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) @@ -612,11 +604,14 @@ TclCreateProc( if (localPtr->defValuePtr != NULL) { const char *tmpPtr = TclGetString(localPtr->defValuePtr); size_t tmpLength = localPtr->defValuePtr->length; - - if ((valueLength != tmpLength) || - Tcl_UtfNcmp(Tcl_GetString(fieldValues[1]), tmpPtr, tmpLength)) { - errorObj = Tcl_ObjPrintf( - "procedure \"%s\": formal parameter \"" ,procName); + const char *value = TclGetString(fieldValues[1]); + size_t valueLength = fieldValues[1]->length; + + if ((valueLength != tmpLength) + || memcmp(value, tmpPtr, tmpLength) != 0 + ) { + Tcl_Obj *errorObj = Tcl_ObjPrintf( + "procedure \"%s\": formal parameter \"", procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" has " "default value inconsistent with precompiled body", -1); @@ -663,7 +658,7 @@ TclCreateProc( if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') - && (strcmp(localPtr->name, "args") == 0)) { + && (memcmp(localPtr->name, "args", 4) == 0)) { localPtr->flags |= VAR_IS_ARGS; } } @@ -681,9 +676,8 @@ TclCreateProc( localPtr = procPtr->firstLocalPtr; procPtr->firstLocalPtr = localPtr->nextPtr; - defPtr = localPtr->defValuePtr; - if (defPtr != NULL) { - Tcl_DecrRefCount(defPtr); + if (localPtr->defValuePtr != NULL) { + Tcl_DecrRefCount(localPtr->defValuePtr); } Tcl_Free(localPtr); |