Index: generic/gentclAPI.tcl =================================================================== diff -u -rf4471765bb7aec8c793b5e365499726619119f63 -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision f4471765bb7aec8c793b5e365499726619119f63) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -259,12 +259,12 @@ char *methodName; Tcl_ObjCmdProc *proc; int nrParameters; - parameterDefinition paramDefs[10]; + XOTclParam paramDefs[10]; } methodDefinition; static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], XOTclObject *obj, Tcl_Obj *procName, - parameterDefinition CONST *paramPtr, int nrParameters, parseContext *pc); + XOTclParam CONST *paramPtr, int nrParameters, parseContext *pc); static int getMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj, XOTclObject **matchObject, char **pattern); Index: generic/tclAPI.h =================================================================== diff -u -rf4471765bb7aec8c793b5e365499726619119f63 -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/tclAPI.h (.../tclAPI.h) (revision f4471765bb7aec8c793b5e365499726619119f63) +++ generic/tclAPI.h (.../tclAPI.h) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -22,12 +22,12 @@ char *methodName; Tcl_ObjCmdProc *proc; int nrParameters; - parameterDefinition paramDefs[10]; + XOTclParam paramDefs[10]; } methodDefinition; static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], XOTclObject *obj, Tcl_Obj *procName, - parameterDefinition CONST *paramPtr, int nrParameters, parseContext *pc); + XOTclParam CONST *paramPtr, int nrParameters, parseContext *pc); static int getMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj, XOTclObject **matchObject, char **pattern); Index: generic/xotcl.c =================================================================== diff -u -rf4471765bb7aec8c793b5e365499726619119f63 -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/xotcl.c (.../xotcl.c) (revision f4471765bb7aec8c793b5e365499726619119f63) +++ generic/xotcl.c (.../xotcl.c) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -192,7 +192,7 @@ void parseContextExtendObjv(parseContext *pc, int from, int elts, Tcl_Obj *CONST source[]) { int requiredSize = from + elts; - /* XOTclPrintObjv("BEFORE: ", pc->objc, pc->full_objv); */ + /*XOTclPrintObjv("BEFORE: ", pc->objc, pc->full_objv);*/ if (requiredSize > PARSE_CONTEXT_PREALLOC) { if (pc->objv == &pc->objv_static[1]) { @@ -211,7 +211,7 @@ memcpy(pc->objv + from, source, sizeof(Tcl_Obj *) * (elts)); pc->objc += elts; - /* XOTclPrintObjv("AFTER: ", pc->objc, pc->full_objv); */ + /*XOTclPrintObjv("AFTER: ", pc->objc, pc->full_objv);*/ } void parseContextRelease(parseContext *pc) { @@ -4847,12 +4847,14 @@ #endif } +static void ParamDefsFree(XOTclParamDefs *paramDefs); + void XOTclProcDeleteProc(ClientData clientData) { XOTclProcContext *ctxPtr = (XOTclProcContext *)clientData; (*ctxPtr->oldDeleteProc)(ctxPtr->oldDeleteData); if (ctxPtr->paramDefs) { - fprintf(stderr, "would free %p\n",ctxPtr->paramDefs); - /*FREE(XOTclProcContext, ctxPtr->clientData);*/ + /*fprintf(stderr, "free ParamDefs %p\n",ctxPtr->paramDefs);*/ + ParamDefsFree(ctxPtr->paramDefs); } /*fprintf(stderr, "free %p\n",ctxPtr);*/ FREE(XOTclProcContext, ctxPtr); @@ -4873,6 +4875,26 @@ return FindProc(interp, Tcl_Namespace_cmdTable(class->nsPtr), methodName); } + +static XOTclParam *ParamsNew(int nr) { + XOTclParam *paramsPtr = NEW_ARRAY(XOTclParam,nr+1); + memset(paramsPtr, 0, sizeof(XOTclParam)*(nr+1)); + return paramsPtr; +} + +static void ParamsFree(XOTclParam *paramsPtr) { + XOTclParam *paramPtr; + + /*fprintf(stderr,"ParamsFree %p\n", paramsPtr);*/ + for (paramPtr=paramsPtr; paramPtr->name; paramPtr++) { + /*fprintf(stderr,".... paramPtr = %p, name=%s, defaultValue %p\n",paramPtr,paramPtr->name,paramPtr->defaultValue);*/ + if (paramPtr->name) ckfree(paramPtr->name); + if (paramPtr->nameObj) {DECR_REF_COUNT(paramPtr->nameObj);} + if (paramPtr->defaultValue) {DECR_REF_COUNT(paramPtr->defaultValue);} + } + FREE(XOTclParam*,paramsPtr); +} + static XOTclParamDefs * ParamDefsGet(Tcl_Command cmdPtr) { if (Tcl_Command_deleteProc(cmdPtr) == XOTclProcDeleteProc) { @@ -4898,8 +4920,64 @@ return TCL_ERROR; } +static void +ParamDefsFree(XOTclParamDefs *paramDefs) { + /*fprintf(stderr, "ParamDefsFree %p\n",paramDefs);*/ + if (paramDefs->paramsPtr) { + ParamsFree(paramDefs->paramsPtr); + } + FREE(XOTclParamDefs, paramDefs); +} /* + * Non Positional Args + */ + +static Tcl_Obj * +ParamDefsFormat(Tcl_Interp *interp, XOTclParamDefs *paramDefs) { + int first; + Tcl_Obj *list = Tcl_NewListObj(0, NULL), *innerlist, *nameStringObj; + XOTclParam CONST *pPtr; + + for (pPtr = paramDefs->paramsPtr; pPtr->name; pPtr++) { + if (*pPtr->name == '-') { + first = 1; + nameStringObj = Tcl_NewStringObj(pPtr->name, -1); + if ((pPtr->flags & XOTCL_ARG_REQUIRED) || pPtr->type) { + Tcl_AppendToObj(nameStringObj,":", 1); + if (pPtr->flags & XOTCL_ARG_REQUIRED) { + first = 0; + Tcl_AppendToObj(nameStringObj,"required", 8); + } + if (pPtr->type) { + if (!first) + Tcl_AppendToObj(nameStringObj,",", 1); + Tcl_AppendToObj(nameStringObj,pPtr->type, -1); + } + } + + innerlist = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, innerlist, nameStringObj); + if (pPtr->defaultValue) { + Tcl_ListObjAppendElement(interp, innerlist, pPtr->defaultValue); + } + + Tcl_ListObjAppendElement(interp, list, innerlist); + } + } + return list; +} + +static void ParsedParamFree(XOTclParsedParam *parsedParamPtr) { + /*fprintf(stderr, "ParsedParamFree %p, npargs %p\n",parsedParamPtr,parsedParamPtr->paramDefs);*/ + if (parsedParamPtr->paramDefs) { + ParamDefsFree(parsedParamPtr->paramDefs); + } + FREE(XOTclParsedParam, parsedParamPtr); +} + + +/* * method dispatch */ @@ -4908,8 +4986,10 @@ invokeProcMethod(ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], char *methodName, XOTclObject *obj, XOTclClass *cl, Tcl_Command cmdPtr, XOTclCallStackContent *csc) { - int result; + int result, releasePc = 0; XOTclObjectOpt *opt = obj->opt; + parseContext pc; + #if defined(PRE85) XOTcl_FrameDecls; #endif @@ -5003,13 +5083,10 @@ ((XOTclProcContext *)Tcl_Command_deleteData(cmdPtr))->paramDefs : NULL; if (paramDefs) { - parseContext pc; - result = ProcessMethodArguments(&pc, interp, obj, 1, paramDefs, methodName, objc, objv); if (result == TCL_OK) { + releasePc = 1; result = PushProcCallFrame(cp, interp, pc.objc, pc.full_objv, csc); - /* maybe release is to early */ - parseContextRelease(&pc); } } else { result = PushProcCallFrame(cp, interp, objc, objv, csc); @@ -5028,6 +5105,9 @@ RUNTIME_STATE(interp)->cs.top->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); #endif result = TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError); + if (releasePc) { + parseContextRelease(&pc); + } } else { result = TCL_ERROR; } @@ -5461,64 +5541,10 @@ #endif /* - * Non Positional Args - */ - -static void parameterDefinitionsFree(parameterDefinition *parameterDefinitions); -static void NonposArgsFree(XOTclParamDefs *paramDefs) { - if (paramDefs->paramPtr) { - parameterDefinitionsFree(paramDefs->paramPtr); - } - FREE(XOTclParamDefs, paramDefs); -} -static void ParsedParameterDefinitionFree(XOTclParsedParameterDefinition *parsedParamPtr) { - /*fprintf(stderr, "ParsedParameterDefinitionFree %p, npargs %p\n",parsedParamPtr,parsedParamPtr->ParamDefs);*/ - if (parsedParamPtr->paramDefs) { - NonposArgsFree(parsedParamPtr->paramDefs); - } - FREE(XOTclParsedParameterDefinition, parsedParamPtr); -} - -static Tcl_Obj * -NonposArgsFormat(Tcl_Interp *interp, XOTclParamDefs *paramDefs) { - int first; - Tcl_Obj *list = Tcl_NewListObj(0, NULL), *innerlist, *nameStringObj; - parameterDefinition CONST *aPtr; - - for (aPtr = paramDefs->paramPtr; aPtr->name; aPtr++) { - if (*aPtr->name == '-') { - first = 1; - nameStringObj = Tcl_NewStringObj(aPtr->name, -1); - if ((aPtr->flags & XOTCL_ARG_REQUIRED) || aPtr->type) { - Tcl_AppendToObj(nameStringObj,":", 1); - if (aPtr->flags & XOTCL_ARG_REQUIRED) { - first = 0; - Tcl_AppendToObj(nameStringObj,"required", 8); - } - if (aPtr->type) { - if (!first) - Tcl_AppendToObj(nameStringObj,",", 1); - Tcl_AppendToObj(nameStringObj,aPtr->type, -1); - } - } - - innerlist = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(interp, innerlist, nameStringObj); - if (aPtr->defaultValue) { - Tcl_ListObjAppendElement(interp, innerlist, aPtr->defaultValue); - } - - Tcl_ListObjAppendElement(interp, list, innerlist); - } - } - return list; -} - -/* * Proc-Creation */ -static Tcl_Obj *addPrefixToBody(Tcl_Obj *body, int paramDefs, XOTclParsedParameterDefinition *paramPtr) { +static Tcl_Obj *addPrefixToBody(Tcl_Obj *body, int paramDefs, XOTclParsedParam *paramPtr) { Tcl_Obj *resultBody = Tcl_NewStringObj("", 0); INCR_REF_COUNT(resultBody); @@ -5557,25 +5583,6 @@ #define NEW_STRING(target,p,l) target = ckalloc(l+1); strncpy(target,p,l); *((target)+l) = '\0' -static parameterDefinition *ParameterDefinitionsNew(int nr) { - parameterDefinition *paramDefsPtr = NEW_ARRAY(parameterDefinition,nr+1); - memset(paramDefsPtr, 0, sizeof(parameterDefinition)*(nr+1)); - return paramDefsPtr; -} - -static void parameterDefinitionsFree(parameterDefinition *parameterDefinitions) { - parameterDefinition *paramPtr; - - /*fprintf(stderr,"freeing %d parameterDefinitions\n",nr);*/ - for (paramPtr=parameterDefinitions; paramPtr->name; paramPtr++) { - /*fprintf(stderr,".... paramPtr = %p, name=%s, defaultValue %p\n",paramPtr,paramPtr->name,paramPtr->defaultValue);*/ - if (paramPtr->name) ckfree(paramPtr->name); - if (paramPtr->nameObj) {DECR_REF_COUNT(paramPtr->nameObj);} - if (paramPtr->defaultValue) {DECR_REF_COUNT(paramPtr->defaultValue);} - } - FREE(parameterDefinition*,parameterDefinitions); -} - XOTCLINLINE static int noMetaChars(char *pattern) { register char c, *p = pattern; @@ -5669,7 +5676,7 @@ } static int -parseNonposargsOption(Tcl_Interp *interp, char *option, int length, parameterDefinition *paramPtr) { +parseParamOption(Tcl_Interp *interp, char *option, int length, XOTclParam *paramPtr) { /*fprintf(stderr, "def %s, option '%s' (%d)\n",paramPtr->name,option,length);*/ if (strncmp(option,"required",length) == 0) { paramPtr->flags |= XOTCL_ARG_REQUIRED; @@ -5711,27 +5718,24 @@ } static int -ParseParamDefinition(Tcl_Interp *interp, char *procName, Tcl_Obj *arg, int isNonposArgument, - parameterDefinition *paramPtr, int *possibleUnknowns) { - Tcl_Obj **npav; +ParseParamDefinition(Tcl_Interp *interp, char *procName, Tcl_Obj *arg, + XOTclParam *paramPtr, int *possibleUnknowns, int *plainParams) { + int rc, npac, length, j, nameLength, isNonposArgument; char *argString, *argName; - int rc, npac, length, j, nameLength; + Tcl_Obj **npav; rc = Tcl_ListObjGetElements(interp, arg, &npac, &npav); if (rc != TCL_OK || npac < 1 || npac > 2) { - return XOTclVarErrMsg(interp, "wrong # of elements in non-positional args for method", + return XOTclVarErrMsg(interp, "wrong # of elements in parameter definition for method", procName, " (should be 1 or 2 list elements): ", ObjStr(arg), (char *) NULL); } argString = ObjStr(npav[0]); length = strlen(argString); + + isNonposArgument = *argString == '-'; - if (isNonposArgument && *argString != '-') { - return XOTclVarErrMsg(interp, "non-positional arg '", argString,"' of method ",procName, - " does not start with '-': ", argString, (char *) NULL); - } - if (isNonposArgument) { argName = argString+1; nameLength = length-1; @@ -5764,43 +5768,43 @@ for (l=start; l0 && isspace((int)argString[end-1]); end--); - parseNonposargsOption(interp, argString+start, end-start, paramPtr); + parseParamOption(interp, argString+start, end-start, paramPtr); l++; /* skip space */ for (start = l; start0 && isspace((int)argString[end-1]); end--); /* process last option */ - parseNonposargsOption(interp, argString+start, end-start, paramPtr); + parseParamOption(interp, argString+start, end-start, paramPtr); } else { /* no ':', the whole arg is the name */ NEW_STRING(paramPtr->name,argString,length); - paramPtr->nameObj = Tcl_NewStringObj(argName,isNonposArgument ? length-1 : length); - INCR_REF_COUNT(paramPtr->nameObj); - - if (isArgsString(argString)) { - paramPtr->converter = convertToNothing; - paramPtr->flags &= ~XOTCL_ARG_REQUIRED; + if (isNonposArgument) { + paramPtr->nameObj = Tcl_NewStringObj(argName, length-1); + } else { + (*plainParams) ++; + paramPtr->nameObj = Tcl_NewStringObj(argName, length); } + INCR_REF_COUNT(paramPtr->nameObj); } /* if we have two arguments in the list, the second one is a default value */ if (npac == 2) { /* if we have for some reason already a default value, free it */ if (paramPtr->defaultValue) { - /* might be set by parseNonposargsOption */ DECR_REF_COUNT(paramPtr->defaultValue); } paramPtr->defaultValue = Tcl_DuplicateObj(npav[1]); INCR_REF_COUNT(paramPtr->defaultValue); - /* the argument will not required for an invocation, since we have a default */ + /* + * The argument will be not required for an invocation, since we + * have a default. + */ paramPtr->flags &= ~XOTCL_ARG_REQUIRED; } - /*fprintf(stderr,"%p %s paramPtr->name = '%s', nrargs %d, required %d, converter %p default %s\n",paramPtr,procName, - paramPtr->name,paramPtr->nrargs,paramPtr->flags & XOTCL_ARG_REQUIRED, paramPtr->converter, - paramPtr->defaultValue ? ObjStr(paramPtr->defaultValue) : "NONE");*/ + /* convertToTclobj() is the default converter */ if (paramPtr->converter == NULL) { paramPtr->converter = convertToTclobj; } @@ -5818,140 +5822,99 @@ } static int -ParsedParameterDefinitionGet(Tcl_Interp *interp, char *procName, Tcl_Obj *npArgs, Tcl_Obj *ordinaryArgs, - int *haveNonposArgs, XOTclParsedParameterDefinition *parsedParamPtr) { - int rc, i, paramDefsDefc, ordinaryArgsDefc, possibleUnknowns = 0; - Tcl_Obj **paramDefsDefv, **ordinaryArgsDefv; - parameterDefinition *paramDefsPtr, *paramPtr; +ParseArgumentDefinitions(Tcl_Interp *interp, char *procName, Tcl_Obj *args, + XOTclParsedParam *parsedParamPtr) { + Tcl_Obj **argsv; + int rc, argsc; - rc = Tcl_ListObjGetElements(interp, npArgs, ¶mDefsDefc, ¶mDefsDefv); + parsedParamPtr->paramDefs = NULL; + parsedParamPtr->possibleUnknowns = 0; + + rc = Tcl_ListObjGetElements(interp, args, &argsc, &argsv); if (rc != TCL_OK) { return XOTclVarErrMsg(interp, "cannot break down non-positional args: ", - ObjStr(npArgs), (char *) NULL); + ObjStr(args), (char *) NULL); } - rc = Tcl_ListObjGetElements(interp, ordinaryArgs, &ordinaryArgsDefc, &ordinaryArgsDefv); - if (rc != TCL_OK) { - return XOTclVarErrMsg(interp, "cannot break down ordinary args: ", - ObjStr(ordinaryArgs), (char *) NULL); - } - paramPtr = paramDefsPtr = ParameterDefinitionsNew(paramDefsDefc+ordinaryArgsDefc); + if (argsc > 0) { + XOTclParam *paramsPtr, *paramPtr, *lastParamPtr; + int i, possibleUnknowns = 0, plainParams = 0; + XOTclParamDefs *paramDefs; - if (paramDefsDefc > 0) { - for (i=0; i < paramDefsDefc; i++, paramPtr++) { - rc = ParseParamDefinition(interp, procName, paramDefsDefv[i], 1, paramPtr, &possibleUnknowns); + paramPtr = paramsPtr = ParamsNew(argsc); + + for (i=0; i < argsc; i++, paramPtr++) { + rc = ParseParamDefinition(interp, procName, argsv[i], + paramPtr, &possibleUnknowns, &plainParams); if (rc != TCL_OK) { - parameterDefinitionsFree(paramDefsPtr); + ParamsFree(paramsPtr); return rc; } - *haveNonposArgs = 1; } - - /* TODO: - for the time being, process the pos args only when we have nonpos args. - We have to benchmark the overhead and maybe we have to provide a switch - via e.g. configure to activate/deactivate pos args handling. + + /* + * If all arguments are good old Tcl arguments, there is no need + * to use the parameter definition structure. + */ + if (plainParams == argsc) { + ParamsFree(paramsPtr); + return TCL_OK; + } + /* + fprintf(stderr, "we need param definition structure for {%s}, argsc %d plain %d\n", + ObjStr(args), argsc,plainParams); */ - if (*haveNonposArgs) { - for (i=0; i< ordinaryArgsDefc; i++, paramPtr++) { - rc = ParseParamDefinition(interp, procName, ordinaryArgsDefv[i], 0, paramPtr, &possibleUnknowns); - if (rc != TCL_OK) { - parameterDefinitionsFree(paramDefsPtr); - return rc; - } - } + /* + * Check the last argument. If the last argument is named 'args', + * force converter and make it non-required. + */ + lastParamPtr = paramPtr - 1; + if (isArgsString(lastParamPtr->name)) { + lastParamPtr->converter = convertToNothing; + lastParamPtr->flags &= ~XOTCL_ARG_REQUIRED; } - if (*haveNonposArgs) { - XOTclParamDefs *nonposArg = NEW(XOTclParamDefs); - MEM_COUNT_ALLOC("nonposArg", nonposArg); + paramDefs = NEW(XOTclParamDefs); + MEM_COUNT_ALLOC("paramDefs", paramDefs); - nonposArg->slotObj = NULL; - nonposArg->paramPtr = paramDefsPtr; - nonposArg->nrParameters = paramPtr-paramDefsPtr; - /*fprintf(stderr, "method %s ifsize %d, possible unknowns = %d,\n", - procName,paramPtr-paramDefsPtr,possibleUnknowns);*/ - parsedParamPtr->paramDefs = nonposArg; - parsedParamPtr->possibleUnknowns = possibleUnknowns; - } else { - /* empty definitions */ - } + paramDefs->slotObj = NULL; + paramDefs->paramsPtr = paramsPtr; + paramDefs->nrParams = paramPtr-paramsPtr; + /*fprintf(stderr, "method %s ifsize %d, possible unknowns = %d,\n", + procName,paramPtr-paramDefsPtr,possibleUnknowns);*/ + parsedParamPtr->paramDefs = paramDefs; + parsedParamPtr->possibleUnknowns = possibleUnknowns; } return TCL_OK; } static int -ParseArgumentDefinitions(Tcl_Interp *interp, char *methodName, Tcl_Obj *input, - XOTclParsedParameterDefinition *output, int *hasNpArgs) { - int result = TCL_OK, argsc, i; - Tcl_Obj **argsv; - - *hasNpArgs = 0; - output->paramDefs = NULL; - output->possibleUnknowns = 0; - - /* see, if we have paramDefs in the ordinary argument list */ - result = Tcl_ListObjGetElements(interp, input, &argsc, &argsv); - if (result != TCL_OK) { - return XOTclVarErrMsg(interp, "cannot break args into list: ", - ObjStr(input), (char *) NULL); - } - for (i=0; i 0) { - arg = ObjStr(npav[0]); - if (*arg == '-') { - *hasNpArgs = 1; - continue; - } - } - break; - } - if (*hasNpArgs) { - int nrOrdinaryArgs = argsc - i; - Tcl_Obj *ordinaryArgs = Tcl_NewListObj(nrOrdinaryArgs, &argsv[i]); - Tcl_Obj *paramDefs = Tcl_NewListObj(i, &argsv[0]); - INCR_REF_COUNT(ordinaryArgs); - INCR_REF_COUNT(paramDefs); - result = ParsedParameterDefinitionGet(interp, methodName, paramDefs, ordinaryArgs, - hasNpArgs, output); - DECR_REF_COUNT(ordinaryArgs); - DECR_REF_COUNT(paramDefs); - } - return result; -} - -static int MakeProc(Tcl_Namespace *nsPtr, XOTclAssertionStore *aStore, Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition, XOTclObject *obj, int clsns) { - int result, haveNonposArgs = 0; + int result; TclCallFrame frame, *framePtr = &frame; Tcl_Obj *ov[4]; char *procName = ObjStr(nameObj); - XOTclParsedParameterDefinition parsedParam; + XOTclParsedParam parsedParam; ov[0] = NULL; /*objv[0];*/ ov[1] = nameObj; - /* Obtain an signature description */ - result = ParseArgumentDefinitions(interp, procName, args, &parsedParam, &haveNonposArgs); + /* Obtain an method parameter definitions */ + result = ParseArgumentDefinitions(interp, procName, args, &parsedParam); if (result != TCL_OK) return result; - if (haveNonposArgs) { + if (parsedParam.paramDefs) { # if defined(CANONICAL_ARGS) - parameterDefinition *aPtr; + XOTclParam *pPtr; Tcl_Obj *argList = Tcl_NewListObj(0, NULL); - for (aPtr = parsedParam.paramDefs->paramPtr; aPtr->name; aPtr++) { - if (*aPtr->name == '-') { - Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(aPtr->name+1,-1)); + for (pPtr = parsedParam.paramDefs->paramsPtr; pPtr->name; pPtr++) { + if (*pPtr->name == '-') { + Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(pPtr->name+1,-1)); } else { - Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(aPtr->name,-1)); + Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(pPtr->name,-1)); } } ov[2] = argList; @@ -6000,7 +5963,7 @@ } #if defined(CANONICAL_ARGS) - if (haveNonposArgs) { + if (parsedParam.paramDefs) { DECR_REF_COUNT(ov[2]); } #endif @@ -6231,16 +6194,16 @@ static void AppendOrdinaryArgsFromNonposArgs(Tcl_Interp *interp, XOTclParamDefs *paramDefs, int varsOnly, Tcl_Obj *argList) { - parameterDefinition CONST *aPtr; + XOTclParam CONST *pPtr; - for (aPtr = paramDefs->paramPtr; aPtr->name; aPtr++) { - if (*aPtr->name == '-') continue; - if (varsOnly || aPtr->defaultValue == NULL) { - Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(aPtr->name,-1)); + for (pPtr = paramDefs->paramsPtr; pPtr->name; pPtr++) { + if (*pPtr->name == '-') continue; + if (varsOnly || pPtr->defaultValue == NULL) { + Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(pPtr->name,-1)); } else { Tcl_Obj *pair = Tcl_NewListObj(0,NULL); - Tcl_ListObjAppendElement(interp, pair, Tcl_NewStringObj(aPtr->name,-1)); - Tcl_ListObjAppendElement(interp, pair, aPtr->defaultValue); + Tcl_ListObjAppendElement(interp, pair, Tcl_NewStringObj(pPtr->name,-1)); + Tcl_ListObjAppendElement(interp, pair, pPtr->defaultValue); Tcl_ListObjAppendElement(interp, argList, pair); } } @@ -9046,21 +9009,21 @@ #include "tclAPI.h" static int -ArgumentError(Tcl_Interp *interp, char *errorMsg, parameterDefinition CONST *paramPtr, +ArgumentError(Tcl_Interp *interp, char *errorMsg, XOTclParam CONST *paramPtr, Tcl_Obj *cmdNameObj, Tcl_Obj *methodNameObj) { Tcl_Obj *argStringObj = Tcl_NewStringObj("", 0); - parameterDefinition CONST *aPtr; + XOTclParam CONST *pPtr; - for (aPtr = paramPtr; aPtr->name; aPtr++) { - if (aPtr != paramPtr) { + for (pPtr = paramPtr; pPtr->name; pPtr++) { + if (pPtr != paramPtr) { Tcl_AppendToObj(argStringObj, " ", 1); } - if (aPtr->flags & XOTCL_ARG_REQUIRED) { - Tcl_AppendToObj(argStringObj, aPtr->name, -1); + if (pPtr->flags & XOTCL_ARG_REQUIRED) { + Tcl_AppendToObj(argStringObj, pPtr->name, -1); } else { Tcl_AppendToObj(argStringObj, "?", 1); - Tcl_AppendToObj(argStringObj, aPtr->name, -1); - if (aPtr->nrargs >0) { + Tcl_AppendToObj(argStringObj, pPtr->name, -1); + if (pPtr->nrargs >0) { Tcl_AppendToObj(argStringObj, " arg", 4); } Tcl_AppendToObj(argStringObj, "?", 1); @@ -9073,40 +9036,40 @@ int ArgumentDefaults(parseContext *pcPtr, Tcl_Interp *interp, - parameterDefinition CONST *ifd, int nrParameters) { - parameterDefinition CONST *aPtr; + XOTclParam CONST *ifd, int nrParams) { + XOTclParam CONST *pPtr; int i, rc; - for (aPtr = ifd, i=0; i %p %p, default %s\n", - aPtr->name, aPtr->flags & XOTCL_ARG_REQUIRED, + pPtr->name, pPtr->flags & XOTCL_ARG_REQUIRED, pcPtr->clientData[i], pcPtr->objv[i], - aPtr->defaultValue ? ObjStr(aPtr->defaultValue) : "NONE");*/ + pPtr->defaultValue ? ObjStr(pPtr->defaultValue) : "NONE");*/ if (pcPtr->objv[i]) { /* we got an actual value, which was already checked by objv parser */ - /*fprintf(stderr, "setting passed value for %s to '%s'\n",aPtr->name,ObjStr(pcPtr->objv[i]));*/ - if (aPtr->converter == convertToSwitch) { + /*fprintf(stderr, "setting passed value for %s to '%s'\n",pPtr->name,ObjStr(pcPtr->objv[i]));*/ + if (pPtr->converter == convertToSwitch) { int bool; - Tcl_GetBooleanFromObj(interp, aPtr->defaultValue, &bool); + Tcl_GetBooleanFromObj(interp, pPtr->defaultValue, &bool); pcPtr->objv[i] = Tcl_NewBooleanObj(!bool); } } else { /* no valued passed, check if default is available */ - if (aPtr->defaultValue) { - Tcl_Obj *newValue = aPtr->defaultValue; + if (pPtr->defaultValue) { + Tcl_Obj *newValue = pPtr->defaultValue; ClientData checkedData; /* we have a default, do we have to subst it? */ - if (aPtr->flags & XOTCL_ARG_SUBST_DEFAULT) { + if (pPtr->flags & XOTCL_ARG_SUBST_DEFAULT) { rc = SubstValue(interp, pcPtr->obj, &newValue); if (rc != TCL_OK) { return rc; } - /*fprintf(stderr, "attribute %s default %p %s => %p '%s'\n", aPtr->name, - aPtr->defaultValue, ObjStr(aPtr->defaultValue), + /*fprintf(stderr, "attribute %s default %p %s => %p '%s'\n", pPtr->name, + pPtr->defaultValue, ObjStr(pPtr->defaultValue), newValue,ObjStr(newValue));*/ /* the according DECR is performed by parseContextRelease() */ @@ -9116,20 +9079,20 @@ pcPtr->objv[i] = newValue; /*fprintf(stderr,"==> setting default value '%s' for var '%s' flag %d type %s conv %p\n", - ObjStr(newValue),aPtr->name, aPtr->flags & XOTCL_ARG_INITCMD, - aPtr->type, aPtr->converter);*/ + ObjStr(newValue),pPtr->name, pPtr->flags & XOTCL_ARG_INITCMD, + pPtr->type, pPtr->converter);*/ /* Check the default value, unless we have an INITCMD */ - if ((aPtr->flags & XOTCL_ARG_INITCMD) == 0) { - if ((*aPtr->converter)(interp, newValue, &checkedData) != TCL_OK) { + if ((pPtr->flags & XOTCL_ARG_INITCMD) == 0) { + if ((*pPtr->converter)(interp, newValue, &checkedData) != TCL_OK) { return TCL_ERROR; } } - } else if (aPtr->flags & XOTCL_ARG_REQUIRED) { + } else if (pPtr->flags & XOTCL_ARG_REQUIRED) { return XOTclVarErrMsg(interp, pcPtr->obj ? objectName(pcPtr->obj) : "", pcPtr->obj ? " " : "", ObjStr(pcPtr->full_objv[0]), ": required argument '", - ObjStr(aPtr->nameObj), "' is missing", (char *) NULL); + ObjStr(pPtr->nameObj), "' is missing", (char *) NULL); } else { /* Use as dummy default value an arbitrary symbol, which must not be * returned to the Tcl level level; this value is @@ -9145,26 +9108,26 @@ static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], XOTclObject *obj, Tcl_Obj *procNameObj, - parameterDefinition CONST *paramPtr, int nrParameters, + XOTclParam CONST *paramPtr, int nrParams, parseContext *pc) { int i, o, flagCount = 0, nrReq = 0, nrOpt = 0, dashdash = 0; /* todo benchmark with and without CONST */ - parameterDefinition CONST *aPtr, *bPtr; + XOTclParam CONST *pPtr; - parseContextInit(pc, nrParameters, obj, procNameObj); + parseContextInit(pc, nrParams, obj, procNameObj); #if defined(PARSE_TRACE) fprintf(stderr, "BEGIN (%d) [0]%s ",objc, ObjStr(procNameObj)); for (o=1; oname && o < objc;) { + for (i = 0, o = 1, pPtr = paramPtr; pPtr->name && o < objc;) { #if defined(PARSE_TRACE_FULL) fprintf(stderr,"... (%d) processing [%d]: '%s' %s\n", i, o, - aPtr->name,aPtr->flags & XOTCL_ARG_REQUIRED ? "req":"not req"); + pPtr->name,pPtr->flags & XOTCL_ARG_REQUIRED ? "req":"not req"); #endif - if (*aPtr->name == '-') { + if (*pPtr->name == '-') { /* Handle non-positional (named) parameters, starting with a * "-"; arguments can be given in an arbitrary order @@ -9175,28 +9138,29 @@ objStr = ObjStr(objv[p]); /*fprintf(stderr,"....checking objv[%d]=%s\n", p, objStr);*/ if (objStr[0] == '-') { + XOTclParam CONST *nppPtr; found = 0; - for (bPtr = aPtr; bPtr->name && *bPtr->name == '-'; bPtr ++) { - if (strcmp(objStr,bPtr->name) == 0) { - /*fprintf(stderr, "... flag '%s' o=%d p=%d, objc=%d nrargs %d\n",objStr,o,p,objc,bPtr->nrargs);*/ - if (bPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; - if (bPtr->nrargs == 0) { - pc->clientData[bPtr-paramPtr] = (ClientData)1; /* the flag was given */ - pc->objv[bPtr-paramPtr] = XOTclGlobalObjects[XOTE_ONE]; + for (nppPtr = pPtr; nppPtr->name && *nppPtr->name == '-'; nppPtr ++) { + if (strcmp(objStr,nppPtr->name) == 0) { + /*fprintf(stderr, "... flag '%s' o=%d p=%d, objc=%d nrargs %d\n",objStr,o,p,objc,nppPtr->nrargs);*/ + if (nppPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; + if (nppPtr->nrargs == 0) { + pc->clientData[nppPtr-paramPtr] = (ClientData)1; /* the flag was given */ + pc->objv[nppPtr-paramPtr] = XOTclGlobalObjects[XOTE_ONE]; } else { /* we assume for now, nrargs is at most 1 */ o++; p++; - if (bPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; + if (nppPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; if (o < objc) { #if defined(PARSE_TRACE_FULL) fprintf(stderr, "... setting cd[%d] '%s' = %s (%d) %s\n", - bPtr-paramPtr, bPtr->name, ObjStr(objv[p]), bPtr->nrargs, - bPtr->flags & XOTCL_ARG_REQUIRED ? "req":"not req"); + nppPtr-paramPtr, nppPtr->name, ObjStr(objv[p]), nppPtr->nrargs, + nppPtr->flags & XOTCL_ARG_REQUIRED ? "req":"not req"); #endif - if ((*bPtr->converter)(interp, objv[p], &pc->clientData[bPtr-paramPtr]) != TCL_OK) { + if ((*nppPtr->converter)(interp, objv[p], &pc->clientData[nppPtr-paramPtr]) != TCL_OK) { return TCL_ERROR; } - pc->objv[bPtr-paramPtr] = objv[p]; + pc->objv[nppPtr-paramPtr] = objv[p]; } else { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Argument for parameter '", objStr, "' expected", (char *) NULL); @@ -9217,7 +9181,7 @@ } /*fprintf(stderr, "... we found %d flags\n",flagCount);*/ /* skip in parameter definition until the end of the switches */ - while (aPtr->name && *aPtr->name == '-') {aPtr++,i++;}; + while (pPtr->name && *pPtr->name == '-') {pPtr++,i++;}; /* under the assumption, flags have no arguments */ o += flagCount; /* @@ -9239,35 +9203,35 @@ * "-"; arguments must be always in same order */ - if (aPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; + if (pPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; /*fprintf(stderr,"... arg %s req %d converter %p try to set on %d: '%s'\n", - aPtr->name,aPtr->flags & XOTCL_ARG_REQUIRED,aPtr->converter,i, ObjStr(objv[o]));*/ - if ((*aPtr->converter)(interp, objv[o], &pc->clientData[i]) != TCL_OK) { + pPtr->name,pPtr->flags & XOTCL_ARG_REQUIRED,pPtr->converter,i, ObjStr(objv[o]));*/ + if ((*pPtr->converter)(interp, objv[o], &pc->clientData[i]) != TCL_OK) { return TCL_ERROR; } /* * objv is always passed via pc->objv */ #if defined(PARSE_TRACE_FULL) - fprintf(stderr, "... setting %s pc->objv[%d] to [%d]'%s'\n",aPtr->name,i,o,ObjStr(objv[o])); + fprintf(stderr, "... setting %s pc->objv[%d] to [%d]'%s'\n",pPtr->name,i,o,ObjStr(objv[o])); #endif pc->objv[i] = objv[o]; - o++; i++; aPtr++; + o++; i++; pPtr++; } } - pc->lastobjc = aPtr->name ? o : o-1; + pc->lastobjc = pPtr->name ? o : o-1; pc->objc = i + 1; /* Process all args until end of parameter definitions to get correct counters */ - while (aPtr->name) { - if (aPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; - aPtr++; + while (pPtr->name) { + if (pPtr->flags & XOTCL_ARG_REQUIRED) nrReq++; else nrOpt++; + pPtr++; } /* is last argument a vararg? */ - aPtr--; - if (aPtr->converter == convertToNothing) { + pPtr--; + if (pPtr->converter == convertToNothing) { pc->varArgs = 1; /*fprintf(stderr, "last arg of proc '%s' is varargs\n", ObjStr(procNameObj));*/ } @@ -9280,7 +9244,7 @@ return ArgumentError(interp, "to many arguments:", paramPtr, NULL, procNameObj); /* for methods and cmds */ } - return ArgumentDefaults(pc, interp, paramPtr, nrParameters); + return ArgumentDefaults(pc, interp, paramPtr, nrParams); return TCL_OK; } @@ -9600,12 +9564,12 @@ static int ListDefaultFromOrdinaryArgs(Tcl_Interp *interp, char *procName, XOTclParamDefs *paramDefs, char *arg, Tcl_Obj *var) { - parameterDefinition CONST *aPtr; + XOTclParam CONST *pPtr; - for (aPtr = paramDefs->paramPtr; aPtr->name; aPtr++) { - if (*aPtr->name == '-') continue; - if (strcmp(aPtr->name,arg) == 0) { - return SetProcDefault(interp, var, aPtr->defaultValue); + for (pPtr = paramDefs->paramsPtr; pPtr->name; pPtr++) { + if (*pPtr->name == '-') continue; + if (strcmp(pPtr->name,arg) == 0) { + return SetProcDefault(interp, var, pPtr->defaultValue); } } return XOTclVarErrMsg(interp, "method '", procName, "' doesn't have an argument '", @@ -10171,14 +10135,14 @@ static int GetObjectParameterDefinition(Tcl_Interp *interp, char *methodName, XOTclObject *obj, - XOTclParsedParameterDefinition *parsedParamPtr, int *hasNonposArgs) { + XOTclParsedParam *parsedParamPtr) { int result; Tcl_Obj *rawConfArgs; /* WARNING: a) definitions are freed on a class cleanup, with - ParsedParameterDefinitionFree(cl->parsedParamPtr) + ParsedParamFree(cl->parsedParamPtr) What should be done: @@ -10194,8 +10158,8 @@ if (obj->cl->parsedParamPtr) { parsedParamPtr->paramDefs = obj->cl->parsedParamPtr->paramDefs; parsedParamPtr->possibleUnknowns = obj->cl->parsedParamPtr->possibleUnknowns; - /*fprintf(stderr, "--- returned cached objif for obj %s from %s: parsedParamPtr->paramDefs %p nrParameters %d\n", - objectName(obj),className(obj->cl), parsedParamPtr->paramDefs, parsedParamPtr->paramDefs ? parsedParamPtr->paramDefs->nrParameters : -1);*/ + /*fprintf(stderr, "--- returned cached objif for obj %s from %s: parsedParamPtr->paramDefs %p nrParams %d\n", + objectName(obj),className(obj->cl), parsedParamPtr->paramDefs, parsedParamPtr->paramDefs ? parsedParamPtr->paramDefs->nrParams : -1);*/ result = TCL_OK; } else { /* get the string representation of the object parameters */ @@ -10208,18 +10172,18 @@ /* Obtain parameter structure */ /* TODO: rather ObjStr(rawConfArgs) or unnecessary */ - result = ParseArgumentDefinitions(interp, methodName, rawConfArgs, parsedParamPtr, hasNonposArgs); + result = ParseArgumentDefinitions(interp, methodName, rawConfArgs, parsedParamPtr); /*fprintf(stderr, "ParseArgumentDefinitions obj %s for '%s' returned parsedParamPtr->paramDefs %p\n", objectName(obj), ObjStr(rawConfArgs), parsedParamPtr->paramDefs);*/ if (result == TCL_OK && RUNTIME_STATE(interp)->cacheInterface) { - XOTclParsedParameterDefinition *ppDefPtr = NEW(XOTclParsedParameterDefinition); + XOTclParsedParam *ppDefPtr = NEW(XOTclParsedParam); ppDefPtr->paramDefs = parsedParamPtr->paramDefs; ppDefPtr->possibleUnknowns = parsedParamPtr->possibleUnknowns; - obj->cl->parsedParamPtr = ppDefPtr; /* free with ParsedParameterDefinitionFree(cl->parsedParamPtr); */ + obj->cl->parsedParamPtr = ppDefPtr; /* free with ParsedParamFree(cl->parsedParamPtr); */ - /*fprintf(stderr, "--- GetObjectParameterDefinition cache objif for obj %s paramDefs %p possibleUnknowns %d ifd %p nrParameters %d\n", + /*fprintf(stderr, "--- GetObjectParameterDefinition cache objif for obj %s paramDefs %p possibleUnknowns %d ifd %p nrParas %d\n", objectName(obj),className(obj->cl), - ifdparamDefs,ifd->possibleUnknowns, ifdparamDefs ? ifdparamDefs->nrParameters : -1);*/ + ifdparamDefs,ifd->possibleUnknowns, ifdparamDefs ? ifdparamDefs->nrParams : -1);*/ } } @@ -10231,20 +10195,18 @@ static int XOTclOConfigureMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { - int result; - -#if defined(CONFIGURE_ARGS) - /* TODO: check for CONST, check for mem leaks and cleanups, especially XOTclParsedParameterDefinition */ - Tcl_Obj *newValue; - XOTclParsedParameterDefinition parsedParam; - int haveNonposArgs = 0, i, remainingArgsc; - parameterDefinition *paramPtr; + int result, i, remainingArgsc; + XOTclParsedParam parsedParam; + XOTclParam *paramPtr; XOTclParamDefs *paramDefs; + Tcl_Obj *newValue; parseContext pc; XOTcl_FrameDecls; + /* TODO: check for CONST, check for mem leaks and cleanups, especially XOTclParsedParam */ + /* Get the object parameter definition */ - result = GetObjectParameterDefinition(interp, ObjStr(objv[0]), obj, &parsedParam, &haveNonposArgs); + result = GetObjectParameterDefinition(interp, ObjStr(objv[0]), obj, &parsedParam); if (result != TCL_OK || !parsedParam.paramDefs) { /*fprintf(stderr, "... nothing to do for method %s\n", ObjStr(objv[0]));*/ goto configure_exit; @@ -10269,7 +10231,7 @@ #if defined(CONFIGURE_ARGS_TRACE) fprintf(stderr, "*** POPULATE OBJ ''''%s'''': nr of parsed args '%d'\n", objectName(obj), pc.objc); #endif - for (i = 1, paramPtr = paramDefs->paramPtr; i < paramDefs->nrParameters; i++, paramPtr++) { + for (i = 1, paramPtr = paramDefs->paramsPtr; i < paramDefs->nrParams; i++, paramPtr++) { char *argName = paramPtr->name; if (*argName == '-') argName++; @@ -10322,7 +10284,7 @@ } XOTcl_PopFrame(interp, obj); - remainingArgsc = pc.objc - paramDefs->nrParameters; + remainingArgsc = pc.objc - paramDefs->nrParams; #if 0 || defined(CONFIGURE_ARGS_TRACE) fprintf(stderr, "*** POPULATE OBJ SETVALUES with '%d' elements:\n", remainingArgsc); @@ -10345,63 +10307,13 @@ Tcl_SetObjResult(interp,XOTclGlobalObjects[XOTE_EMPTY]); } parseContextRelease(&pc); -#endif -#if !defined(CONFIGURE_ARGS) - XOTclObjects *slotObjects, *so; - /* would be nice to do it here instead of setValue - XOTcl_FrameDecls; - - XOTcl_PushFrame(interp, obj); make instvars of obj accessible */ - - /* - * Search for default values on slots - */ - slotObjects = computeSlotObjects(interp, obj, NULL, 0); - for (so = slotObjects; so; so = so->nextPtr) { - result = setDefaultValue(interp, obj, so->obj); - if (result != TCL_OK) { - goto configure_exit; - } - } - - /* - * call configure methods (starting with '-') - */ - /*{ int i; - fprintf(stderr, "call setvalues %d: ",objc+1); - for (i=0; inextPtr) { - result = checkRequiredValue(interp, obj, so->obj); - if (result != TCL_OK) { - goto configure_exit; - } - } -# endif -#endif configure_exit: -#if defined(CONFIGURE_ARGS) - if(parsedParam.paramDefs) { + if (parsedParam.paramDefs) { if (RUNTIME_STATE(interp)->cacheInterface == 0) { - NonposArgsFree(parsedParam.paramDefs); + ParamDefsFree(parsedParam.paramDefs); } } -#else - if (slotObjects) { - XOTclObjectListFree(slotObjects); - } -#endif return result; } @@ -11221,9 +11133,9 @@ } static int XOTclCInvalidateObjectParameterMethod(Tcl_Interp *interp, XOTclClass *cl) { - /*fprintf(stderr, " %s invalidate %p\n", className(cl), cl->parsedParamPtr);*/ if (cl->parsedParamPtr) { - ParsedParameterDefinitionFree(cl->parsedParamPtr); + /*fprintf(stderr, " %s invalidate %p\n", className(cl), cl->parsedParamPtr);*/ + ParsedParamFree(cl->parsedParamPtr); cl->parsedParamPtr = NULL; } return TCL_OK; @@ -11407,7 +11319,7 @@ XOTclParamDefs *paramDefs = procPtr ? ParamDefsGet((Tcl_Command)procPtr->cmdPtr) : NULL; if (paramDefs) { - Tcl_SetObjResult(interp, NonposArgsFormat(interp, paramDefs)); + Tcl_SetObjResult(interp, ParamDefsFormat(interp, paramDefs)); } return TCL_OK; } @@ -11675,7 +11587,7 @@ XOTclParamDefs *paramDefs = procPtr ? ParamDefsGet((Tcl_Command)procPtr->cmdPtr) : NULL; if (paramDefs) { - Tcl_SetObjResult(interp, NonposArgsFormat(interp, paramDefs)); + Tcl_SetObjResult(interp, ParamDefsFormat(interp, paramDefs)); } return TCL_OK; } @@ -11909,7 +11821,7 @@ paramDefs = ParamDefsGet(cmd); if (paramDefs) { - arglistObj = NonposArgsFormat(interp, paramDefs); + arglistObj = ParamDefsFormat(interp, paramDefs); INCR_REF_COUNT(arglistObj); AppendOrdinaryArgsFromNonposArgs(interp, paramDefs, 0, arglistObj); } @@ -12168,35 +12080,6 @@ } #endif -#if 0 -/* - * Interpretation of Non-Positional Args - */ -int -isNonposArg(Tcl_Interp *interp, char * argStr, - int paramDefsDefc, Tcl_Obj **paramDefsDefv, - Tcl_Obj **var, char **type) { - int i, npac; - Tcl_Obj **npav; - char *varName; - - if (argStr[0] == '-') { - for (i=0; i < paramDefsDefc; i++) { - if (Tcl_ListObjGetElements(interp, paramDefsDefv[i], - &npac, &npav) == TCL_OK && npac > 0) { - varName = argStr+1; - if (!strcmp(varName, ObjStr(npav[0]))) { - *var = npav[0]; - *type = ObjStr(npav[1]); - return 1; - } - } - } - } - return 0; -} -#endif - #if defined(CANONICAL_ARGS) int ProcessMethodArguments(parseContext *pcPtr, Tcl_Interp *interp, @@ -12209,7 +12092,7 @@ if (obj && pushFrame) { XOTcl_PushFrame(interp, obj); } - rc = ArgumentParse(interp, objc, objv, obj, objv[0], paramDefs->paramPtr, paramDefs->nrParameters, pcPtr); + rc = ArgumentParse(interp, objc, objv, obj, objv[0], paramDefs->paramsPtr, paramDefs->nrParams, pcPtr); if (obj && pushFrame) { XOTcl_PopFrame(interp, obj); } @@ -12219,11 +12102,11 @@ /* * Set objc of the parse context to the number of defined parameters. - * pcPtr->objc and paramDefs->nrParameters will be equivalent in cases + * pcPtr->objc and paramDefs->nrParams will be equivalent in cases * where argument values are passed to the call in absence of var * args ('args'). Treating "args is more involved (see below). */ - pcPtr->objc = paramDefs->nrParameters + 1; + pcPtr->objc = paramDefs->nrParams + 1; if (pcPtr->varArgs) { /* @@ -12244,7 +12127,7 @@ */ /*XOTclPrintObjv("actual: ", objc, objv);*/ - parseContextExtendObjv(pcPtr, paramDefs->nrParameters, elts-1, objv + 1 + pcPtr->lastobjc); + parseContextExtendObjv(pcPtr, paramDefs->nrParams, elts-1, objv + 1 + pcPtr->lastobjc); } else { /* * A single argument was passed to "args". There is no need to @@ -12295,7 +12178,7 @@ XOTclParamDefs *paramDefs = ParamDefsGet(csc->cmdPtr); char *procName = (char *)Tcl_GetCommandName(interp, csc->cmdPtr); Tcl_Obj *proc = Tcl_NewStringObj(procName, -1); - parameterDefinition CONST *aPtr; + XOTclParam CONST *pPtr; parseContext pc; int i, rc; @@ -12306,7 +12189,7 @@ /*if (!paramDefs) {return TCL_OK;}*/ INCR_REF_COUNT(proc); - rc = ArgumentParse(interp, objc, objv, csc->self, proc, paramDefs->paramPtr, objc, &pc); + rc = ArgumentParse(interp, objc, objv, csc->self, proc, paramDefs->paramsPtr, objc, &pc); DECR_REF_COUNT(proc); if (rc != TCL_OK) { @@ -12316,20 +12199,20 @@ return rc; } - for (aPtr = paramDefs->paramPtr, i=0; aPtr->name; aPtr++, i++) { - char *argName = aPtr->name; + for (pPtr = paramDefs->paramsPtr, i=0; pPtr->name; pPtr++, i++) { + char *argName = pPtr->name; if (*argName == '-') argName++; /*fprintf(stderr, "got for arg %s (%d) => %p %p, default %s\n", - aPtr->name, aPtr->flags & XOTCL_ARG_REQUIRED, + pPtr->name, pPtr->flags & XOTCL_ARG_REQUIRED, pc.clientData[i], pc.objv[i], - aPtr->defaultValue ? ObjStr(aPtr->defaultValue) : "NONE");*/ + pPtr->defaultValue ? ObjStr(pPtr->defaultValue) : "NONE");*/ if (pc.objv[i]) { /* got a value, already checked by objv parser */ /*fprintf(stderr, "setting passed value for %s to '%s'\n",argName,ObjStr(pc.objv[i]));*/ - if (aPtr->converter == convertToSwitch) { + if (pPtr->converter == convertToSwitch) { int bool; - Tcl_GetBooleanFromObj(interp, aPtr->defaultValue, &bool); + Tcl_GetBooleanFromObj(interp, pPtr->defaultValue, &bool); /*fprintf(stderr, "setting passed value for %s to '%d'\n",argName,!pc.clientData[i]);*/ Tcl_SetVar2Ex(interp, argName, NULL, Tcl_NewBooleanObj(!bool), 0); } else { @@ -12338,11 +12221,11 @@ } } else { /* no valued passed, check if default is available */ - if (aPtr->defaultValue) { + if (pPtr->defaultValue) { /* TODO: default value is not jet checked; should be in arg parsing */ - /*fprintf(stderr,"=== setting default value '%s' for var '%s'\n",ObjStr(aPtr->defaultValue),argName);*/ - Tcl_SetVar2Ex(interp, argName, NULL, aPtr->defaultValue, 0); - } else if (aPtr->flags & XOTCL_ARG_REQUIRED) { + /*fprintf(stderr,"=== setting default value '%s' for var '%s'\n",ObjStr(pPtr->defaultValue),argName);*/ + Tcl_SetVar2Ex(interp, argName, NULL, pPtr->defaultValue, 0); + } else if (pPtr->flags & XOTCL_ARG_REQUIRED) { #if defined(CANONICAL_ARGS) parseContextRelease(pcPtr); #endif @@ -12352,12 +12235,12 @@ } } - aPtr--; - if (aPtr->converter == convertToNothing) { + pPtr--; + if (pPtr->converter == convertToNothing) { /* "args" is always defined as non-required and with convertToNothing */ int elts = objc - pc.lastobjc; /*fprintf(stderr, "args last objc=%d, objc=%d, elts=%d\n", pc.lastobjc, objc, elts);*/ - Tcl_SetVar2Ex(interp, aPtr->name, NULL, Tcl_NewListObj(elts,objv+pc.lastobjc), 0); + Tcl_SetVar2Ex(interp, pPtr->name, NULL, Tcl_NewListObj(elts,objv+pc.lastobjc), 0); } else { Tcl_UnsetVar2(interp, "args", NULL, 0); } Index: generic/xotcl.h =================================================================== diff -u -rf79e2c8697d6f0ae0082c257a65240e815e99ad8 -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/xotcl.h (.../xotcl.h) (revision f79e2c8697d6f0ae0082c257a65240e815e99ad8) +++ generic/xotcl.h (.../xotcl.h) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -79,6 +79,7 @@ #define STACK_TRACE 1 #define PARSE_TRACE 1 #define PARSE_TRACE_FULL 1 +#define CONFIGURE_ARGS_TRACE 1 */ /* @@ -89,13 +90,6 @@ #define CANONICAL_ARGS 1 #define TCL85STACK 1 -#define CONFIGURE_ARGS 1 - -#if defined(CONFIGURE_ARGS) -# define CANONICAL_ARGS 1 -/*# define CONFIGURE_ARGS_TRACE 1*/ -#endif - #if defined(PARSE_TRACE_FULL) # define PARSE_TRACE 1 #endif Index: generic/xotclInt.h =================================================================== diff -u -r300e593347cf3f13d62ac4d21299a2278ff83d5e -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/xotclInt.h (.../xotclInt.h) (revision 300e593347cf3f13d62ac4d21299a2278ff83d5e) +++ generic/xotclInt.h (.../xotclInt.h) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -424,7 +424,7 @@ #define XOTCL_DELETED 0x4000 #define XOTCL_RECREATE 0x8000 -/* flags for parameterDefinitions */ +/* flags for XOTclParams */ #define XOTCL_ARG_REQUIRED 0x0001 #define XOTCL_ARG_SUBST_DEFAULT 0x0002 @@ -457,18 +457,18 @@ Tcl_Obj *defaultValue; char *type; Tcl_Obj *nameObj; -} parameterDefinition; +} XOTclParam; typedef struct XOTclParamDefs { - parameterDefinition *paramPtr; - int nrParameters; + XOTclParam *paramsPtr; + int nrParams; Tcl_Obj *slotObj; } XOTclParamDefs; -typedef struct XOTclParsedParameterDefinition { +typedef struct XOTclParsedParam { XOTclParamDefs *paramDefs; int possibleUnknowns; -} XOTclParsedParameterDefinition; +} XOTclParsedParam; typedef struct XOTclObjectOpt { XOTclAssertionStore *assertions; @@ -525,7 +525,7 @@ struct XOTclClasses *order; Tcl_HashTable instances; Tcl_Namespace *nsPtr; - XOTclParsedParameterDefinition *parsedParamPtr; + XOTclParsedParam *parsedParamPtr; XOTclClassOpt *opt; } XOTclClass; Index: generic/xotclTrace.c =================================================================== diff -u -r0f1d08f0090b3cb676b82f049bae6fe354d331ff -r9f1d59741223795c836a0e8230a891781ecfc09e --- generic/xotclTrace.c (.../xotclTrace.c) (revision 0f1d08f0090b3cb676b82f049bae6fe354d331ff) +++ generic/xotclTrace.c (.../xotclTrace.c) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -148,7 +148,8 @@ int j; fprintf(stderr, string); for (j = 0; j < objc; j++) { - fprintf(stderr, " objv[%d]=%s, ",j, objv[j] ? ObjStr(objv[j]) : "NULL"); + /*fprintf(stderr, " objv[%d]=%s, ",j, objv[j] ? ObjStr(objv[j]) : "NULL");*/ + fprintf(stderr, " objv[%d]=%s %p, ",j, objv[j] ? ObjStr(objv[j]) : "NULL", objv[j]); } fprintf(stderr, "\n"); } Index: library/lib/test.xotcl =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r9f1d59741223795c836a0e8230a891781ecfc09e --- library/lib/test.xotcl (.../test.xotcl) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ library/lib/test.xotcl (.../test.xotcl) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -85,7 +85,7 @@ #regexp {^(-?[0-9]+) +} $r0 _ mS0 regexp {^(-?[0-9]+) +} $r1 _ mS1 set ms [expr {$mS1*1.0/$c}] - puts stderr "[my name]:\t[format %6.1f $ms] mms, $msg" + puts stderr "[my name]:\t[format %6.2f $ms] mms, $msg" } else { puts stderr "[my name]: $msg ok" } Index: tests/testo.xotcl =================================================================== diff -u -r8d4f0d69f9586bdafbffa45b0368b84b86169bca -r9f1d59741223795c836a0e8230a891781ecfc09e --- tests/testo.xotcl (.../testo.xotcl) (revision 8d4f0d69f9586bdafbffa45b0368b84b86169bca) +++ tests/testo.xotcl (.../testo.xotcl) (revision 9f1d59741223795c836a0e8230a891781ecfc09e) @@ -61,6 +61,8 @@ if {$ukn != $args} then { error "wrong order in unknown: $ukns" } + set X [concat [self proc] [list $l] [list $n] [list $l] $args] + puts stderr "l=[llength $X], $X" eval [list [self]] [list [self proc]] [list $l] [list $n] [list $l] $args }