Index: TODO =================================================================== diff -u -N -r8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- TODO (.../TODO) (revision 8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b) +++ TODO (.../TODO) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -4175,10 +4175,48 @@ - extended regression test (new file properties.test) +Property Reform Part 2: better handling of per-object properties +nsf.c: +- changed "/class/ __objectconfigure" to "/obj/ __objectconfigure" + to be able to handle per-object properties on classes properly. +- renamed "info method parametersyntax" -> "info method syntax" +- renamed "/obj|cls/ info method parametersyntax" into "/obj|cls/ info method syntax" +- replaced "::nsf::methods::class::info::objectparameter" by + "::nsf::methods::object::info::objectparameter" +- new command "::nsf::parameter::specs ?-configure? ?-noposargs? slotobjs": + convert provided slotobjs into a list of parameter specs +- new command "::nsf::parameter::get list|name|syntax parameterspec": + convert parameter spec into syntax form, or retrieve pieces of + information from it (can be extended in the future) +- added more or less generic list handling functions TclObjListFreeList(), TclObjListNewElement() + and TclObjListAdd() used by "::nsf::parameter::specs" +- replaced "::nsf::method::property /obj/ -per-object /name/ slotcontainer ?value?" + by "::nsf::object::property /obj/ slotcontainer ?value?" +- added "::nsf::object::property /obj/ hasperobjectslots ?value?" + +nx.tcl: +- new info methods + * "/obj/ info lookup parameter definitions" + * "/obj/ info lookup parameter names" + * "/obj/ info lookup parameter list" + * "/obj/ info lookup parameter syntax" +- changed "/cls/ info parameter definition ?name?" + into "/cls/ info parameter definitions ?name?" + since ir returns a list. Still, "list" or "syntax" won't + be plural + + + ======================================================================== TODO: +- regression tests for "/obj/ info lookup parameter ...." +- check potential mis-cachings due to per-object/per-class mixins, + when object-parameters are e.g. manually invalidated. +- don't blindly register all object/class methods for XOTcl +- do we need NSF_CONFIGURE, NSF_INITIALIZE, NSF_ASSIGN - check noconfig -- Property reform part 2: better handling of per-object properties +- "/obj/ configure" returns values which can't be read via "/obj/ cget" + (but altered properly via "configure"). - Property reform part 3: change defaultPropertyAccessor or nx to none - update documentation with property reform Index: doc/next-migration.txt =================================================================== diff -u -N -r9063ec58e3c46495681147e8fd803fb10674241c -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- doc/next-migration.txt (.../next-migration.txt) (revision 9063ec58e3c46495681147e8fd803fb10674241c) +++ doc/next-migration.txt (.../next-migration.txt) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -2304,11 +2304,8 @@ /cls/ info parameter names ?name? # Return the full parameter specs -/cls/ info parameter definition ?name? +/cls/ info parameter definitions ?name? -# Return the slot object(s) -/cls/ info parameter slot ?name? - # Return in the Tcl parameter syntax /cls/ info parameter syntax ?name? ---------------- Index: generic/nsf.c =================================================================== diff -u -N -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- generic/nsf.c (.../nsf.c) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) +++ generic/nsf.c (.../nsf.c) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -5590,35 +5590,119 @@ return result; } -#if defined(NSF_WITH_ASSERTIONS) -/********************************************************************* - * Assertions - **********************************************************************/ /* - * Generic List handling functions, just used in assertion handling + * Generic Obj-List handling functions. */ +/* + *---------------------------------------------------------------------- + * TclObjListFreeList -- + * + * Free the elements of the obj list. + * + * Results: + * None. + * + * Side effects: + * free memory. + * + *---------------------------------------------------------------------- + */ static void TclObjListFreeList(NsfTclObjList *list) { NsfTclObjList *del; while (list) { del = list; list = list->nextPtr; DECR_REF_COUNT2("listContent", del->content); + if (del->payload) {DECR_REF_COUNT2("listContent", del->payload);} FREE(NsfTclObjList, del); } } +/* + *---------------------------------------------------------------------- + * TclObjListNewElement -- + * + * Add a new element to the obj list with an optional value (stored in + * payload). + * + * Results: + * None. + * + * Side effects: + * allocate memory. + * + *---------------------------------------------------------------------- + */ static Tcl_Obj * -TclObjListNewElement(NsfTclObjList **list, Tcl_Obj *ov) { +TclObjListNewElement(NsfTclObjList **list, Tcl_Obj *obj, Tcl_Obj *value) { NsfTclObjList *elt = NEW(NsfTclObjList); - INCR_REF_COUNT2("listContent", ov); - elt->content = ov; + INCR_REF_COUNT2("listContent", obj); + elt->content = obj; + elt->payload = value; + if (value) { + INCR_REF_COUNT2("listPayload", value); + } elt->nextPtr = *list; *list = elt; - return ov; + return obj; } +/* + *---------------------------------------------------------------------- + * TclObjListAdd -- + * + * Add a NsfTclObjList element to the obj list indexed by a key into a + * sorted list of elements. Duplicates are appended to the payload + * elements. + * + * Results: + * None. + * + * Side effects: + * Add element to the obj-list. + * + *---------------------------------------------------------------------- + */ +static void +TclObjListAdd(Tcl_Interp *interp, NsfTclObjList **list, Tcl_Obj *key, Tcl_Obj *value) { + NsfTclObjList *elt, **prevPtr; + CONST char *keyString = ObjStr(key); + + for (elt = *list, prevPtr = list; elt; prevPtr = &elt->nextPtr, elt = elt->nextPtr) { + CONST char *eltString = ObjStr(elt->content); + if (key == elt->content || strcmp(keyString, eltString) == 0) { + /* + * Found the element, append to it + */ + /* fprintf(stderr, "TclObjListAdd: insert %s equal %s\n", keyString, eltString);*/ + Tcl_ListObjAppendElement(interp, elt->payload, value); + return; + } + if (strcmp(keyString, eltString) < 0) { + /* + * Element not found, insert new before as a new entry. + */ + /* fprintf(stderr, "TclObjListAdd: insert %s before %s\n", keyString, eltString);*/ + TclObjListNewElement(prevPtr, key, value); + return; + } + } + /* + * Element not found, insert new as last entry. + */ + /* fprintf(stderr, "TclObjListAdd: insert last %s\n", keyString); */ + TclObjListNewElement(prevPtr, key, Tcl_NewListObj(1, &value)); + + return; +} + +#if defined(NSF_WITH_ASSERTIONS) +/********************************************************************* + * Assertions + **********************************************************************/ + static NsfTclObjList * AssertionNewList(Tcl_Interp *interp, Tcl_Obj *aObj) { Tcl_Obj **ov; int oc; @@ -5627,8 +5711,8 @@ if (Tcl_ListObjGetElements(interp, aObj, &oc, &ov) == TCL_OK) { if (oc > 0) { int i; - for (i=oc-1; i>=0; i--) { - TclObjListNewElement(&last, ov[i]); + for (i = oc - 1; i >= 0; i--) { + TclObjListNewElement(&last, ov[i], NULL); } } } @@ -17314,7 +17398,7 @@ * In case, we failed so far to obtain a result, try to use the * object-system implementors definitions in the global array * ::nsf::parametersyntax. Note that we can only obtain the - * parametersyntax this way. + * parameter syntax this way. */ if (printStyle == NSF_PARAMS_SYNTAX) { Tcl_DString ds, *dsPtr = &ds; @@ -17492,7 +17576,7 @@ return TCL_OK; } } - case InfomethodsubcmdParametersyntaxIdx: + case InfomethodsubcmdSyntaxIdx: { Tcl_Command importedCmd = GetOriginalCommand(cmd); return ListCmdParams(interp, importedCmd, methodName, NSF_PARAMS_SYNTAX); @@ -19104,7 +19188,7 @@ static int NsfInvalidateObjectParameterCmd(Tcl_Interp *interp, NsfClass *cl) { if (cl->parsedParamPtr) { - /*fprintf(stderr, " %s invalidate %p\n", ClassName(cl), cl->parsedParamPtr);*/ + /* fprintf(stderr, " %s invalidate %p\n", ClassName(cl), cl->parsedParamPtr); */ ParsedParamFree(cl->parsedParamPtr); cl->parsedParamPtr = NULL; } @@ -19545,7 +19629,7 @@ {-argName "object" -required 1 -type object} {-argName "-per-object"} {-argName "methodName" -required 1 -type tclobj} - {-argName "methodproperty" -required 1 -type "class-only|call-private|call-protected|redefine-protected|returns|slotcontainer|slotobj"} + {-argName "methodproperty" -required 1 -type "class-only|call-private|call-protected|redefine-protected|returns|slotobj"} {-argName "value" -type tclobj} } */ @@ -19629,38 +19713,7 @@ Tcl_SetIntObj(Tcl_GetObjResult(interp), (Tcl_Command_flags(cmd) & flag) != 0); break; } - case MethodpropertySlotcontainerIdx: - { - NsfObject *containerObject = NsfGetObjectFromCmdPtr(cmd); - if (containerObject == NULL) { - return NsfPrintError(interp, "slot container must be an object"); - } - flag = NSF_IS_SLOT_CONTAINER; - if (valueObj) { - int flagValue; - int result = SetBooleanFlag(interp, &containerObject->flags, flag, valueObj, &flagValue); - if (result != TCL_OK) { - return result; - } - assert(containerObject->nsPtr); - if (flagValue) { - /* turn on SlotContainerCmdResolver */ - Tcl_SetNamespaceResolvers(containerObject->nsPtr, - (Tcl_ResolveCmdProc *)SlotContainerCmdResolver, - NsColonVarResolver, - (Tcl_ResolveCompiledVarProc *)NULL); - } else { - /* turn off SlotContainerCmdResolver */ - Tcl_SetNamespaceResolvers(containerObject->nsPtr, - (Tcl_ResolveCmdProc *)NULL, - NsColonVarResolver, - (Tcl_ResolveCompiledVarProc *)NULL); - } - } - Tcl_SetIntObj(Tcl_GetObjResult(interp), (containerObject->flags & flag) != 0); - break; - } case MethodpropertySlotobjIdx: case MethodpropertyReturnsIdx: { @@ -19981,7 +20034,7 @@ /* cmd "object::property" NsfObjectPropertyCmd { {-argName "objectName" -required 1 -type object} - {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch" -required 1} + {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|hasperobjectslots|keepcallerself|perobjectdispatch" -required 1} {-argName "value" -required 0 -type tclobj} } */ @@ -19995,18 +20048,38 @@ case ObjectpropertyClassIdx: flags = NSF_IS_CLASS; break; case ObjectpropertyRootmetaclassIdx: flags = NSF_IS_ROOT_META_CLASS; break; case ObjectpropertyRootclassIdx: flags = NSF_IS_ROOT_CLASS; break; - case ObjectpropertySlotcontainerIdx: flags = NSF_IS_SLOT_CONTAINER; break; + case ObjectpropertySlotcontainerIdx: flags = NSF_IS_SLOT_CONTAINER; allowSet = 1; break; case ObjectpropertyKeepcallerselfIdx: flags = NSF_KEEP_CALLER_SELF; allowSet = 1; break; case ObjectpropertyPerobjectdispatchIdx: flags = NSF_PER_OBJECT_DISPATCH; allowSet = 1; break; + case ObjectpropertyHasperobjectslotsIdx: flags = NSF_HAS_PER_OBJECT_SLOTS; allowSet = 1; break; } if (valueObj) { if (likely(allowSet)) { - int flagValue; - int result = SetBooleanFlag(interp, &object->flags, flags, valueObj, &flagValue); - if (result != TCL_OK) { + int flagValue, result; + + result = SetBooleanFlag(interp, &object->flags, flags, valueObj, &flagValue); + if (unlikely(result != TCL_OK)) { return result; } + + if (objectproperty == ObjectpropertySlotcontainerIdx) { + assert(object->nsPtr); + if (flagValue) { + /* turn on SlotContainerCmdResolver */ + Tcl_SetNamespaceResolvers(object->nsPtr, + (Tcl_ResolveCmdProc *)SlotContainerCmdResolver, + NsColonVarResolver, + (Tcl_ResolveCompiledVarProc *)NULL); + } else { + /* turn off SlotContainerCmdResolver */ + Tcl_SetNamespaceResolvers(object->nsPtr, + (Tcl_ResolveCmdProc *)NULL, + NsColonVarResolver, + (Tcl_ResolveCompiledVarProc *)NULL); + } + } + } else { return NsfPrintError(interp, "object property is read only"); } @@ -20588,6 +20661,148 @@ } /* +cmd parameter::get NsfParameterGetCmd { + {-argName "parametersubcmd" -type "list|name|syntax" -required 1} + {-argName "parameterspec" -required 1 -type tclobj} +} +*/ +static int +NsfParameterGetCmd(Tcl_Interp *interp, int parametersubcmd, Tcl_Obj *parameterspec) { + NsfParsedParam parsedParam; + Tcl_Obj *paramsObj = Tcl_NewListObj(1, ¶meterspec), *listObj; + Nsf_Param *paramsPtr; + int result; + + result = ParamDefsParse(interp, NULL, paramsObj, + NSF_DISALLOWED_ARG_OBJECT_PARAMETER, 0, + &parsedParam); + if (result != TCL_OK) { + return result; + } + + paramsPtr = parsedParam.paramDefs->paramsPtr; + + switch (parametersubcmd) { + case ParametersubcmdListIdx: + listObj = ParamDefsList(interp, paramsPtr); + break; + case ParametersubcmdNameIdx: + listObj = ParamDefsNames(interp, paramsPtr); + break; + /* case InfoobjectparametersubcmdParameterIdx: + listObj = ParamDefsFormat(interp, paramsPtr); + break;*/ + case ParametersubcmdSyntaxIdx: + listObj = NsfParamDefsSyntax(paramsPtr); + break; + } + + assert(listObj); + Tcl_SetObjResult(interp, listObj); + + DECR_REF_COUNT2("paramDefsObj", listObj); + ParamDefsRefCountDecr(parsedParam.paramDefs); + return TCL_OK; +} + +/* +cmd parameter::specs NsfParameterSpecsCmd { + {-argName "-configure" -nrargs 0 -required 0} + {-argName "-nonposargs" -nrargs 0 -required 0} + {-argName "slotobjs" -required 1 -type tclobj} +} +*/ + +static int +NsfParameterSpecsCmd(Tcl_Interp *interp, int withConfigure, int withNonposargs, Tcl_Obj *slotListObj) { + NsfTclObjList *objList = NULL, *elt; + Tcl_Obj **objv, *resultObj; + int result = TCL_OK, i, objc; + + if (Tcl_ListObjGetElements(interp, slotListObj, &objc, &objv) != TCL_OK) { + return NsfPrintError(interp, "NsfParameterSpecsCmd: invalid slot object list"); + } + + /* + * Iterate over the slot objects and obtain the position and the + * parameterSpec. + */ + for (i = 0; i < objc; i++) { + NsfObject *slotObject; + Tcl_Obj *positionObj, *specObj = NULL; + + if (GetObjectFromObj(interp, objv[i], &slotObject) != TCL_OK) { + return NsfPrintError(interp, "objectparameter: slot element is not a next scripting object"); + } + /* + * When withConfigure is provided, skip this parameter ... + * - when configure is not set + * - or configure == 0 + */ + if (withConfigure) { + int configure = 0; + Tcl_Obj *configureObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp, + NsfGlobalObjs[NSF_CONFIG], NULL, 0); + if (!configureObj) continue; + Tcl_GetBooleanFromObj(interp, configureObj, &configure); + if (!configure) continue; + } + + /* + * When withNonposargs is provided, skip this parameter ... + * - when positional == 1 + */ + if (withNonposargs) { + Tcl_Obj *positionalObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp, + NsfGlobalObjs[NSF_POSITIONAL], NULL, 0); + if (positionalObj) { + int positional = 0; + Tcl_GetBooleanFromObj(interp, positionalObj, &positional); + if (positional) continue; + } + } + + positionObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp, + NsfGlobalObjs[NSF_POSITION], NULL, 0); + specObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp, + NsfGlobalObjs[NSF_PARAMETERSPEC], NULL, 0); + if (specObj == NULL) { + result = CallMethod(slotObject, interp, NsfGlobalObjs[NSF_GET_PARAMETER_SPEC], 2, 0, + NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE); + if (unlikely(result != TCL_OK)) { + return NsfPrintError(interp, "objectparameter: %s %s returned error", + ObjectName(slotObject), + NsfGlobalStrings[NSF_GET_PARAMETER_SPEC]); + } + specObj = Tcl_GetObjResult(interp); + } + /*fprintf(stderr, "NsfParameterSpecsCmd slot obj = %s pos %s spec %s\n", ObjStr(objv[i]), + positionObj ? ObjStr(positionObj) : "NONE", ObjStr(specObj) );*/ + /* + * Add the spec to the list indicated by the position + */ + TclObjListAdd(interp, &objList, positionObj, specObj); + } + + /* + * Fold the per-position lists into a flat result list + */ + resultObj = Tcl_NewListObj(0, NULL); + for (elt = objList; elt; elt = elt->nextPtr) { + Tcl_ListObjGetElements(interp, elt->payload, &objc, &objv); + for (i = 0; i < objc; i++) { + Tcl_ListObjAppendElement(interp, resultObj, objv[i]); + + } + } + + Tcl_SetObjResult(interp, resultObj); + TclObjListFreeList(objList); + + return result; +} + +/* cmd proc NsfProcCmd { {-argName "-ad" -required 0} {-argName "procName" -required 1 -type tclobj} @@ -21346,9 +21561,10 @@ *---------------------------------------------------------------------- * GetObjectParameterDefinition -- * - * Obtain the parameter definitions for an object by calling the - * scripted method "objectparameter" if the value is not cached - * already. + * Obtain the parameter definitions for an object by calling the method + * "__objectparameter" if the value is not cached already. Caching is + * performed on the class, the cached values are used in case there are no + * object-specific slots. * * Results: * Tcl return code, parsed structure in last argument @@ -21360,12 +21576,23 @@ */ static int -GetObjectParameterDefinition(Tcl_Interp *interp, Tcl_Obj *procNameObj, NsfClass *class, - NsfParsedParam *parsedParamPtr) { +GetObjectParameterDefinition(Tcl_Interp *interp, Tcl_Obj *procNameObj, + NsfObject *object, NsfParsedParam *parsedParamPtr) { int result; Tcl_Obj *rawConfArgs; - NsfParsedParam *clParsedParamPtr = class->parsedParamPtr; + NsfClass *class; + assert(object); + if (object->flags & NSF_HAS_PER_OBJECT_SLOTS) { + assert(object->flags & NSF_INIT_CALLED); + assert(object->nsPtr != NULL); + /*fprintf(stderr, "per-object configure obj %s flags %.6x\n", + ObjectName(object), object->flags);*/ + class = NULL; + } else { + class = object->cl; + } + /* * Parameter definitions are cached in the class, for which * instances are created. The parameter definitions are flushed in @@ -21386,7 +21613,8 @@ * creating objects of this class. */ - if (clParsedParamPtr) { + if (likely(class && class->parsedParamPtr)) { + NsfParsedParam *clParsedParamPtr = class->parsedParamPtr; parsedParamPtr->paramDefs = clParsedParamPtr->paramDefs; parsedParamPtr->possibleUnknowns = clParsedParamPtr->possibleUnknowns; result = TCL_OK; @@ -21395,11 +21623,11 @@ * There is no parameter definition available, get a new one in * the the string representation. */ - Tcl_Obj *methodObj = NsfMethodObj(&class->object, NSF_c_objectparameter_idx); + Tcl_Obj *methodObj = NsfMethodObj(object, NSF_c_objectparameter_idx); if (methodObj) { /*fprintf(stderr, "=== calling %s objectparameter\n", ClassName(class));*/ - result = CallMethod(class, interp, methodObj, + result = CallMethod(object, interp, methodObj, 2, 0, NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE); if (likely(result == TCL_OK)) { @@ -21419,7 +21647,9 @@ NsfParsedParam *ppDefPtr = NEW(NsfParsedParam); ppDefPtr->paramDefs = parsedParamPtr->paramDefs; ppDefPtr->possibleUnknowns = parsedParamPtr->possibleUnknowns; - class->parsedParamPtr = ppDefPtr; + if (class) { + class->parsedParamPtr = ppDefPtr; + } if (ppDefPtr->paramDefs) { ParamDefsRefCountIncr(ppDefPtr->paramDefs); } @@ -21600,13 +21830,14 @@ CallFrame frame, *framePtr = &frame, *uplevelVarFramePtr; #if 0 - fprintf(stderr, "NsfOConfigureMethod %s %2d ", ObjectName(object), objc); + fprintf(stderr, "NsfOConfigureMethod %s flags %.6x oc %2d", ObjectName(object), object->flags, objc); for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(objv[i]));} fprintf(stderr, "\n"); #endif /* Get the object parameter definition */ - result = GetObjectParameterDefinition(interp, objv[0], object->cl, &parsedParam); + result = GetObjectParameterDefinition(interp, objv[0], object, &parsedParam); + if (result != TCL_OK || !parsedParam.paramDefs) { /*fprintf(stderr, "... nothing to do for method %s\n", ObjStr(objv[0]));*/ return result; @@ -22055,7 +22286,7 @@ * Get the object parameter definition */ result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY], - object->cl, &parsedParam); + object, &parsedParam); if (unlikely(result != TCL_OK)) { return result; } @@ -22097,16 +22328,17 @@ * "initcmd", "alias" and "forward". */ if (paramPtr->flags & NSF_ARG_METHOD_INVOCATION) { - // TODO: just for the time being - fprintf(stderr, "method arg %s found, flags %.8x slot %p\n", nameString, paramPtr->flags, paramPtr->slotObj); + /* TODO: maybe we can allow this in the future */ + /*fprintf(stderr, "method arg %s found, flags %.8x slot %p\n", + nameString, paramPtr->flags, paramPtr->slotObj);*/ found = 0; } if (!found) { result = NsfPrintError(interp, "cannot lookup parameter value for %s", nameString); } else { - //fprintf(stderr, "arg %s found, flags %.8x\n", nameString, paramPtr->flags); + /* fprintf(stderr, "arg %s found, flags %.8x\n", nameString, paramPtr->flags);*/ if (paramPtr->slotObj) { NsfObject *slotObject = GetSlotObject(interp, paramPtr->slotObj); @@ -23492,7 +23724,7 @@ /* objectInfoMethod method NsfObjInfoMethodMethod { - {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|parametersyntax|type|precondition|postcondition|submethods"} + {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|syntax|type|precondition|postcondition|submethods"} {-argName "name" -required 1 -type tclobj} } */ @@ -23588,6 +23820,75 @@ } /* +objectInfoMethod objectparameter NsfObjInfoObjectparameterMethod { + {-argName "infoobjectparametersubcmd" -type "definition|list|name|syntax" -required 1} + {-argName "name" -required 0} +} +*/ +static int +NsfObjInfoObjectparameterMethod(Tcl_Interp *interp, NsfObject *object, int subcmd, CONST char *name) { + NsfParsedParam parsedParam; + Tcl_Obj *listObj = NULL; + Nsf_Param CONST *paramsPtr; + Nsf_Param paramList[2]; + int result; + + result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY], + object, &parsedParam); + + if (result != TCL_OK || !parsedParam.paramDefs) { + return result; + } + + paramsPtr = parsedParam.paramDefs->paramsPtr; + + /* + * If a single parameter name is given, we construct a filtered parameter + * list on the fly and provide it to the output functions. Note, that the + * first matching parameter is queried. + */ + if (name) { + Nsf_Param CONST *pPtr; + + for (pPtr = paramsPtr; pPtr->name; pPtr++) { + if (Tcl_StringMatch( ObjStr(pPtr->nameObj), name)) { + paramsPtr = (Nsf_Param CONST *)¶mList; + paramList[0] = *pPtr; + paramList[1].name = NULL; + break; + } + } + if (paramsPtr == parsedParam.paramDefs->paramsPtr) { + /* + * The named parameter was NOT found, so return "". + */ + Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]); + return TCL_OK; + } + } + + switch (subcmd) { + case InfoobjectparametersubcmdDefinitionIdx: + listObj = ParamDefsFormat(interp, paramsPtr); + break; + case InfoobjectparametersubcmdListIdx: + listObj = ParamDefsList(interp, paramsPtr); + break; + case InfoobjectparametersubcmdNameIdx: + listObj = ParamDefsNames(interp, paramsPtr); + break; + case InfoobjectparametersubcmdSyntaxIdx: + listObj = NsfParamDefsSyntax(paramsPtr); + break; + } + assert(listObj); + Tcl_SetObjResult(interp, listObj); + DECR_REF_COUNT2("paramDefsObj", listObj); + + return TCL_OK; +} + +/* objectInfoMethod parent NsfObjInfoParentMethod { } */ @@ -23820,7 +24121,7 @@ /* classInfoMethod method NsfClassInfoMethodMethod { - {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|origin|handle|parameter|parametersyntax|type|precondition|postcondition|submethods|returns"} + {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|origin|handle|parameter|syntax|type|precondition|postcondition|submethods|returns"} {-argName "name" -required 1 -type tclobj} } */ @@ -24044,79 +24345,7 @@ return TCL_OK; } - /* -classInfoMethod objectparameter NsfClassInfoObjectparameterMethod { - {-argName "infoobjectparametersubcmd" -type "name|parameter|parametersyntax" -required 1} - {-argName "name" -required 0} -} -*/ - -static int -NsfClassInfoObjectparameterMethod(Tcl_Interp *interp, NsfClass *class, - int subcmd, CONST char *name) { - NsfParsedParam parsedParam; - Tcl_Obj *listObj = NULL; - Nsf_Param CONST *paramsPtr; - Nsf_Param paramList[2]; - int result; - - result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY], - class, &parsedParam); - - if (result != TCL_OK || !parsedParam.paramDefs) { - return result; - } - - paramsPtr = parsedParam.paramDefs->paramsPtr; - - /* - * If a single parameter name is given, we construct a filtered parameter - * list on the fly and provide it to the output functions. Note, that the - * first matching parameter is queried. - */ - if (name) { - Nsf_Param CONST *pPtr; - - for (pPtr = paramsPtr; pPtr->name; pPtr++) { - if (Tcl_StringMatch( ObjStr(pPtr->nameObj), name)) { - paramsPtr = (Nsf_Param CONST *)¶mList; - paramList[0] = *pPtr; - paramList[1].name = NULL; - break; - } - } - if (paramsPtr == parsedParam.paramDefs->paramsPtr) { - /* - * The named parameter was NOT found, so return "". - */ - Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]); - return TCL_OK; - } - } - - switch (subcmd) { - case InfoobjectparametersubcmdListIdx: - listObj = ParamDefsList(interp, paramsPtr); - break; - case InfoobjectparametersubcmdNameIdx: - listObj = ParamDefsNames(interp, paramsPtr); - break; - case InfoobjectparametersubcmdParameterIdx: - listObj = ParamDefsFormat(interp, paramsPtr); - break; - case InfoobjectparametersubcmdParametersyntaxIdx: - listObj = NsfParamDefsSyntax(paramsPtr); - break; - } - assert(listObj); - Tcl_SetObjResult(interp, listObj); - DECR_REF_COUNT2("paramDefsObj", listObj); - - return TCL_OK; -} - -/* classInfoMethod slots NsfClassInfoSlotobjectsMethod { {-argName "-closure" -nrargs 0} {-argName "-source" -nrargs 1 -type "all|application|baseclasses"} Index: generic/nsfAPI.decls =================================================================== diff -u -N -r8f14fdaf0de110b56e3132a178267f3372a32235 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 8f14fdaf0de110b56e3132a178267f3372a32235) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -72,6 +72,17 @@ {-argName "value" -required 1 -type tclobj} } {-nxdoc 1} +cmd parameter::specs NsfParameterSpecsCmd { + {-argName "-configure" -nrargs 0 -required 0} + {-argName "-nonposargs" -nrargs 0 -required 0} + {-argName "slotobjs" -required 1 -type tclobj} +} +cmd parameter::get NsfParameterGetCmd { + {-argName "parametersubcmd" -type "list|name|syntax" -required 1} + {-argName "parameterspec" -required 1 -type tclobj} +} + + # # method cmds # @@ -131,7 +142,7 @@ {-argName "object" -required 1 -type object} {-argName "-per-object" -nrargs 0} {-argName "methodName" -required 1 -type tclobj} - {-argName "methodproperty" -required 1 -type "class-only|call-private|call-protected|redefine-protected|returns|slotcontainer|slotobj"} + {-argName "methodproperty" -required 1 -type "class-only|call-private|call-protected|redefine-protected|returns|slotobj"} {-argName "value" -type tclobj} } {-nxdoc 1} cmd "method::registered" NsfMethodRegisteredCmd { @@ -151,7 +162,7 @@ } {-nxdoc 1} cmd "object::property" NsfObjectPropertyCmd { {-argName "objectName" -required 1 -type object} - {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch" -required 1} + {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|slotcontainer|hasperobjectslots|keepcallerself|perobjectdispatch" -required 1} {-argName "value" -required 0 -type tclobj} } {-nxdoc 1} cmd "object::qualify" NsfObjectQualifyCmd { @@ -389,7 +400,7 @@ {-argName "pattern" -required 0} } objectInfoMethod method NsfObjInfoMethodMethod { - {-argName "infomethodsubcmd" -required 1 -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|parametersyntax|type|precondition|postcondition|submethods|returns"} + {-argName "infomethodsubcmd" -required 1 -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns"} {-argName "name" -required 1 -type tclobj} } objectInfoMethod methods NsfObjInfoMethodsMethod { @@ -411,6 +422,10 @@ } objectInfoMethod parent NsfObjInfoParentMethod { } +objectInfoMethod objectparameter NsfObjInfoObjectparameterMethod { + {-argName "infoobjectparametersubcmd" -type "definition|list|name|syntax" -required 1} + {-argName "name" -required 0} +} objectInfoMethod precedence NsfObjInfoPrecedenceMethod { {-argName "-intrinsic" -nrargs 0} {-argName "pattern" -required 0} @@ -446,7 +461,7 @@ } classInfoMethod method NsfClassInfoMethodMethod { - {-argName "infomethodsubcmd" -required 1 -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|parametersyntax|type|precondition|postcondition|submethods|returns"} + {-argName "infomethodsubcmd" -required 1 -type "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns"} {-argName "name" -required 1 -type tclobj} } classInfoMethod methods NsfClassInfoMethodsMethod { @@ -471,10 +486,6 @@ {-argName "-scope" -required 0 -type "all|class|object"} {-argName "pattern" -type objpattern} } -classInfoMethod objectparameter NsfClassInfoObjectparameterMethod { - {-argName "infoobjectparametersubcmd" -type "list|name|parameter|parametersyntax" -required 1} - {-argName "pattern" -required 0} -} classInfoMethod slotobjects NsfClassInfoSlotobjectsMethod { {-argName "-closure" -nrargs 0} {-argName "-source" -type "all|application|baseclasses" -default all} Index: generic/nsfAPI.h =================================================================== diff -u -N -r8f14fdaf0de110b56e3132a178267f3372a32235 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- generic/nsfAPI.h (.../nsfAPI.h) (revision 8f14fdaf0de110b56e3132a178267f3372a32235) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -19,12 +19,12 @@ -enum InfomethodsubcmdIdx {InfomethodsubcmdNULL, InfomethodsubcmdArgsIdx, InfomethodsubcmdBodyIdx, InfomethodsubcmdDefinitionIdx, InfomethodsubcmdExistsIdx, InfomethodsubcmdRegistrationhandleIdx, InfomethodsubcmdDefinitionhandleIdx, InfomethodsubcmdHandleIdx, InfomethodsubcmdOriginIdx, InfomethodsubcmdParameterIdx, InfomethodsubcmdParametersyntaxIdx, InfomethodsubcmdTypeIdx, InfomethodsubcmdPreconditionIdx, InfomethodsubcmdPostconditionIdx, InfomethodsubcmdSubmethodsIdx, InfomethodsubcmdReturnsIdx}; +enum InfomethodsubcmdIdx {InfomethodsubcmdNULL, InfomethodsubcmdArgsIdx, InfomethodsubcmdBodyIdx, InfomethodsubcmdDefinitionIdx, InfomethodsubcmdExistsIdx, InfomethodsubcmdRegistrationhandleIdx, InfomethodsubcmdDefinitionhandleIdx, InfomethodsubcmdHandleIdx, InfomethodsubcmdOriginIdx, InfomethodsubcmdParameterIdx, InfomethodsubcmdSyntaxIdx, InfomethodsubcmdTypeIdx, InfomethodsubcmdPreconditionIdx, InfomethodsubcmdPostconditionIdx, InfomethodsubcmdSubmethodsIdx, InfomethodsubcmdReturnsIdx}; static int ConvertToInfomethodsubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"args", "body", "definition", "exists", "registrationhandle", "definitionhandle", "handle", "origin", "parameter", "parametersyntax", "type", "precondition", "postcondition", "submethods", "returns", NULL}; + static CONST char *opts[] = {"args", "body", "definition", "exists", "registrationhandle", "definitionhandle", "handle", "origin", "parameter", "syntax", "type", "precondition", "postcondition", "submethods", "returns", NULL}; (void)pPtr; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "infomethodsubcmd", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); @@ -84,19 +84,6 @@ return result; } -enum InfoobjectparametersubcmdIdx {InfoobjectparametersubcmdNULL, InfoobjectparametersubcmdListIdx, InfoobjectparametersubcmdNameIdx, InfoobjectparametersubcmdParameterIdx, InfoobjectparametersubcmdParametersyntaxIdx}; - -static int ConvertToInfoobjectparametersubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, - ClientData *clientData, Tcl_Obj **outObjPtr) { - int index, result; - static CONST char *opts[] = {"list", "name", "parameter", "parametersyntax", NULL}; - (void)pPtr; - result = Tcl_GetIndexFromObj(interp, objPtr, opts, "infoobjectparametersubcmd", 0, &index); - *clientData = (ClientData) INT2PTR(index + 1); - *outObjPtr = objPtr; - return result; -} - enum ConfigureoptionIdx {ConfigureoptionNULL, ConfigureoptionDebugIdx, ConfigureoptionDtraceIdx, ConfigureoptionFilterIdx, ConfigureoptionProfileIdx, ConfigureoptionSoftrecreateIdx, ConfigureoptionObjectsystemsIdx, ConfigureoptionKeepinitcmdIdx, ConfigureoptionCheckresultsIdx, ConfigureoptionCheckargumentsIdx}; static int ConvertToConfigureoption(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, @@ -149,32 +136,45 @@ return result; } -enum MethodpropertyIdx {MethodpropertyNULL, MethodpropertyClass_onlyIdx, MethodpropertyCall_privateIdx, MethodpropertyCall_protectedIdx, MethodpropertyRedefine_protectedIdx, MethodpropertyReturnsIdx, MethodpropertySlotcontainerIdx, MethodpropertySlotobjIdx}; +enum MethodpropertyIdx {MethodpropertyNULL, MethodpropertyClass_onlyIdx, MethodpropertyCall_privateIdx, MethodpropertyCall_protectedIdx, MethodpropertyRedefine_protectedIdx, MethodpropertyReturnsIdx, MethodpropertySlotobjIdx}; static int ConvertToMethodproperty(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"class-only", "call-private", "call-protected", "redefine-protected", "returns", "slotcontainer", "slotobj", NULL}; + static CONST char *opts[] = {"class-only", "call-private", "call-protected", "redefine-protected", "returns", "slotobj", NULL}; (void)pPtr; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "methodproperty", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); *outObjPtr = objPtr; return result; } -enum ObjectpropertyIdx {ObjectpropertyNULL, ObjectpropertyInitializedIdx, ObjectpropertyClassIdx, ObjectpropertyRootmetaclassIdx, ObjectpropertyRootclassIdx, ObjectpropertySlotcontainerIdx, ObjectpropertyKeepcallerselfIdx, ObjectpropertyPerobjectdispatchIdx}; +enum ObjectpropertyIdx {ObjectpropertyNULL, ObjectpropertyInitializedIdx, ObjectpropertyClassIdx, ObjectpropertyRootmetaclassIdx, ObjectpropertyRootclassIdx, ObjectpropertySlotcontainerIdx, ObjectpropertyHasperobjectslotsIdx, ObjectpropertyKeepcallerselfIdx, ObjectpropertyPerobjectdispatchIdx}; static int ConvertToObjectproperty(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; - static CONST char *opts[] = {"initialized", "class", "rootmetaclass", "rootclass", "slotcontainer", "keepcallerself", "perobjectdispatch", NULL}; + static CONST char *opts[] = {"initialized", "class", "rootmetaclass", "rootclass", "slotcontainer", "hasperobjectslots", "keepcallerself", "perobjectdispatch", NULL}; (void)pPtr; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "objectproperty", 0, &index); *clientData = (ClientData) INT2PTR(index + 1); *outObjPtr = objPtr; return result; } +enum ParametersubcmdIdx {ParametersubcmdNULL, ParametersubcmdListIdx, ParametersubcmdNameIdx, ParametersubcmdSyntaxIdx}; + +static int ConvertToParametersubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, + ClientData *clientData, Tcl_Obj **outObjPtr) { + int index, result; + static CONST char *opts[] = {"list", "name", "syntax", NULL}; + (void)pPtr; + result = Tcl_GetIndexFromObj(interp, objPtr, opts, "parametersubcmd", 0, &index); + *clientData = (ClientData) INT2PTR(index + 1); + *outObjPtr = objPtr; + return result; +} + enum RelationtypeIdx {RelationtypeNULL, RelationtypeObject_mixinIdx, RelationtypeClass_mixinIdx, RelationtypeObject_filterIdx, RelationtypeClass_filterIdx, RelationtypeClassIdx, RelationtypeSuperclassIdx, RelationtypeRootclassIdx}; static int ConvertToRelationtype(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, @@ -201,28 +201,42 @@ return result; } +enum InfoobjectparametersubcmdIdx {InfoobjectparametersubcmdNULL, InfoobjectparametersubcmdDefinitionIdx, InfoobjectparametersubcmdListIdx, InfoobjectparametersubcmdNameIdx, InfoobjectparametersubcmdSyntaxIdx}; +static int ConvertToInfoobjectparametersubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, Nsf_Param CONST *pPtr, + ClientData *clientData, Tcl_Obj **outObjPtr) { + int index, result; + static CONST char *opts[] = {"definition", "list", "name", "syntax", NULL}; + (void)pPtr; + result = Tcl_GetIndexFromObj(interp, objPtr, opts, "infoobjectparametersubcmd", 0, &index); + *clientData = (ClientData) INT2PTR(index + 1); + *outObjPtr = objPtr; + return result; +} + + static enumeratorConverterEntry enumeratorConverterEntries[] = { + {ConvertToInfoobjectparametersubcmd, "definition|list|name|syntax"}, {ConvertToScope, "all|class|object"}, - {ConvertToInfoobjectparametersubcmd, "list|name|parameter|parametersyntax"}, - {ConvertToInfomethodsubcmd, "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|parametersyntax|type|precondition|postcondition|submethods|returns"}, + {ConvertToInfomethodsubcmd, "args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns"}, {ConvertToCallprotection, "all|public|protected|private"}, {ConvertToMethodtype, "all|scripted|builtin|alias|forwarder|object|setter|nsfproc"}, {ConvertToFrame, "method|object|default"}, {ConvertToCurrentoption, "proc|method|methodpath|object|class|activelevel|args|activemixin|calledproc|calledmethod|calledclass|callingproc|callingmethod|callingclass|callinglevel|callingobject|filterreg|isnextcall|nextmethod"}, {ConvertToObjectkind, "class|baseclass|metaclass"}, - {ConvertToMethodproperty, "class-only|call-private|call-protected|redefine-protected|returns|slotcontainer|slotobj"}, + {ConvertToMethodproperty, "class-only|call-private|call-protected|redefine-protected|returns|slotobj"}, {ConvertToRelationtype, "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"}, {ConvertToSource, "all|application|baseclasses"}, {ConvertToConfigureoption, "debug|dtrace|filter|profile|softrecreate|objectsystems|keepinitcmd|checkresults|checkarguments"}, - {ConvertToObjectproperty, "initialized|class|rootmetaclass|rootclass|slotcontainer|keepcallerself|perobjectdispatch"}, + {ConvertToObjectproperty, "initialized|class|rootmetaclass|rootclass|slotcontainer|hasperobjectslots|keepcallerself|perobjectdispatch"}, {ConvertToAssertionsubcmd, "check|object-invar|class-invar"}, + {ConvertToParametersubcmd, "list|name|syntax"}, {NULL, NULL} }; /* just to define the symbol */ -static Nsf_methodDefinition method_definitions[102]; +static Nsf_methodDefinition method_definitions[104]; static CONST char *method_command_namespace_names[] = { "::nsf::methods::object::info", @@ -248,7 +262,6 @@ static int NsfClassInfoMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoMixinclassesMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int NsfClassInfoObjectparameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoSlotobjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoSuperclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -282,6 +295,8 @@ static int NsfObjectPropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjectQualifyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjectSystemCreateCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfParameterGetCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfParameterSpecsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfProcCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfProfileClearDataStubStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfProfileGetDataStubStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -327,6 +342,7 @@ static int NsfObjInfoMixinclassesMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoNameMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfObjInfoObjectparameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoSlotobjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -350,7 +366,6 @@ static int NsfClassInfoMixinOfMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withScope, CONST char *patternString, NsfObject *patternObject); static int NsfClassInfoMixinclassesMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withGuards, int withHeritage, CONST char *patternString, NsfObject *patternObject); static int NsfClassInfoMixinguardMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *mixin); -static int NsfClassInfoObjectparameterMethod(Tcl_Interp *interp, NsfClass *cl, int infoobjectparametersubcmd, CONST char *pattern); static int NsfClassInfoSlotobjectsMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withSource, NsfClass *withType, CONST char *pattern); static int NsfClassInfoSubclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, CONST char *patternString, NsfObject *patternObject); static int NsfClassInfoSuperclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, Tcl_Obj *pattern); @@ -384,6 +399,8 @@ static int NsfObjectPropertyCmd(Tcl_Interp *interp, NsfObject *objectName, int objectproperty, Tcl_Obj *value); static int NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *objectName); static int NsfObjectSystemCreateCmd(Tcl_Interp *interp, Tcl_Obj *rootClass, Tcl_Obj *rootMetaClass, Tcl_Obj *systemMethods); +static int NsfParameterGetCmd(Tcl_Interp *interp, int parametersubcmd, Tcl_Obj *parameterspec); +static int NsfParameterSpecsCmd(Tcl_Interp *interp, int withConfigure, int withNonposargs, Tcl_Obj *slotobjs); static int NsfProcCmd(Tcl_Interp *interp, int withAd, Tcl_Obj *procName, Tcl_Obj *arguments, Tcl_Obj *body); static int NsfProfileClearDataStub(Tcl_Interp *interp); static int NsfProfileGetDataStub(Tcl_Interp *interp); @@ -429,6 +446,7 @@ static int NsfObjInfoMixinclassesMethod(Tcl_Interp *interp, NsfObject *obj, int withGuards, int withHeritage, CONST char *patternString, NsfObject *patternObject); static int NsfObjInfoMixinguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *mixin); static int NsfObjInfoNameMethod(Tcl_Interp *interp, NsfObject *obj); +static int NsfObjInfoObjectparameterMethod(Tcl_Interp *interp, NsfObject *obj, int infoobjectparametersubcmd, CONST char *name); static int NsfObjInfoParentMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfObjInfoPrecedenceMethod(Tcl_Interp *interp, NsfObject *obj, int withIntrinsic, CONST char *pattern); static int NsfObjInfoSlotobjectsMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType, CONST char *pattern); @@ -453,7 +471,6 @@ NsfClassInfoMixinOfMethodIdx, NsfClassInfoMixinclassesMethodIdx, NsfClassInfoMixinguardMethodIdx, - NsfClassInfoObjectparameterMethodIdx, NsfClassInfoSlotobjectsMethodIdx, NsfClassInfoSubclassMethodIdx, NsfClassInfoSuperclassMethodIdx, @@ -487,6 +504,8 @@ NsfObjectPropertyCmdIdx, NsfObjectQualifyCmdIdx, NsfObjectSystemCreateCmdIdx, + NsfParameterGetCmdIdx, + NsfParameterSpecsCmdIdx, NsfProcCmdIdx, NsfProfileClearDataStubIdx, NsfProfileGetDataStubIdx, @@ -532,6 +551,7 @@ NsfObjInfoMixinclassesMethodIdx, NsfObjInfoMixinguardMethodIdx, NsfObjInfoNameMethodIdx, + NsfObjInfoObjectparameterMethodIdx, NsfObjInfoParentMethodIdx, NsfObjInfoPrecedenceMethodIdx, NsfObjInfoSlotobjectsMethodIdx, @@ -931,26 +951,6 @@ } static int -NsfClassInfoObjectparameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - ParseContext pc; - NsfClass *cl = NsfObjectToClass(clientData); - if (unlikely(cl == NULL)) return NsfDispatchClientDataError(interp, clientData, "class", "objectparameter"); - if (likely(ArgumentParse(interp, objc, objv, (NsfObject *) cl, objv[0], - method_definitions[NsfClassInfoObjectparameterMethodIdx].paramDefs, - method_definitions[NsfClassInfoObjectparameterMethodIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, - &pc) == TCL_OK)) { - int infoobjectparametersubcmd = (int )PTR2INT(pc.clientData[0]); - CONST char *pattern = (CONST char *)pc.clientData[1]; - - assert(pc.status == 0); - return NsfClassInfoObjectparameterMethod(interp, cl, infoobjectparametersubcmd, pattern); - - } else { - return TCL_ERROR; - } -} - -static int NsfClassInfoSlotobjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; NsfClass *cl = NsfObjectToClass(clientData); @@ -1624,6 +1624,47 @@ } static int +NsfParameterGetCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + (void)clientData; + + if (likely(ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfParameterGetCmdIdx].paramDefs, + method_definitions[NsfParameterGetCmdIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, + &pc) == TCL_OK)) { + int parametersubcmd = (int )PTR2INT(pc.clientData[0]); + Tcl_Obj *parameterspec = (Tcl_Obj *)pc.clientData[1]; + + assert(pc.status == 0); + return NsfParameterGetCmd(interp, parametersubcmd, parameterspec); + + } else { + return TCL_ERROR; + } +} + +static int +NsfParameterSpecsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + (void)clientData; + + if (likely(ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfParameterSpecsCmdIdx].paramDefs, + method_definitions[NsfParameterSpecsCmdIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, + &pc) == TCL_OK)) { + int withConfigure = (int )PTR2INT(pc.clientData[0]); + int withNonposargs = (int )PTR2INT(pc.clientData[1]); + Tcl_Obj *slotobjs = (Tcl_Obj *)pc.clientData[2]; + + assert(pc.status == 0); + return NsfParameterSpecsCmd(interp, withConfigure, withNonposargs, slotobjs); + + } else { + return TCL_ERROR; + } +} + +static int NsfProcCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; (void)clientData; @@ -2434,6 +2475,26 @@ } static int +NsfObjInfoObjectparameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + NsfObject *obj = (NsfObject *)clientData; + if (unlikely(obj == NULL)) return NsfDispatchClientDataError(interp, clientData, "object", "objectparameter"); + if (likely(ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[NsfObjInfoObjectparameterMethodIdx].paramDefs, + method_definitions[NsfObjInfoObjectparameterMethodIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, + &pc) == TCL_OK)) { + int infoobjectparametersubcmd = (int )PTR2INT(pc.clientData[0]); + CONST char *name = (CONST char *)pc.clientData[1]; + + assert(pc.status == 0); + return NsfObjInfoObjectparameterMethod(interp, obj, infoobjectparametersubcmd, name); + + } else { + return TCL_ERROR; + } +} + +static int NsfObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { NsfObject *obj = (NsfObject *)clientData; if (unlikely(obj == NULL)) return NsfDispatchClientDataError(interp, clientData, "object", "parent"); @@ -2508,7 +2569,7 @@ } } -static Nsf_methodDefinition method_definitions[102] = { +static Nsf_methodDefinition method_definitions[104] = { {"::nsf::methods::class::alloc", NsfCAllocMethodStub, 1, { {"objectName", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, @@ -2582,10 +2643,6 @@ {"::nsf::methods::class::info::mixinguard", NsfClassInfoMixinguardMethodStub, 1, { {"mixin", NSF_ARG_REQUIRED, 1, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::methods::class::info::objectparameter", NsfClassInfoObjectparameterMethodStub, 2, { - {"infoobjectparametersubcmd", NSF_ARG_REQUIRED|NSF_ARG_IS_ENUMERATION, 1, ConvertToInfoobjectparametersubcmd, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, - {"pattern", 0, 1, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} -}, {"::nsf::methods::class::info::slotobjects", NsfClassInfoSlotobjectsMethodStub, 4, { {"-closure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"-source", 0|NSF_ARG_IS_ENUMERATION, 1, ConvertToSource, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, @@ -2752,6 +2809,15 @@ {"rootMetaClass", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"systemMethods", 0, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::parameter::get", NsfParameterGetCmdStub, 2, { + {"parametersubcmd", NSF_ARG_REQUIRED|NSF_ARG_IS_ENUMERATION, 1, ConvertToParametersubcmd, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"parameterspec", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, +{"::nsf::parameter::specs", NsfParameterSpecsCmdStub, 3, { + {"-configure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"-nonposargs", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"slotobjs", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, {"::nsf::proc", NsfProcCmdStub, 4, { {"-ad", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"procName", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, @@ -2922,6 +2988,10 @@ {"::nsf::methods::object::info::name", NsfObjInfoNameMethodStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::methods::object::info::objectparameter", NsfObjInfoObjectparameterMethodStub, 2, { + {"infoobjectparametersubcmd", NSF_ARG_REQUIRED|NSF_ARG_IS_ENUMERATION, 1, ConvertToInfoobjectparametersubcmd, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"name", 0, 1, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, {"::nsf::methods::object::info::parent", NsfObjInfoParentMethodStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, Index: generic/nsfAPI.nxdocindex =================================================================== diff -u -N -rba42e7d2b911f631d2bd104eb2e22a9da6f7e1bd -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- generic/nsfAPI.nxdocindex (.../nsfAPI.nxdocindex) (revision ba42e7d2b911f631d2bd104eb2e22a9da6f7e1bd) +++ generic/nsfAPI.nxdocindex (.../nsfAPI.nxdocindex) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -14,6 +14,8 @@ set ::nxdoc::include(::nsf::interp) 1 set ::nxdoc::include(::nsf::invalidateobjectparameter) 0 set ::nxdoc::include(::nsf::is) 1 +set ::nxdoc::include(::nsf::parameter::specs) 0 +set ::nxdoc::include(::nsf::parameter::get) 0 set ::nxdoc::include(::nsf::method::alias) 1 set ::nxdoc::include(::nsf::method::assertion) 1 set ::nxdoc::include(::nsf::method::create) 1 @@ -82,6 +84,7 @@ set ::nxdoc::include(::nsf::methods::object::info::mixinguard) 0 set ::nxdoc::include(::nsf::methods::object::info::name) 0 set ::nxdoc::include(::nsf::methods::object::info::parent) 0 +set ::nxdoc::include(::nsf::methods::object::info::objectparameter) 0 set ::nxdoc::include(::nsf::methods::object::info::precedence) 0 set ::nxdoc::include(::nsf::methods::object::info::slotobjects) 0 set ::nxdoc::include(::nsf::methods::object::info::vars) 0 @@ -95,7 +98,6 @@ set ::nxdoc::include(::nsf::methods::class::info::mixinclasses) 0 set ::nxdoc::include(::nsf::methods::class::info::mixinguard) 0 set ::nxdoc::include(::nsf::methods::class::info::mixinof) 0 -set ::nxdoc::include(::nsf::methods::class::info::objectparameter) 0 set ::nxdoc::include(::nsf::methods::class::info::slotobjects) 0 set ::nxdoc::include(::nsf::methods::class::info::subclass) 0 set ::nxdoc::include(::nsf::methods::class::info::superclass) 0 Index: generic/nsfInt.h =================================================================== diff -u -N -r7495af656ca04a32826ecb0b6e207f886eaaa7f8 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- generic/nsfInt.h (.../nsfInt.h) (revision 7495af656ca04a32826ecb0b6e207f886eaaa7f8) +++ generic/nsfInt.h (.../nsfInt.h) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -290,6 +290,7 @@ typedef struct NsfTclObjList { Tcl_Obj *content; + Tcl_Obj *payload; struct NsfTclObjList *nextPtr; } NsfTclObjList; @@ -377,13 +378,13 @@ #define NSF_IS_SLOT_CONTAINER 0x0200 #define NSF_KEEP_CALLER_SELF 0x0400 #define NSF_PER_OBJECT_DISPATCH 0x0800 -/* deletion state */ -#define NSF_DESTROY_CALLED_SUCCESS 0x1000 -#define NSF_DURING_DELETE 0x2000 -#define NSF_DELETED 0x4000 -#define NSF_RECREATE 0x8000 -#define NSF_RECREATE 0x8000 -#define NSF_TCL_DELETE 0x010000 /* requires flags to be int, not short */ +#define NSF_HAS_PER_OBJECT_SLOTS 0x1000 +/* deletion states */ +#define NSF_DESTROY_CALLED_SUCCESS 0x010000 /* requires flags to be int, not short */ +#define NSF_DURING_DELETE 0x020000 +#define NSF_DELETED 0x040000 +#define NSF_RECREATE 0x080000 +#define NSF_TCL_DELETE 0x100000 /* flags for NsfParams */ @@ -605,10 +606,10 @@ typedef enum { NSF_EMPTY, NSF_ZERO, NSF_ONE, /* methods called internally */ - NSF_CONFIGURE, NSF_INITIALIZE, NSF_ASSIGN, + NSF_CONFIGURE, NSF_INITIALIZE, NSF_ASSIGN, NSF_GET_PARAMETER_SPEC, /* var names */ NSF_AUTONAMES, NSF_DEFAULTMETACLASS, NSF_DEFAULTSUPERCLASS, - NSF_ALIAS_ARRAY, + NSF_ALIAS_ARRAY, NSF_POSITION, NSF_POSITIONAL, NSF_CONFIG, NSF_PARAMETERSPEC, /* object/class names */ NSF_METHOD_PARAMETER_SLOT_OBJ, /* constants */ @@ -626,10 +627,10 @@ char *NsfGlobalStrings[] = { "", "0", "1", /* methods called internally */ - "configure", "initialize", "assign", + "configure", "initialize", "assign", "getParameterSpec", /* var names */ "__autonames", "__default_metaclass", "__default_superclass", - "::nsf::alias", + "::nsf::alias", "position", "positional", "config", "parameterSpec", /* object/class names */ "::nx::methodParameterSlot", /* constants */ Index: library/lib/nxdoc-core.tcl =================================================================== diff -u -N -re0f9892926cd7c2c3bf54a1e7d1d945a5c77e7ca -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/lib/nxdoc-core.tcl (.../nxdoc-core.tcl) (revision e0f9892926cd7c2c3bf54a1e7d1d945a5c77e7ca) +++ library/lib/nxdoc-core.tcl (.../nxdoc-core.tcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -556,7 +556,7 @@ :public method "pinfo get" {{-default ?} args} { if {![info exists :pdata] || ![dict exists ${:pdata} {*}$args]} { - return $default; + return $default } dict get ${:pdata} {*}$args } @@ -567,12 +567,12 @@ } :public method "pinfo lappend" args { - if {![info exists :pdata]} return; + if {![info exists :pdata]} return dict lappend :pdata {*}$args } :public method "pinfo set" args { - if {![info exists :pdata]} return; + if {![info exists :pdata]} return dict set :pdata {*}$args } @@ -585,7 +585,7 @@ # For now, we disallow upstream propagation if the receiving # entity is missing ... as this would be pointless ... # - if {[$p pinfo get -default "extra" status] eq "missing"} break; + if {[$p pinfo get -default "extra" status] eq "missing"} break $p pinfo set {*}$args } } @@ -712,7 +712,7 @@ set slots [: -system info lookup slots] set attrs [list] foreach s $slots { - if {![$s info has type ::nx::doc::PartAttribute] || ![$s eval {info exists :part_class}]} continue; + if {![$s info has type ::nx::doc::PartAttribute] || ![$s eval {info exists :part_class}]} continue lappend attrs $s [$s part_class] } return $attrs @@ -730,7 +730,7 @@ # themselves. # if {[info exists class] && \ - [[$s part_class] info superclass -closure $class] eq ""} continue; + [[$s part_class] info superclass -closure $class] eq ""} continue set accessor [$s name] if {[info exists :$accessor]} { set items [sorted [:$accessor] name] @@ -813,7 +813,7 @@ if {${:@namespace} eq "" && [info exists :previous]} { return ${:previous} [current method] } else { - return ${:@namespace}; # defaults to top-level/global NS + return ${:@namespace} ;# defaults to top-level/global NS } } @@ -938,7 +938,7 @@ :public method get1PassScript {sources} { set 1pass "::nx::doc::__trace_pkg\n" dict for {srcType items} $sources { - if {![llength $items]} continue; + if {![llength $items]} continue switch -exact -- $srcType { package { foreach i $items { @@ -980,13 +980,13 @@ # script # dependency # - if {$dependency || ![info exists script]} continue; + if {$dependency || ![info exists script]} continue if {[info exists package]} { set fragment " - ::nx::doc::__cpackage push $package; + ::nx::doc::__cpackage push $package %s - ::nx::doc::__cpackage pop; + ::nx::doc::__cpackage pop " set block [format $block $fragment] unset package @@ -1292,7 +1292,7 @@ - }; # @method + } ;# @method # @class ::nx::doc::@param # @@ -2159,9 +2159,8 @@ # if {[::nsf::is class $cmd]} { - dict set bundle parametersyntax [::nsf::dispatch $cmd \ - ::nsf::methods::class::info::objectparameter \ - parametersyntax] + dict set bundle syntax [::nsf::dispatch $cmd \ + ::nx::Class::slot::__info::parameter::syntax] # # TODO: Are the parameters needed for objects??? # @@ -2171,8 +2170,8 @@ } } else { if {![catch {set syntax [::nsf::dispatch $rootclass $infoMethod \ - parametersyntax $cmd]} _]} { - dict set bundle parametersyntax $syntax + syntax $cmd]} _]} { + dict set bundle syntax $syntax } if {![catch {set pa [::nsf::dispatch $rootclass $infoMethod \ @@ -2218,9 +2217,9 @@ #::interp hide "" auto_import ::proc ::auto_import {pattern} { set ns [uplevel [list namespace current]] - ::nx::doc::__cpackage push TCL_LIBRARY; + ::nx::doc::__cpackage push TCL_LIBRARY interp invokehidden "" -namespace $ns auto_import $pattern - ::nx::doc::__cpackage pop; + ::nx::doc::__cpackage pop } } proc __init {} { @@ -2236,14 +2235,14 @@ # if {$rootclass ne "::nx::doc::_%&::obj"} { - ::nsf::configure keepinitcmd true; + ::nsf::configure keepinitcmd true array set sysmeths [concat {*}$m] set ::nx::doc::rootns [namespace qualifier $rootmclass] $rootmclass $sysmeths(-class.create) ${::nx::doc::rootns}::__Tracer ::nsf::method::create ${::nx::doc::rootns}::__Tracer \ $sysmeths(-class.create) {name args} { - set obj [::nsf::next]; + set obj [::nsf::next] set bundle [dict create] if {[info commands "::nx::Class"] ne ""} { if {[::nsf::dispatch $obj ::nsf::methods::object::info::hastype ::nx::Slot]} { @@ -2304,8 +2303,8 @@ dict set bundle parameter {*}[::nx::doc::paraminfo {*}$pspec] } } - if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::${scope}::info::method parametersyntax $handle]} _]} { - dict set bundle parametersyntax $psyn + if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::${scope}::info::method syntax $handle]} _]} { + dict set bundle syntax $psyn } ::nx::doc::__at_register_command $handle \ ->cmdtype @method \ @@ -2347,7 +2346,7 @@ set is_method 0 set obj [concat {*}[split [string trimleft $obj :] "::"]] foreach label $obj { - if {$label eq "slot"} {set is_method 1; continue;} + if {$label eq "slot"} {set is_method 1; continue} if {$is_method} { lappend method_name [string trimleft $label _] } else { @@ -2375,7 +2374,7 @@ foreach pspec [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method parameter $handle] { dict set bundle parameter {*}[::nx::doc::paraminfo {*}$pspec] } - dict set bundle parametersyntax [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method parametersyntax $handle] + dict set bundle syntax [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method syntax $handle] dict set bundle type [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method type $handle] dict set bundle returns [::nsf::method::property ${::nx::doc::rootns}::__Tracer $handle returns] ::nx::doc::__at_register_command $handle \ @@ -2404,8 +2403,8 @@ dict set bundle parameter {*}[::nx::doc::paraminfo {*}$pspec] } } - if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method parametersyntax $handle]} _]} { - dict set bundle parametersyntax $psyn + if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method syntax $handle]} _]} { + dict set bundle syntax $psyn } ::nx::doc::__at_register_command $handle \ @@ -2427,8 +2426,8 @@ dict set bundle handle $handle dict set bundle handleinfo [::nx::doc::handleinfo $handle] dict set bundle type [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method type $handle] - if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method parametersyntax $handle]} _]} { - dict set bundle parametersyntax $psyn + if {![catch {set psyn [::nsf::dispatch ${::nx::doc::rootns}::__Tracer ::nsf::methods::object::info::method syntax $handle]} _]} { + dict set bundle syntax $psyn } ::nx::doc::__at_register_command $handle \ @@ -2529,9 +2528,9 @@ switch -glob -- $subcmd { imp* { foreach pattern $args { - if {[string match "-*" $pattern]} continue; + if {[string match "-*" $pattern]} continue foreach cmd [info commands $pattern] { - if {![::nx::doc::is_exported $cmd]} continue; + if {![::nx::doc::is_exported $cmd]} continue set type @command if {[info commands ::nsf::object::exists] ne "" &&\ [::nsf::object::exists $cmd]} { @@ -2590,7 +2589,7 @@ nspatterns:optional } { - if {![info exists :registered_commands]} return; + if {![info exists :registered_commands]} return if {[info exists nspatterns]} { set opts [join $nspatterns |] set nspatterns "^($opts)\$" @@ -2632,7 +2631,7 @@ # :do { if {[info commands ::nsf::configure] ne ""} { - ::nsf::configure keepinitcmd false; + ::nsf::configure keepinitcmd false array set sysmeths [concat {*}[lassign {*}[::nsf::configure objectsystem] rootclass rootmclass]] # TODO: some cleanup is only needed if __init has been called # (which is not always the case). refactor the code @@ -2765,27 +2764,27 @@ # dict for {cmd info} $generated_commands { dict with info { - if {$cmdtype ni [list @command @object @class @method]} continue; + if {$cmdtype ni [list @command @object @class @method]} continue if {[info exists package] && [dict exists $pkgMap $package]} { set pkgObj [dict get $pkgMap $package] [: -system info class] containers push $pkgObj unset package } if {$cmdtype eq "@object" && [string match *::slot::* $cmd]} { - if {[dict exists $info bundle objtype] && [dict get $info bundle objtype] eq "ensemble"} continue; + if {[dict exists $info bundle objtype] && [dict get $info bundle objtype] eq "ensemble"} continue set name [namespace tail $cmd] set scope "" set obj [namespace qualifiers [namespace qualifiers $cmd]] - if {![dict exists $map $obj]} continue; + if {![dict exists $map $obj]} continue set partof_entity [dict get $map $obj] set entity [$partof_entity @[join [list {*}${scope} property] -] $name] } elseif {$cmdtype eq "@method"} { lassign [dict get $bundle handleinfo] obj scope name # ! we assume the partof entity is present or has been generated - if {![dict exists $map $obj]} continue; + if {![dict exists $map $obj]} continue set partof_entity [dict get $map $obj] - if {![$partof_entity info has type ::nx::doc::@object]} continue; + if {![$partof_entity info has type ::nx::doc::@object]} continue set owning_entity $partof_entity foreach subm $name { set en [$partof_entity @[join [list {*}${scope} method] -] id $subm] @@ -2903,8 +2902,8 @@ } } - if {![:pinfo exists bundle parametersyntax]} { - :pinfo set bundle parametersyntax $params + if {![:pinfo exists bundle syntax]} { + :pinfo set bundle syntax $params } # TODO (Review!): [next] will cause the missing parameter @@ -2934,9 +2933,8 @@ set prj [:current_project] set box [$prj sandbox] set statement [list ::nsf::dispatch ${:name} \ - ::nsf::methods::class::info::objectparameter \ - parametersyntax] - :pinfo set bundle parametersyntax [$box eval $statement] + ::nx::Class::slot::__info::parameter::syntax] + :pinfo set bundle syntax [$box eval $statement] } } } @@ -3031,8 +3029,8 @@ } } - if {![:pinfo exists bundle parametersyntax]} { - :pinfo set bundle parametersyntax $params + if {![:pinfo exists bundle syntax]} { + :pinfo set bundle syntax $params } # Note: [next] will cause the missing parameter created to @@ -3071,7 +3069,7 @@ # the parametersyntax. Review later ... # if {${:name} eq "__out__" && \ - [${:partof} eval {: -system info has type ::nx::doc::@command}]} return; + [${:partof} eval {: -system info has type ::nx::doc::@command}]} return # # Here, we escape from any parameter verification for @@ -3081,7 +3079,7 @@ if {[${:partof} eval {: -system info has type ::nx::doc::@method}] && \ [${:partof} pinfo get bundle type] in [list forward alias]} { dict set :pdata status "" - return; + return } if {[info exists :pdata] && \ @@ -3120,7 +3118,7 @@ } } - if {![llength $scripts]} return; + if {![llength $scripts]} return set sbox [Sandbox new -interp [interp create]] # 1pass Index: library/nx/nx.nxd =================================================================== diff -u -N -r062dd3cb76774853a767854e29f60a3325c4bd94 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/nx/nx.nxd (.../nx.nxd) (revision 062dd3cb76774853a767854e29f60a3325c4bd94) +++ library/nx/nx.nxd (.../nx.nxd) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -771,7 +771,7 @@ # pattern string in the sense of # '''string match''' -# @class.method {Class "info parameter definition"} +# @class.method {Class "info parameter definitions"} # # Returns all parameters, or the selected one, as object parameter # specifications Index: library/nx/nx.tcl =================================================================== diff -u -N -r8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/nx/nx.tcl (.../nx.tcl) (revision 8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b) +++ library/nx/nx.tcl (.../nx.tcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -332,8 +332,9 @@ # Provide a placeholder for objectparameter during the bootup # process. The real definition is based on slots, which are not # available at this point. - Class protected method __objectparameter {} {;} + Object protected method __objectparameter {} {;} + ###################################################################### # Define forward methods ###################################################################### @@ -422,13 +423,7 @@ # internally by the serializer. # proc ::nx::isSlotContainer {object} { - set container [namespace tail $object] - if {[::nsf::object::exists $object] && $container in {slot per-object-slot}} { - set parent [$object ::nsf::methods::object::info::parent] - return [expr {[::nsf::object::exists $parent] - && [::nsf::method::property $parent -per-object $container slotcontainer]}] - } - return 0 + return [::nsf::object::property $object slotcontainer] } # @@ -441,7 +436,8 @@ ::nsf::method::property $baseObject -per-object $containerName call-protected true ::nsf::method::property $baseObject -per-object $containerName redefine-protected true #puts stderr "::nsf::method::property $baseObject -per-object $containerName slotcontainer true" - ::nsf::method::property $baseObject -per-object $containerName slotcontainer true + #::nsf::method::property $baseObject -per-object $containerName slotcontainer true + ::nsf::object::property $slotContainer slotcontainer true } # @@ -456,6 +452,9 @@ if {![::nsf::object::exists $slotContainer]} { ::nx::Object ::nsf::methods::class::alloc $slotContainer ::nx::internal::setSlotContainerProperties $baseObject $container + if {$container eq "per-object-slot"} { + ::nsf::object::property $baseObject hasperobjectslots true + } } if {[info exists name]} { return ${slotContainer}::$name @@ -646,7 +645,7 @@ :protected alias __configure ::nsf::methods::object::configure :public method configure {args} { if {[llength $args] == 0} { - [:info class] info parameter syntax + : ::nsf::methods::object::info::objectparameter syntax } else { : __configure {*}$args return @@ -670,6 +669,26 @@ if {[info exists pattern]} {lappend cmd $pattern} return [: {*}$cmd] } + :method "info lookup parameter definitions" {pattern:optional} { + set cmd [list ::nsf::methods::object::info::objectparameter definition] + if {[info exists pattern]} {lappend cmd $pattern} + return [: {*}$cmd] + } + :method "info lookup parameter names" {pattern:optional} { + set cmd [list ::nsf::methods::object::info::objectparameter name] + if {[info exists pattern]} {lappend cmd $pattern} + return [: {*}$cmd] + } + :method "info lookup parameter list" {pattern:optional} { + set cmd [list ::nsf::methods::object::info::objectparameter list] + if {[info exists pattern]} {lappend cmd $pattern} + return [: {*}$cmd] + } + :method "info lookup parameter syntax" {pattern:optional} { + set cmd [list ::nsf::methods::object::info::objectparameter syntax] + if {[info exists pattern]} {lappend cmd $pattern} + return [: {*}$cmd] + } :alias "info children" ::nsf::methods::object::info::children :alias "info class" ::nsf::methods::object::info::class :alias "info filter guard" ::nsf::methods::object::info::filterguard @@ -750,27 +769,29 @@ :alias "info mixin guard" ::nsf::methods::class::info::mixinguard :alias "info mixin classes" ::nsf::methods::class::info::mixinclasses :alias "info mixinof" ::nsf::methods::class::info::mixinof - :method "info parameter definition" {name:optional} { - if {[info exists name]} { - return [: ::nsf::methods::class::info::objectparameter parameter $name] - } - return [:__objectparameter] - } - :method "info parameter list" {name:optional} { - set cmd [list ::nsf::methods::class::info::objectparameter list] + :method "info parameter definitions" {name:optional} { + set cmd [list ::nsf::methods::class::info::slotobjects -closure -type ::nx::Slot] if {[info exists name]} {lappend cmd $name} - return [: {*}$cmd] + return [::nsf::parameter::specs -configure [: {*}$cmd]] } - :method "info parameter names" {name:optional} { - set cmd [list ::nsf::methods::class::info::objectparameter name] - if {[info exists name]} {lappend cmd $name} - return [: {*}$cmd] + :method "info parameter list" {{name:optional ""}} { + set defs [:info parameter definitions {*}$name] + set result "" + foreach def $defs {lappend result [::nsf::parameter::get list $def]} + return $result } - :method "info parameter syntax" {name:optional} { - set cmd [list ::nsf::methods::class::info::objectparameter parametersyntax] - if {[info exists name]} {lappend cmd $name} - return [: {*}$cmd] + :method "info parameter names" {{name:optional ""}} { + set defs [:info parameter definitions {*}$name] + set result "" + foreach def $defs {lappend result [::nsf::parameter::get name $def]} + return $result } + :method "info parameter syntax" {{name:optional ""}} { + set defs [:info parameter definitions {*}$name] + set result "" + foreach def $defs {lappend result [::nsf::parameter::get syntax $def]} + return [join $result " "] + } :method "info slot objects" {{-type ::nx::Slot} -closure:switch -source:optional pattern:optional} { set cmd [list ::nsf::methods::class::info::slotobjects -type $type] if {[info exists source]} {lappend cmd -source $source} @@ -1092,16 +1113,21 @@ # # Bootstrap version of getParameter spec. Just bare essentials. # + if {[info exists :parameterSpec]} { + return ${:parameterSpec} + } set name [namespace tail [self]] set prefix [expr {[info exists :positional] && ${:positional} ? "" : "-"}] set options [list] if {[info exists :default]} { if {[string match {*\[*\]*} ${:default}]} { append options substdefault } - return [list [list [:namedParameterSpec $prefix $name $options]] ${:default}] + set :parameterSpec [list [list [:namedParameterSpec $prefix $name $options]] ${:default}] + } else { + set :parameterSpec [list [:namedParameterSpec $prefix $name $options]] } - return [list [:namedParameterSpec $prefix $name $options]] + return ${:parameterSpec} } BootStrapVariableSlot protected method init {args} { @@ -1319,24 +1345,9 @@ # Define objectparameter method ###################################################################### - Class protected method __objectparameter {} { - # - # Collect the object parameter slots in per-position lists to - # ensure partial ordering and avoid sorting. - # - foreach slot [nsf::directdispatch [self] ::nsf::methods::class::info::slotobjects -closure -type ::nx::Slot] { - lappend defs([$slot position]) [$slot getParameterSpec] - } - # - # Fold the per-position lists into a common list - # parameterdefinitions, which is the result. - # - set parameterdefinitions [list] - foreach p [lsort [array names defs]] { - lappend parameterdefinitions {*}$defs($p) - } - #puts stderr "*** parameter definition for [::nsf::self]: $parameterdefinitions" - return $parameterdefinitions + Object protected method __objectparameter {} { + set slotObjects [nsf::directdispatch [self] ::nsf::methods::object::info::lookupslots -type ::nx::Slot] + return [::nsf::parameter::specs $slotObjects] } } @@ -2213,6 +2224,7 @@ # copy object -> might be a class obj ::nsf::object::property $obj keepcallerself [::nsf::object::property $origin keepcallerself] ::nsf::object::property $obj perobjectdispatch [::nsf::object::property $origin perobjectdispatch] + ::nsf::object::property $obj hasperobjectslots [::nsf::object::property $origin hasperobjectslots] ::nsf::method::assertion $obj check [::nsf::method::assertion $origin check] ::nsf::method::assertion $obj object-invar [::nsf::method::assertion $origin object-invar] ::nsf::relation $obj object-filter [::nsf::relation $origin object-filter] @@ -2239,15 +2251,12 @@ } # - # Check, if $origin is a slot container. If yes, set the same - # properties on $dest + # Check, if $origin is a slot container. If yes, set the slot + # container properties on $dest # - set base [$origin ::nsf::methods::object::info::parent] - set container [namespace tail $origin] - if {[::nsf::object::exists $base] - && [::nsf::method::property $base -per-object $container slotcontainer] - } { - ::nx::internal::setSlotContainerProperties [$dest ::nsf::methods::object::info::parent] $container + if {[::nsf::object::property $origin slotcontainer]} { + ::nx::internal::setSlotContainerProperties \ + [$dest ::nsf::methods::object::info::parent] [namespace tail $origin] } # Index: library/xotcl/library/lib/metadataAnalyzer.xotcl =================================================================== diff -u -N -r9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/xotcl/library/lib/metadataAnalyzer.xotcl (.../metadataAnalyzer.xotcl) (revision 9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0) +++ library/xotcl/library/lib/metadataAnalyzer.xotcl (.../metadataAnalyzer.xotcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -61,6 +61,7 @@ } } + Class create MetadataToken -parameter { {name ""} {properties ""} Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -N -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -377,13 +377,14 @@ # Method objectparameter, backwards upward compatible. We use # here the definition of parametersfromslots from nx.tcl # - ::xotcl::Class instproc objectparameter {} { - set parameterdefinitions [list] - foreach slot [nsf::directdispatch [self] ::nsf::methods::class::info::slotobjects -closure -type ::nx::Slot] { - lappend parameterdefinitions [$slot getParameterSpec] + ::xotcl::Object instproc objectparameter {} { + set parameterDefinitions [list] + set class [nsf::directdispatch [self] ::nsf::methods::object::info::class] + foreach slot [nsf::directdispatch $class ::nsf::methods::class::info::slotobjects -closure -type ::nx::Slot] { + lappend parameterDefinitions [$slot getParameterSpec] } - lappend parameterdefinitions args:alias,method=residualargs,args - return $parameterdefinitions + lappend parameterDefinitions args:alias,method=residualargs,args + return $parameterDefinitions } ###################################################################### @@ -928,28 +929,6 @@ # explicitly to slots for backward compatibility ... # :public alias unknown ::nsf::classes::xotcl::Class::unknown - :public method __objectparameter {} { - set parameterdefinitions [list] - set slots [nsf::directdispatch [self] \ - ::nsf::methods::class::info::slotobjects \ - -closure -type ::nx::Slot] - foreach slot $slots { - # - # Skip any positional object parameters (i.e., __initcmd) - # which are not backward compatible with the XOTcl slots - # interface ... - # - if {[$slot eval { - expr {[info exists :positional] && ${:positional}} - }]} continue; - lappend parameterdefinitions [$slot getParameterSpec] - } - # - # Add the XOTcl-specific handling of residual varargs - # - lappend parameterdefinitions args:alias,method=residualargs,args - return $parameterdefinitions - } } # @@ -966,6 +945,14 @@ return [$object eval [list :isMultivalued]] } } + + :public method __objectparameter {} { + set slotObjects [nsf::directdispatch [self] ::nsf::methods::object::info::lookupslots -type ::nx::Slot] + set parameterDefinitions [::nsf::parameter::specs -nonposargs $slotObjects] + lappend parameterDefinitions args:alias,method=residualargs,args + return $parameterDefinitions + } + # provide minimal compatibility :public alias proc ::nsf::classes::xotcl::Object::proc :public method exists {var} {::nsf::var::exists [self] $var} Index: library/xotcl/tests/slottest.xotcl =================================================================== diff -u -N -r364a9eda329acd7d20173a4165d71394d3061aae -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 364a9eda329acd7d20173a4165d71394d3061aae) +++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -113,7 +113,8 @@ ? {o1 class} "::O" o1 class Object ? {o1 class} "::xotcl::Object" -? {Object objectparameter} "-mixin:mixinreg,alias,0..n -filter:filterreg,alias,0..n -class:class,alias args:alias,method=residualargs,args" +? {o1 objectparameter} "-mixin:mixinreg,alias,0..n -filter:filterreg,alias,0..n -class:class,alias args:alias,method=residualargs,args" +? {Object objectparameter} "-instfilter:filterreg,alias,0..n -superclass:alias,0..n -instmixin:mixinreg,alias,0..n {-__default_metaclass ::xotcl::Class} {-__default_superclass ::xotcl::Object} -mixin:mixinreg,alias,0..n -filter:filterreg,alias,0..n -class:class,alias args:alias,method=residualargs,args" ? {o1 class add M} {class: expected a class but got "M ::xotcl::Object"} @@ -384,9 +385,11 @@ ? {c3 x} "0" } + ################### # Application Slots # +nx::Test case app-slots Class Person -slots { Attribute create name @@ -461,6 +464,7 @@ } } } + Person p3 -sex male ? {p3 sex} m Person method foo {s:sex,slot=::Person::slot::sex,convert} {return $s} Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -N -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -408,7 +408,7 @@ SC($i) destroy } - ::errorCheck $::filterCount 960 \ + ::errorCheck $::filterCount 1080 \ "Filter Test - Filter Count -- Got: $::filterCount" # @@ -556,7 +556,7 @@ Class D D filter f D d1 - ::errorCheck $::r "::D-d1 ::D-alloc ::D-objectparameter ::D-create ::D-unknown" \ + ::errorCheck $::r "::D-d1 ::D-alloc ::D-create ::D-unknown" \ "filter state after next" Object instproc f {} {} D destroy @@ -1161,7 +1161,7 @@ TransferDialog$i destroy } - ::errorCheck $::filterCount 240 \ + ::errorCheck $::filterCount 260 \ "Simple Observer - Filter Count" } @@ -2951,7 +2951,7 @@ Recreated recreateObj recreateObj destroy errorCheck [set ::recreateFilterResult] \ - " ::recreateObj+::xotcl::Object->configure ::recreateObj+::xotcl::Object->init ::recreateObj+::xotcl::Object->cleanup ::recreateObj+::xotcl::Object->configure ::recreateObj+::xotcl::Object->init ::recreateObj+::xotcl::Object->destroy" \ + " ::recreateObj+::xotcl::Object->configure ::recreateObj+::xotcl::Object->objectparameter ::recreateObj+::xotcl::Object->init ::recreateObj+::xotcl::Object->cleanup ::recreateObj+::xotcl::Object->configure ::recreateObj+::xotcl::Object->init ::recreateObj+::xotcl::Object->destroy" \ "recreateObj - recreateFilterResult" if {$i == 0} { errorCheck [set ::recreateMixinResult] \ @@ -3182,12 +3182,12 @@ ::errorCheck [b info procs] objproc "info procs" ::errorCheck [B info instprocs] myProc2 "info instprocs" - ::errorCheck [lsort [b info methods]] "abstract append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg f filter filterguard filtersearch forward hasclass incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objproc parametercmd proc procsearch requireNamespace residualargs self set setFilter signature subst trace unknown unset uplevel upvar volatile vwait" "b info methods" + ::errorCheck [lsort [b info methods]] "abstract append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg f filter filterguard filtersearch forward hasclass incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objectparameter objproc parametercmd proc procsearch requireNamespace residualargs self set setFilter signature subst trace unknown unset uplevel upvar volatile vwait" "b info methods" - ::errorCheck [lsort [b info methods -nocmds]] "abstract check extractConfigureArg f filtersearch forward hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 myProcMix1 myProcMix2 objproc proc procsearch self setFilter signature unknown vwait" "b info methods -nocmds" + ::errorCheck [lsort [b info methods -nocmds]] "abstract check extractConfigureArg f filtersearch forward hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc proc procsearch self setFilter signature unknown vwait" "b info methods -nocmds" ::errorCheck [lsort [b info methods -noprocs]] "append array autoname class cleanup configure destroy eval exists filter filterguard incr info instvar invar lappend mixin mixinguard noinit parametercmd requireNamespace residualargs set subst trace unset uplevel upvar volatile" "b info methods -noprocs" - ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract check extractConfigureArg f filtersearch forward hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 objproc proc procsearch self setFilter signature unknown vwait" "b info methods -nocmds -nomixins" + ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract check extractConfigureArg f filtersearch forward hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 objectparameter objproc proc procsearch self setFilter signature unknown vwait" "b info methods -nocmds -nomixins" ::errorCheck [b info methods -nocmds -noprocs] "" "b info methods -nocmds -noprocs" ::errorCheck [lsort [B info methods -nocmds]] "abstract allinstances check extractConfigureArg f filtersearch forward hasclass init instforward instproc isclass ismetaclass ismixin isobject istype method objectparameter parameter proc procsearch self setFilter signature slots unknown uses vwait" "B info methods -nocmds" @@ -3584,9 +3584,9 @@ set ::context payrollApp - ::errorCheck [lsort [jim info methods]] "abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy driving-license eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "condmixin all methods" + ::errorCheck [lsort [jim info methods]] "abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy driving-license eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "condmixin all methods" - ::errorCheck "[lsort [jim info methods -incontext]]" "abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "all methods in context" + ::errorCheck "[lsort [jim info methods -incontext]]" "abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "all methods in context" ::errorCheck [my show payrollApp jim] "{payrollApp: jim info methods salary => salary} {payrollApp: jim info methods -incontext salary => salary} {payrollApp: jim info methods driv* => driving-license} {payrollApp: jim info methods -incontext driv* => }" "payrollApp jim" ::errorCheck [my show shipmentApp jim] "{shipmentApp: jim info methods salary => salary} {shipmentApp: jim info methods -incontext salary => } {shipmentApp: jim info methods driv* => driving-license} {shipmentApp: jim info methods -incontext driv* => driving-license}" "shipmentApp jim" Index: tests/disposition.test =================================================================== diff -u -N -rfbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- tests/disposition.test (.../disposition.test) (revision fbdde5cf08cdbbbde43f1d5a8ddc836d66dc09f4) +++ tests/disposition.test (.../disposition.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -25,12 +25,12 @@ # some testing helpers # :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } + #:class method __objectparameter {} { + # return ${:objectparams} + #} :setObjectParams "" :public class method new args { @@ -323,12 +323,12 @@ nx::Test case dispo-multiplicities { Class create S { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } + #:class method __objectparameter {} { + # return ${:objectparams} + #} :public method foo {args} { set :foo $args return $args @@ -385,13 +385,10 @@ nx::Test case dispo-returns { Class create R { - :public class method setObjectParams {spec} { - set :objectparams $spec - ::nsf::invalidateobjectparameter [current] + :public class method setObjectParams {spec} { + :protected method __objectparameter {} [list return $spec] + ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } } # @@ -453,12 +450,9 @@ nx::Test case dispo-callstack { Class create Callee { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } } # @@ -624,12 +618,9 @@ nx::Test case alias-noarg { Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } :public method foo {args} { set :foo $args return $args @@ -768,12 +759,9 @@ nx::Test case alias-noarg { Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } } C setObjectParams {initcmd:initcmd,noarg} @@ -786,12 +774,9 @@ nx::Test case alias-args { Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } :public method Residualargs args { puts stderr "aliased RESIDUALARGS <[llength $args]>" puts stderr "....... <$args>" @@ -879,12 +864,9 @@ nx::Test case alias-init { Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - return ${:objectparams} - } :method init {} { incr :y } @@ -903,14 +885,9 @@ # Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - if {[info exists :objectparams]} { - return ${:objectparams} - } - } } # A depth-1 submethod ... @@ -1108,14 +1085,9 @@ nx::Test case dispo-configure-transparency { Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - if {[info exists :objectparams]} { - return ${:objectparams} - } - } } ::proc foo {} { @@ -1206,14 +1178,9 @@ Class create C Class create T { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [current] } - :class method __objectparameter {} { - if {[info exists :objectparams]} { - return ${:objectparams} - } - } } # @@ -1373,7 +1340,7 @@ ? {::xotcl::Class create XD -set x 1} "::XD" #? {c1 eval {info exists :args}} 0 - ? {XD objectparameter} "-mixin:mixinreg,alias,0..n -filter:filterreg,alias,0..n -class:class,alias args:alias,method=residualargs,args" + ? {XD objectparameter} "-instfilter:filterreg,alias,0..n -superclass:alias,0..n -instmixin:mixinreg,alias,0..n {-__default_metaclass ::xotcl::Class} {-__default_superclass ::xotcl::Object} -mixin:mixinreg,alias,0..n -filter:filterreg,alias,0..n -class:class,alias args:alias,method=residualargs,args" # # test passing arguments to init Index: tests/info-method.test =================================================================== diff -u -N -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- tests/info-method.test (.../info-method.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) +++ tests/info-method.test (.../info-method.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -661,7 +661,7 @@ # ? {nx::Object info method parameter "info lookup methods"} \ "-callprotection -incontext:switch -methodtype -nomixins:switch -path:switch -source pattern:optional" - ? {nx::Object info method parametersyntax "info lookup methods"} \ + ? {nx::Object info method syntax "info lookup methods"} \ "?-callprotection all|public|protected|private? ?-incontext? ?-methodtype all|scripted|builtin|alias|forwarder|object|setter|nsfproc? ?-nomixins? ?-path? ?-source all|application|baseclasses? ?pattern?" ? {o info method parameter "foo b"} "x:int y:upper" @@ -696,18 +696,20 @@ :class property -accessor public a2 :method "sub foo" args {;} } - +puts stderr ====1 + C new ? {C info parameter syntax} "?-a value? ?-b value? ?-volatile? ?-properties value? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?" +puts stderr ====2 ? {C info parameter syntax a} "?-a value?" - ? {C info parameter definition} "-a {-b 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" + ? {C info parameter definitions} "-a {-b 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" ? {C info parameter list} "-a -b -volatile -properties -noinit -mixin -class -filter __initcmd" ? {C info parameter names} "a b volatile properties noinit mixin class filter __initcmd" ? {lsort [C info slot objects -closure]} "::C::slot::a ::C::slot::b ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter ::nx::Object::slot::mixin ::nx::Object::slot::noinit ::nx::Object::slot::properties ::nx::Object::slot::volatile" - ? {C info parameter definition b} "{-b 1}" - ? {D info parameter definition b} "{-b 2}" + ? {C info parameter definitions b} "{-b 1}" + ? {D info parameter definitions b} "{-b 2}" ? {D info slot objects -closure b} "::D::slot::b" ? {D info slot objects -closure a} "::C::slot::a" ? {D info slot objects -closure class} "::nx::Object::slot::class" @@ -726,7 +728,7 @@ ? {::nx::Object info methods "info"} "info" ? {::nx::Object info methods -path "info"} "" ? {lsort [::nx::Object info methods -path "info lookup *"]} \ - "{info lookup filter} {info lookup method} {info lookup methods} {info lookup slots}" + "{info lookup filter} {info lookup method} {info lookup methods} {info lookup parameter definitions} {info lookup parameter list} {info lookup parameter names} {info lookup parameter syntax} {info lookup slots}" ? {lsort [::nx::Object info methods -path "info *method*"]} \ "{info filter methods} {info lookup method} {info lookup methods} {info method} {info methods}" ? {lsort [::nx::Object info methods "slots"]} "" @@ -779,12 +781,12 @@ # nx::Test case parametersyntax { # a true method - ? {::nx::Object info method parametersyntax method} "name arguments ?-returns value? body ?-precondition value? ?-postcondition value?" - # a forwarder to ::nsf::relation; definition comes via ::nsf::parametersyntax - ? {::nx::Object info method parametersyntax mixin} "?classes?|?add class?|?delete class?" + ? {::nx::Object info method syntax method} "name arguments ?-returns value? body ?-precondition value? ?-postcondition value?" + # a forwarder to ::nsf::relation; definition comes via array ::nsf::parametersyntax + ? {::nx::Object info method syntax mixin} "?classes?|?add class?|?delete class?" - ? {::nx::Object info method parametersyntax ::nx::next} "?arguments?" - ? {::nx::Object info method parametersyntax ::nsf::xotclnext} "?--noArgs? ?arg ...?" + ? {::nx::Object info method syntax ::nx::next} "?arguments?" + ? {::nx::Object info method syntax ::nsf::xotclnext} "?--noArgs? ?arg ...?" } # @@ -1202,5 +1204,5 @@ # Test error messages within an ensemble call # nx::Test case error-in-ensemble { - ? {nx::Object info method definition foo 1} {invalid argument '1', maybe too many arguments; should be "::nx::Object info method args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|parametersyntax|type|precondition|postcondition|submethods|returns name"} + ? {nx::Object info method definition foo 1} {invalid argument '1', maybe too many arguments; should be "::nx::Object info method args|body|definition|exists|registrationhandle|definitionhandle|handle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns name"} } \ No newline at end of file Index: tests/object-system.test =================================================================== diff -u -N -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- tests/object-system.test (.../object-system.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4) +++ tests/object-system.test (.../object-system.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -191,6 +191,11 @@ ? {::nsf::object::exists C::slot} 1 ? {C info children} ::C::slot +#? {C::slot info vars} __parameter +#? {C info attributes} {{x 1} {y 2}} +? {C info parameter definitions x} {{-x 1}} +? {C info parameter definitions y} {{-y 2}} + ? {C copy X} ::X ? {::nsf::object::exists X} 1 ? {X info vars} "" @@ -205,15 +210,11 @@ ? {set C [C copy]} ::nsf::__#6 ? {::nsf::object::exists ${C}::slot} 1 -#? {C::slot info vars} __parameter -#? {C info attributes} {{x 1} {y 2}} -? {C info parameter definition x} {{-x 1}} -? {C info parameter definition y} {{-y 2}} #? {X::slot info vars} __parameter #? {X info attributes} {{x 1} {y 2}} -? {X info parameter definition x} {{-x 1}} -? {X info parameter definition y} {{-y 2}} +? {X info parameter definitions x} {{-x 1}} +? {X info parameter definitions y} {{-y 2}} ? {X info properties} {{x 1} {y 2}} ? {X info properties -closure *a*} {volatile:alias,noarg class:class,alias,method=::nsf::methods::object::class} Index: tests/parameters.test =================================================================== diff -u -N -r8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- tests/parameters.test (.../parameters.test) (revision 8232fc43e280715e51dc20a9b7f2a3bb9bb2ff7b) +++ tests/parameters.test (.../parameters.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -274,10 +274,11 @@ C create c1 ? {C eval :__objectparameter} \ - "-a -b:boolean {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" + "{-superclass:class,alias,method=::nsf::methods::class::superclass,1..n ::nx::Object} -object-mixin:mixinreg,alias,method=::nsf::classes::nx::Object::mixin -mixin:mixinreg,alias,0..n -object-filter:filterreg,alias,method=::nsf::classes::nx::Object::filter -filter:filterreg,alias,0..n -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -class:class,alias,method=::nsf::methods::object::class __initcmd:initcmd,optional,noleadingdash" - ? {c1 eval :__objectparameter} \ - "::c1: unable to dispatch method '__objectparameter'" + #### TOOD: remove or add + #? {c1 eval :__objectparameter} \ + # "::c1: unable to dispatch method '__objectparameter'" } ####################################################### @@ -304,7 +305,7 @@ ? {d1 info lookup slots -source application} \ "::D::slot::d ::C::slot::a ::C::slot::b ::C::slot::c" - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-d:required -a -b:boolean {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" } @@ -333,29 +334,29 @@ } D mixin M - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-b -m1 -m2 -d:required -a {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \ "mixin added" M mixin M2 - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \ "transitive mixin added" D mixin "" #we should have again the old interface - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-d:required -a -b:boolean {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" C mixin M - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \ "mixin added" C mixin "" #we should have again the old interface - ? {D eval :__objectparameter} \ + ? {d1 eval :__objectparameter} \ "-d:required -a -b:boolean {-c 1} -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" } @@ -1309,12 +1310,14 @@ ? {o a} 4 ? {o b} 44 ? {o c 5} 999 - + ? {::nsf::object::property o hasperobjectslots} 1 + o copy o2 ? {o a} 4 ? {o b} 44 ? {o c 5} 999 + ? {::nsf::object::property o2 hasperobjectslots} 1 ::nx::Class create C { :property a {set :defaultcmd { set _ 4 } } @@ -1584,17 +1587,17 @@ :method metaclassarg {-x:metaclass} {return $x} } - ? {Foo info method parametersyntax noarg} "" - ? {Foo info method parametersyntax onearg} "?-x value?" - ? {Foo info method parametersyntax intarg} "?-x integer?" - ? {Foo info method parametersyntax intsarg} "?-x integer ...?" - ? {Foo info method parametersyntax boolarg} "?-x boolean?" - ? {Foo info method parametersyntax classarg} "?-x class?" - ? {Foo info method parametersyntax upperarg} "?-x upper?" - ? {Foo info method parametersyntax metaclassarg} "?-x metaclass?" + ? {Foo info method syntax noarg} "" + ? {Foo info method syntax onearg} "?-x value?" + ? {Foo info method syntax intarg} "?-x integer?" + ? {Foo info method syntax intsarg} "?-x integer ...?" + ? {Foo info method syntax boolarg} "?-x boolean?" + ? {Foo info method syntax classarg} "?-x class?" + ? {Foo info method syntax upperarg} "?-x upper?" + ? {Foo info method syntax metaclassarg} "?-x metaclass?" # return enumeration type - ? {nx::Class info method parametersyntax "info mixinof"} \ + ? {nx::Class info method syntax "info mixinof"} \ "?-closure? ?-scope all|class|object? ?pattern?" } @@ -1828,15 +1831,13 @@ } # -# Test potential incfluence on parameters +# Test incfluence of mixins on objectparameters # nx::Test case parameter-object-mixin-dependency { nx::Class create C { :property a1 :create c1 { -puts stderr ====1 :property a2 -puts stderr ====2 } } @@ -1850,7 +1851,7 @@ ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::properties ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter" - ? {C eval :__objectparameter} "-a1 -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" + ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" # # invalidate object parameter and expect that the per-class mixin @@ -1864,7 +1865,7 @@ ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::properties ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter" - ? {C eval :__objectparameter} "-a1 -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" + ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,noarg -properties:alias,method=::nx::internal::addProperties -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" # should not require b1 ? {C create c2} ::c2 @@ -2138,9 +2139,7 @@ nx::Class create C { # define 2 class-level variables, one via variable, one via property - puts stderr ====1 :variable v v0 - puts stderr ====2 :property {a a0} # create an instance @@ -2155,13 +2154,13 @@ # # We expect a specifiable object parameter for "a" but not for "v". # The parameter for v can be obtained via spec, but is not listed in - # "info parameter syntax" or "info parameter definition". + # "info parameter syntax" or "info parameter definitions". # ? {C info parameter list a} "-a" - ? {C info parameter definition a} "{-a a0}" + ? {C info parameter definitions a} "{-a a0}" ? {C info parameter syntax a} "?-a value?" - ? {C info parameter definition v} "" + ? {C info parameter definitions v} "" ? {C info slot definition v} "{v:noconfig v0}" ? {C info parameter list v} "" ? {C info parameter syntax v} "" @@ -2448,12 +2447,9 @@ nx::Class create C { :public class method setObjectParams {spec} { - set :objectparams $spec + :protected method __objectparameter {} [list return $spec] ::nsf::invalidateobjectparameter [self] } - :class method __objectparameter {} { - return ${:objectparams} - } :setObjectParams "" } Index: tests/serialize.test =================================================================== diff -u -N -r75a621dace63d1282e9abd6f0f4da5fbe11d47c5 -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 --- tests/serialize.test (.../serialize.test) (revision 75a621dace63d1282e9abd6f0f4da5fbe11d47c5) +++ tests/serialize.test (.../serialize.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2) @@ -150,10 +150,11 @@ ? {::nsf::object::exists ::C::slot} 1 ? {::nsf::object::exists ::C::per-object-slot} 1 - ? {::nsf::method::property ::C -per-object slot slotcontainer} 1 - ? {::nsf::method::property ::C -per-object per-object-slot slotcontainer} 1 + ? {::nx::isSlotContainer ::C::slot} 1 + ? {::nx::isSlotContainer ::C::per-object-slot} 1 ? {::nsf::object::exists ::C::slot::a} 1 ? {::nsf::object::exists ::C::per-object-slot::x} 1 + ? {::nsf::object::property ::C hasperobjectslots} 1 set script [C serialize] C destroy @@ -162,10 +163,11 @@ eval $script ? {::nsf::object::exists ::C::slot} 1 ? {::nsf::object::exists ::C::per-object-slot} 1 - ? {::nsf::method::property ::C -per-object slot slotcontainer} 1 - ? {::nsf::method::property ::C -per-object per-object-slot slotcontainer} 1 + ? {::nx::isSlotContainer ::C::slot} 1 + ? {::nx::isSlotContainer ::C::per-object-slot} 1 ? {::nsf::object::exists ::C::slot::a} 1 ? {::nsf::object::exists ::C::per-object-slot::x} 1 + ? {::nsf::object::property ::C hasperobjectslots} 1 } #