Index: TODO =================================================================== diff -u -r396bf130d2a1dc934b01522a105bc93fa003f237 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- TODO (.../TODO) (revision 396bf130d2a1dc934b01522a105bc93fa003f237) +++ TODO (.../TODO) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -2949,7 +2949,26 @@ * removed residualargs from object system definition * extended regression test +- nsf.c: + * Don't output non-consuming procs (which are always called) + via parametersyntax (shows, what a user can input) + * additional command ::nsf::object::initialized to check whether + an object is already initialized + * new function DispatchInitMethod() similar to DispatchDefaultMethod() + * let residualargs call init directly instead of doing it the inidrect way + * provided ability to call init with object parameters at arbitrary + times + * switch from Tcl_ObjCmdProc style interface (ClientData first) + to a C stype interface for DispatchDefaultMethod(), DispatchUnknownMethod() + * bring cmd definitions for nsf::object in right order +- extended regression test + + TODO: +- do we have to adjust the documentation in xotcl2 for object initialization? +- maybe optional arg (true) to ::nsf::object::initialized + to generalize -noinit +- nsf.c: change "nsfCmd" to "cmd" - add explicit regression tests for disposition + types - check refcounting for dispo+types Index: generic/gentclAPI.decls =================================================================== diff -u -rfe26beaf50950cf92a55bba33afcc92f5583814c -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision fe26beaf50950cf92a55bba33afcc92f5583814c) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -112,19 +112,22 @@ {-argName "parameter" -required 1 -type tclobj} } -cmd proc NsfProcCmd { - {-argName "-ad" -required 0 -nrargs 0} - {-argName "procName" -required 1 -type tclobj} - {-argName "arguments" -required 1 -type tclobj} - {-argName "body" -required 1 -type tclobj} +cmd "object::exists" NsfObjectExistsCmd { + {-argName "value" -required 1 -type tclobj} } +cmd "object::initialized" NsfObjectInitializedCmd { + {-argName "objectName" -required 1 -type object} +} +cmd "object::qualify" NsfObjectQualifyCmd { + {-argName "objectName" -required 1 -type tclobj} +} - cmd my NsfMyCmd { {-argName "-local" -nrargs 0} {-argName "methodName" -required 1 -type tclobj} {-argName "args" -type args} } + cmd next NsfNextCmd { {-argName "arguments" -required 0 -type tclobj} } @@ -136,12 +139,13 @@ {-argName "fromNs" -required 1 -type tclobj} {-argName "toNs" -required 1 -type tclobj} } -cmd "object::exists" NsfIsObjectCmd { - {-argName "value" -required 1 -type tclobj} + +cmd proc NsfProcCmd { + {-argName "-ad" -required 0 -nrargs 0} + {-argName "procName" -required 1 -type tclobj} + {-argName "arguments" -required 1 -type tclobj} + {-argName "body" -required 1 -type tclobj} } -cmd "object::qualify" NsfQualifyObjCmd { - {-argName "objectName" -required 1 -type tclobj} -} cmd relation NsfRelationCmd { {-argName "object" -required 1 -type object} {-argName "relationtype" -required 1 -type "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"} Index: generic/nsf.c =================================================================== diff -u -r6409ddbc3a2f70f716c4bdc4b2bded464809f0bd -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- generic/nsf.c (.../nsf.c) (revision 6409ddbc3a2f70f716c4bdc4b2bded464809f0bd) +++ generic/nsf.c (.../nsf.c) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -185,10 +185,10 @@ int objc, Tcl_Obj *CONST objv[], Tcl_Command cmd, NsfObject *object, NsfClass *cl, CONST char *methodName, int frameType, int flags); -static int DispatchDefaultMethod(ClientData clientData, Tcl_Interp *interp, +static int DispatchDefaultMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *obj, int flags); static int DispatchDestroyMethod(Tcl_Interp *interp, NsfObject *object, int flags); -static int DispatchUnknownMethod(ClientData clientData, Tcl_Interp *interp, +static int DispatchUnknownMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *CONST objv[], NsfObject *delegator, Tcl_Obj *methodObj, int flags); @@ -7962,6 +7962,12 @@ for (pPtr = paramPtr; pPtr->name; pPtr++) { if (pPtr != paramPtr) { + /* + * Don't output non-consuming parameters (i.e. positional, and no args) + */ + if (*pPtr->name != '-' && pPtr->nrArgs == 0) { + continue; + } Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL); } if (pPtr->converter == ConvertToNothing && strcmp(pPtr->name, "args") == 0) { @@ -8468,7 +8474,7 @@ if (objc < 2) { CallFrame frame, *framePtr = &frame; Nsf_PushFrameCsc(interp, cscPtr, framePtr); - result = DispatchDefaultMethod(cp, interp, objv[0], NSF_CSC_IMMEDIATE); + result = DispatchDefaultMethod(interp, invokeObj, objv[0], NSF_CSC_IMMEDIATE); Nsf_PopFrameCsc(interp, framePtr); } else { CallFrame frame, *framePtr = &frame; @@ -8547,7 +8553,7 @@ * handler. */ /*fprintf(stderr, "next calls DispatchUnknownMethod\n");*/ - result = DispatchUnknownMethod(self, interp, objc, objv, object, + result = DispatchUnknownMethod(interp, self, objc, objv, object, objv[1], NSF_CM_NO_OBJECT_METHOD|NSF_CSC_IMMEDIATE); } obj_dispatch_ok: @@ -8711,7 +8717,7 @@ if ((flags & NSF_CSC_METHOD_IS_UNKNOWN) || ((cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) && rst->unknown) ) { - result = DispatchUnknownMethod(object, interp, + result = DispatchUnknownMethod(interp, object, cscPtr->objc, cscPtr->objv, NULL, cscPtr->objv[0], (cscPtr->flags & NSF_CSC_CALL_NO_UNKNOWN)|NSF_CSC_IMMEDIATE); /* @@ -9079,11 +9085,10 @@ *---------------------------------------------------------------------- */ static int -DispatchDefaultMethod(ClientData clientData, Tcl_Interp *interp, +DispatchDefaultMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *obj, int flags) { int result; Tcl_Obj *methodObj; - NsfObject *object = clientData; assert(object); @@ -9097,12 +9102,13 @@ tov[0] = obj; tov[1] = methodObj; - result = ObjectDispatch(clientData, interp, 2, tov, flags|NSF_CM_NO_UNKNOWN); + result = ObjectDispatch(object, interp, 2, tov, flags|NSF_CM_NO_UNKNOWN); } return result; } + /* *---------------------------------------------------------------------- * DispatchDestroyMethod -- @@ -9172,6 +9178,62 @@ /* *---------------------------------------------------------------------- + * DispatchInitMethod -- + * +in case the object system has it + * defined and it was not already called on the object, + * + * Results: + * Result code. + * + * Side effects: + * Indirect effects by calling Tcl code + * + *---------------------------------------------------------------------- + */ +static int +DispatchInitMethod(Tcl_Interp *interp, NsfObject *object, + int objc, Tcl_Obj *CONST objv[], + int flags) { + int result; + Tcl_Obj *methodObj; + + assert(object); + + /* + * check, whether init was called already + */ + if (!(object->flags & (NSF_INIT_CALLED|NSF_DESTROY_CALLED))) { + + /* + * Flag the call to "init" before the dispatch, such that a call to + * "configure" within init does not clear the already set instance + * variables. + */ + + object->flags |= NSF_INIT_CALLED; + + if (CallDirectly(interp, object, NSF_o_init_idx, &methodObj)) { + /*fprintf(stderr, "%s init directly\n", ObjectName(object));*/ + /* + * Actually, nothing to do. + */ + result = TCL_OK; + } else { + /*fprintf(stderr, "%s init dispatch\n", ObjectName(object));*/ + result = CallMethod(object, interp, methodObj, + objc+2, objv, flags|NSF_CM_NO_PROTECT|NSF_CSC_IMMEDIATE); + } + + } else { + result = TCL_OK; + } + + return result; +} + +/* + *---------------------------------------------------------------------- * DispatchUnknownMethod -- * * Dispatch the method "unknown" in case the object system has it @@ -9187,11 +9249,10 @@ */ static int -DispatchUnknownMethod(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], +DispatchUnknownMethod(Tcl_Interp *interp, NsfObject *object, + int objc, Tcl_Obj *CONST objv[], NsfObject *delegator, Tcl_Obj *methodObj, int flags) { int result; - NsfObject *object = (NsfObject *)clientData; Tcl_Obj *unknownObj = NsfMethodObj(object, NSF_o_unknown_idx); CONST char *methodName = MethodName(methodObj); @@ -9231,7 +9292,7 @@ mustCopy, delegator, ObjStr(tov[offset]), ObjStr(methodObj));*/ INCR_REF_COUNT(tov[offset]); - result = ObjectDispatch(clientData, interp, objc+offset, tov, flags|NSF_CM_NO_UNKNOWN); + result = ObjectDispatch(object, interp, objc+offset, tov, flags|NSF_CM_NO_UNKNOWN); DECR_REF_COUNT(tov[offset]); FREE_ON_STACK(Tcl_Obj*, tov); @@ -9283,7 +9344,7 @@ */ result = ObjectDispatch(clientData, interp, objc, objv, 0); } else { - result = DispatchDefaultMethod(clientData, interp, objv[0], 0); + result = DispatchDefaultMethod(interp, (NsfObject *)clientData, objv[0], 0); } return result; } @@ -10211,7 +10272,7 @@ for (start = j+1; start0 && isspace((int)argString[end-1]); end--); @@ -13077,17 +13138,33 @@ /* - * Std object initialization: - * call parameter default values - * apply "-" methods (call "configure" with given arguments) - * call constructor "init", if it was not called before + *---------------------------------------------------------------------- + * DoObjInitialization -- + * + * Perform the object initialization: first call "configure" and the + * constructor "init", if not called already from configure. The function + * will make sure that the called methods do not change the result passed + * into this function. + * + * Results: + * Tcl return code + * + * Side effects: + * Indirect effects by calling Tcl code + * + *---------------------------------------------------------------------- */ static int DoObjInitialization(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *CONST objv[]) { - Tcl_Obj *methodObj, *savedObjResult = Tcl_GetObjResult(interp); /* save the result */ + Tcl_Obj *methodObj, *savedObjResult; int result; + /* + * Save the result we have so far to return it in case of success + */ + savedObjResult = Tcl_GetObjResult(interp); INCR_REF_COUNT(savedObjResult); + /* * clear INIT_CALLED flag */ @@ -13099,7 +13176,7 @@ NsfObjectRefCountIncr(object); /* - * call configure method + * Call configure method */ if (CallDirectly(interp, object, NSF_o_configure_idx, &methodObj)) { ALLOC_ON_STACK(Tcl_Obj*, objc, tov); @@ -13112,49 +13189,19 @@ result = CallMethod(object, interp, methodObj, objc, objv+2, NSF_CSC_IMMEDIATE); } - if (result != TCL_OK) { - goto objinitexit; - } - - /* - * check, whether init was called already - */ - if (!(object->flags & (NSF_INIT_CALLED|NSF_DESTROY_CALLED))) { - int nobjc = 0; - Tcl_Obj **nobjv, *resultObj = Tcl_GetObjResult(interp); - + if (result == TCL_OK) { /* - * Call the scripted constructor and pass the result of - * configure to it as arguments + * Call constructor when needed */ - INCR_REF_COUNT(resultObj); - Tcl_ListObjGetElements(interp, resultObj, &nobjc, &nobjv); - - /* - * Flag the call to "init" before the dispatch, such that a call to - * "configure" within init does not clear the already set instance - * variables. - */ - - object->flags |= NSF_INIT_CALLED; - - if (CallDirectly(interp, object, NSF_o_init_idx, &methodObj)) { - //fprintf(stderr, "%s init directly\n", ObjectName(object)); - result = TCL_OK; - } else { - //fprintf(stderr, "%s init dispatch\n", ObjectName(object)); - result = CallMethod(object, interp, methodObj, - nobjc+2, nobjv, NSF_CM_NO_PROTECT|NSF_CSC_IMMEDIATE); + if (!(object->flags & (NSF_INIT_CALLED|NSF_DESTROY_CALLED))) { + result = DispatchInitMethod(interp, object, 0, NULL, 0); } - DECR_REF_COUNT(resultObj); + if (result == TCL_OK) { + Tcl_SetObjResult(interp, savedObjResult); + } } - if (result == TCL_OK) { - Tcl_SetObjResult(interp, savedObjResult); - } - - objinitexit: NsfCleanupObject(object, "obj init"); DECR_REF_COUNT(savedObjResult); return result; @@ -13788,7 +13835,7 @@ if (objc > 1) { result = ObjectDispatch(object, interp, objc, objv, NSF_CSC_IMMEDIATE); } else { - result = DispatchDefaultMethod(object, interp, objv[0], NSF_CSC_IMMEDIATE); + result = DispatchDefaultMethod(interp, object, objv[0], NSF_CSC_IMMEDIATE); } } else { /*fprintf(stderr, "CallForwarder: no nsf object %s\n", ObjStr(tcd->cmdName));*/ @@ -16475,8 +16522,8 @@ osPtr->rootClass = theobj; osPtr->rootMetaClass = thecls; - theobj->object.flags |= NSF_IS_ROOT_CLASS; - thecls->object.flags |= NSF_IS_ROOT_META_CLASS; + theobj->object.flags |= NSF_IS_ROOT_CLASS|NSF_INIT_CALLED; + thecls->object.flags |= NSF_IS_ROOT_META_CLASS|NSF_INIT_CALLED; ObjectSystemAdd(interp, osPtr); @@ -16745,18 +16792,54 @@ } /* -nsfCmd isobject NsfIsObjectCmd { - {-argName "object" -required 1 -type tclobj} +cmd "object::exists" NsfObjectExistsCmd { + {-argName "value" -required 1 -type tclobj} } */ static int -NsfIsObjectCmd(Tcl_Interp *interp, Tcl_Obj *valueObj) { +NsfObjectExistsCmd(Tcl_Interp *interp, Tcl_Obj *valueObj) { NsfObject *object; + + /* + * Pass the object as Tcl_Obj, since we do not want to raise an error in + * case the object does not exist. + */ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), GetObjectFromObj(interp, valueObj, &object) == TCL_OK); return TCL_OK; } /* +cmd "object::initialized" NsfObjectInitializedCmd { + {-argName "objectName" -required 1 -type object} +} +*/ +static int +NsfObjectInitializedCmd(Tcl_Interp *interp, NsfObject *object) { + + Tcl_SetObjResult(interp, + NsfGlobalObjs[(object->flags & NSF_INIT_CALLED) ? + NSF_ONE : NSF_ZERO]); + return TCL_OK; +} + +/* +cmd "object::qualify" NsfObjectQualifyCmd { + {-argName "objectName" -required 1 -type tclobj} +} +*/ +static int +NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *nameObj) { + CONST char *nameString = ObjStr(nameObj); + + if (isAbsolutePath(nameString)) { + Tcl_SetObjResult(interp, nameObj); + } else { + Tcl_SetObjResult(interp, NameInNamespaceObj(interp, nameString, CallingNameSpace(interp))); + } + return TCL_OK; +} + +/* nsfCmd method::alias NsfMethodAliasCmd { {-argName "object" -type object} {-argName "-per-object"} @@ -17728,23 +17811,6 @@ } /* -nsfCmd __qualify NsfQualifyObjCmd { - {-argName "name" -required 1 -type tclobj} -} -*/ -static int -NsfQualifyObjCmd(Tcl_Interp *interp, Tcl_Obj *nameObj) { - CONST char *nameString = ObjStr(nameObj); - - if (isAbsolutePath(nameString)) { - Tcl_SetObjResult(interp, nameObj); - } else { - Tcl_SetObjResult(interp, NameInNamespaceObj(interp, nameString, CallingNameSpace(interp))); - } - return TCL_OK; -} - -/* nsfCmd relation NsfRelationCmd { {-argName "object" -type object} {-argName "relationtype" -required 1 -type "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"} @@ -18632,7 +18698,8 @@ NsfParsedParam parsedParam; Nsf_Param *paramPtr; NsfParamDefs *paramDefs; - Tcl_Obj *newValue; + Tcl_Obj *newValue, *initMethodObj; + CONST char *initString; ParseContext pc; CallFrame frame, *framePtr = &frame; @@ -18649,6 +18716,13 @@ return result; } + if (CallDirectly(interp, object, NSF_o_init_idx, &initMethodObj)) { + initString = NULL; + } else { + initString = ObjStr(initMethodObj); + } + + /* Push frame to allow for [self] and make instvars of obj accessible as locals */ Nsf_PushFrameObj(interp, object, framePtr); @@ -18757,6 +18831,7 @@ } else if (paramPtr->flags & NSF_ARG_ALIAS) { Tcl_Obj *methodObj, **ovPtr, *ov0; + CONST char *methodString; int oc = 0; /* @@ -18770,6 +18845,7 @@ * If "method=" was given, use it as method name */ methodObj = paramPtr->method ? paramPtr->method : paramPtr->nameObj; + methodString = ObjStr(methodObj); /*fprintf(stderr, "ALIAS %s, nrargs %d converter %p toNothing %d i %d oc %d, pcPtr->lastobjc %d\n", paramPtr->name, paramPtr->nrArgs, paramPtr->converter, @@ -18813,14 +18889,24 @@ } ovPtr = NULL; } - - /*fprintf(stderr, "call alias %s with methodObj %s.%s oc %d, nrArgs %d '%s'\n", - paramPtr->name, ObjectName(object), ObjStr(methodObj), oc, - paramPtr->nrArgs, ObjStr(newValue));*/ - result = NsfCallMethodWithArgs(interp, (Nsf_Object*)object, methodObj, - ov0, oc, ovPtr, NSF_CSC_IMMEDIATE); + /* + * Check, if we have an object parameter alias for the constructor. + * Since we require the object system for the current object to + * determine its object system configuration, we can't do this at + * parameter compile time. + */ + if (initString && *initString == *methodString && strcmp(initString, methodString) == 0) { + result = DispatchInitMethod(interp, object, oc, &ov0, 0); + } else { + /*fprintf(stderr, "call alias %s with methodObj %s.%s oc %d, nrArgs %d '%s'\n", + paramPtr->name, ObjectName(object), ObjStr(methodObj), oc, + paramPtr->nrArgs, ObjStr(newValue));*/ + + result = NsfCallMethodWithArgs(interp, (Nsf_Object*)object, methodObj, + ov0, oc, ovPtr, NSF_CSC_IMMEDIATE); + } } else /* must be NSF_ARG_FORWARD */ { Tcl_Obj *forwardSpec = paramPtr->method ? paramPtr->method : NULL; /* different default? */ Tcl_Obj **nobjv, *ov[3]; @@ -18927,21 +19013,16 @@ } } - Nsf_PopFrameObj(interp, framePtr); - remainingArgsc = pc.objc - paramDefs->nrParams; /* - * Check, if varargs were processed. In case of varargs, we return the - * result of the varargs cmd (to preserve XOTcl compatibility); otherwise, - * return empty. + * Check, if varargs were processed. */ + remainingArgsc = pc.objc - paramDefs->nrParams; if (pc.varArgs && remainingArgsc > 0) { assert(varArgsProcessed); - } else { - Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]); } configure_exit: @@ -19132,9 +19213,9 @@ */ static int NsfOResidualargsMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *CONST objv[]) { - Tcl_Obj **argv, **nextArgv, *resultObj; int i, start = 1, argc, nextArgc, normalArgs, result = TCL_OK, isdasharg = NO_DASH; CONST char *methodName, *nextMethodName, *initString = NULL; + Tcl_Obj **argv, **nextArgv; #if 0 fprintf(stderr, "NsfOResidualargsMethod %s %2d ",ObjectName(object), objc); @@ -19196,9 +19277,17 @@ } } } - resultObj = Tcl_NewListObj(normalArgs, objv+1); - Tcl_SetObjResult(interp, resultObj); + /* + * Call init with residual args in case it was not called yet + */ + result = DispatchInitMethod(interp, object, normalArgs, objv+1, 0); + + /* + * Return the non-processed leading arguments (XOTcl convention) + */ + Tcl_SetObjResult(interp, Tcl_NewListObj(normalArgs, objv+1)); + return result; } Index: generic/nsfInt.h =================================================================== diff -u -r396bf130d2a1dc934b01522a105bc93fa003f237 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- generic/nsfInt.h (.../nsfInt.h) (revision 396bf130d2a1dc934b01522a105bc93fa003f237) +++ generic/nsfInt.h (.../nsfInt.h) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -582,7 +582,7 @@ */ typedef enum { - NSF_EMPTY, NSF_ONE, + NSF_EMPTY, NSF_ZERO, NSF_ONE, /* methods called internally */ NSF_CONFIGURE, /* var names */ @@ -603,7 +603,7 @@ extern char *NsfGlobalStrings[]; #else char *NsfGlobalStrings[] = { - "", "1", + "", "0", "1", /* methods called internally */ "configure", /* var names */ Index: generic/tclAPI.h =================================================================== diff -u -rceb5634acd12db91d50b16bcec1bda5906922ced -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- generic/tclAPI.h (.../tclAPI.h) (revision ceb5634acd12db91d50b16bcec1bda5906922ced) +++ generic/tclAPI.h (.../tclAPI.h) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -230,7 +230,6 @@ static int NsfInterpObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfInvalidateObjectParameterCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfIsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int NsfIsObjectCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfMethodAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfMethodAssertionCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfMethodCreateCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -243,10 +242,12 @@ static int NsfNSCopyCmdsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfNSCopyVarsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfNextCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfObjectExistsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfObjectInitializedCmdStub(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 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 []); -static int NsfQualifyObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfSelfCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfSetVarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -324,7 +325,6 @@ static int NsfInterpObjCmd(Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[]); static int NsfInvalidateObjectParameterCmd(Tcl_Interp *interp, NsfClass *class); static int NsfIsCmd(Tcl_Interp *interp, int withComplain, Tcl_Obj *constraint, Tcl_Obj *value); -static int NsfIsObjectCmd(Tcl_Interp *interp, Tcl_Obj *value); static int NsfMethodAliasCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, CONST char *methodName, int withFrame, Tcl_Obj *cmdName); static int NsfMethodAssertionCmd(Tcl_Interp *interp, NsfObject *object, int assertionsubcmd, Tcl_Obj *arg); static int NsfMethodCreateCmd(Tcl_Interp *interp, NsfObject *object, int withInner_namespace, int withPer_object, NsfObject *withReg_object, Tcl_Obj *methodName, Tcl_Obj *arguments, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); @@ -337,10 +337,12 @@ static int NsfNSCopyCmdsCmd(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int NsfNSCopyVarsCmd(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int NsfNextCmd(Tcl_Interp *interp, Tcl_Obj *arguments); +static int NsfObjectExistsCmd(Tcl_Interp *interp, Tcl_Obj *value); +static int NsfObjectInitializedCmd(Tcl_Interp *interp, NsfObject *objectName); +static int NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *objectName); 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); -static int NsfQualifyObjCmd(Tcl_Interp *interp, Tcl_Obj *objectName); static int NsfRelationCmd(Tcl_Interp *interp, NsfObject *object, int relationtype, Tcl_Obj *value); static int NsfSelfCmd(Tcl_Interp *interp); static int NsfSetVarCmd(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *varName, Tcl_Obj *value); @@ -419,7 +421,6 @@ NsfInterpObjCmdIdx, NsfInvalidateObjectParameterCmdIdx, NsfIsCmdIdx, - NsfIsObjectCmdIdx, NsfMethodAliasCmdIdx, NsfMethodAssertionCmdIdx, NsfMethodCreateCmdIdx, @@ -432,10 +433,12 @@ NsfNSCopyCmdsCmdIdx, NsfNSCopyVarsCmdIdx, NsfNextCmdIdx, + NsfObjectExistsCmdIdx, + NsfObjectInitializedCmdIdx, + NsfObjectQualifyCmdIdx, NsfProcCmdIdx, NsfProfileClearDataStubIdx, NsfProfileGetDataStubIdx, - NsfQualifyObjCmdIdx, NsfRelationCmdIdx, NsfSelfCmdIdx, NsfSetVarCmdIdx, @@ -1188,22 +1191,6 @@ } static int -NsfIsObjectCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - (void)clientData; - - - - if (objc != 2) { - return NsfArgumentError(interp, "wrong # of arguments:", - method_definitions[NsfIsObjectCmdIdx].paramDefs, - NULL, objv[0]); - } - - return NsfIsObjectCmd(interp, objc == 2 ? objv[1] : NULL); - -} - -static int NsfMethodAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; (void)clientData; @@ -1460,6 +1447,57 @@ } static int +NsfObjectExistsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + (void)clientData; + + + + if (objc != 2) { + return NsfArgumentError(interp, "wrong # of arguments:", + method_definitions[NsfObjectExistsCmdIdx].paramDefs, + NULL, objv[0]); + } + + return NsfObjectExistsCmd(interp, objc == 2 ? objv[1] : NULL); + +} + +static int +NsfObjectInitializedCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + (void)clientData; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfObjectInitializedCmdIdx].paramDefs, + method_definitions[NsfObjectInitializedCmdIdx].nrParameters, 1, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + NsfObject *objectName = (NsfObject *)pc.clientData[0]; + + assert(pc.status == 0); + return NsfObjectInitializedCmd(interp, objectName); + + } +} + +static int +NsfObjectQualifyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + (void)clientData; + + + + if (objc != 2) { + return NsfArgumentError(interp, "wrong # of arguments:", + method_definitions[NsfObjectQualifyCmdIdx].paramDefs, + NULL, objv[0]); + } + + return NsfObjectQualifyCmd(interp, objc == 2 ? objv[1] : NULL); + +} + +static int NsfProcCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; (void)clientData; @@ -1514,22 +1552,6 @@ } static int -NsfQualifyObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - (void)clientData; - - - - if (objc != 2) { - return NsfArgumentError(interp, "wrong # of arguments:", - method_definitions[NsfQualifyObjCmdIdx].paramDefs, - NULL, objv[0]); - } - - return NsfQualifyObjCmd(interp, objc == 2 ? objv[1] : NULL); - -} - -static int NsfRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; (void)clientData; @@ -2423,9 +2445,6 @@ {"constraint", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"value", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::object::exists", NsfIsObjectCmdStub, 1, { - {"value", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} -}, {"::nsf::method::alias", NsfMethodAliasCmdStub, 5, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"-per-object", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, @@ -2498,6 +2517,15 @@ {"::nsf::next", NsfNextCmdStub, 1, { {"arguments", 0, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::object::exists", NsfObjectExistsCmdStub, 1, { + {"value", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, +{"::nsf::object::initialized", NsfObjectInitializedCmdStub, 1, { + {"objectName", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, +{"::nsf::object::qualify", NsfObjectQualifyCmdStub, 1, { + {"objectName", 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}, @@ -2510,9 +2538,6 @@ {"::nsf::__profile_get", NsfProfileGetDataStubStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::object::qualify", NsfQualifyObjCmdStub, 1, { - {"objectName", NSF_ARG_REQUIRED, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} -}, {"::nsf::relation", NsfRelationCmdStub, 3, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"relationtype", NSF_ARG_REQUIRED|NSF_ARG_IS_ENUMERATION, 1, ConvertToRelationtype, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, Index: library/nx/nx.tcl =================================================================== diff -u -r58e11ae3135406567181a97b8eac0d88e179a897 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- library/nx/nx.tcl (.../nx.tcl) (revision 58e11ae3135406567181a97b8eac0d88e179a897) +++ library/nx/nx.tcl (.../nx.tcl) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -1249,10 +1249,20 @@ # # Define the initcmd as a positional ObjectParameterSlot # +# ::nx::ObjectParameterSlot create ${os}::Object::slot::__init \ +# -disposition alias \ +# -methodname "init" \ +# -noarg true \ +# -positional true \ +# -position 1 + + # + # Define the initcmd as a positional ObjectParameterSlot + # ::nx::ObjectParameterSlot create ${os}::Object::slot::__initcmd \ -disposition initcmd \ -positional true \ - -position 1 + -position 2 # # Make sure the invalidate all ObjectParameterSlots Index: tests/disposition.test =================================================================== diff -u -r396bf130d2a1dc934b01522a105bc93fa003f237 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- tests/disposition.test (.../disposition.test) (revision 396bf130d2a1dc934b01522a105bc93fa003f237) +++ tests/disposition.test (.../disposition.test) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -557,6 +557,31 @@ } + +nx::Test case alias-init { + Class create C { + :public class method setObjectParams {spec} { + set :objectparams $spec + ::nsf::invalidateobjectparameter [current] + } + :class method objectparameter {} { + return ${:objectparams} + } + :method init {} { + incr :y + } + } + + # call init between -a and -b + C setObjectParams {-a init:alias,noarg -b:integer} + ? {C create c1} {::c1} + # "init" should be called only once + ? {c1 eval {set :y}} 1 +} +#puts stderr ===exit +#exit + +# # check xotcl with residual args # nx::Test case xotcl-residualargs { @@ -578,4 +603,32 @@ ? {x1 exists args} 1 ? {x1 set args} {1 2 3} } -#puts stderr ===exit \ No newline at end of file + + +nx::Test parameter count 100000 +nx::Test case xotcl-residualargs { + + ::xotcl::Class create XC -parameter {a b c} + ::XC instproc init args {set :x $args; incr :y} + + ::nx::Class create C { + :attribute a + :attribute b + :attribute c + :method init args {set :x $args; incr :y} + } + + ? {XC create xc1 -a 1} ::xc1 + ? {XC create xc2 x y -a 1} ::xc2 + + ? {C create c1 -a 1} ::c1 + ? {xc2 eval {info exists :a}} 1 + ? {xc2 eval {set :x}} {x y} + ? {xc2 eval {set :y}} 1 + ? {c1 eval {info exists :a}} 1 + ? {c1 eval {set :y}} 1 +} + +# TODO: what todo with object parameter inspection for names with alias, forward... "names" do not always correspond with vars set. +#puts stderr ===exit + Index: tests/object-system.test =================================================================== diff -u -r756a5ed4e51921ada898fdf69cc7bd2c5c616828 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- tests/object-system.test (.../object-system.test) (revision 756a5ed4e51921ada898fdf69cc7bd2c5c616828) +++ tests/object-system.test (.../object-system.test) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -22,6 +22,7 @@ ? {::nsf::configure objectsystem} "{::nx::Object ::nx::Class {-class.alloc alloc -class.create create -class.dealloc dealloc -class.objectparameter objectparameter -class.recreate recreate -object.configure configure -object.defaultmethod defaultmethod -object.destroy destroy -object.init init -object.move move -object.unknown unknown}}" ? {::nsf::object::exists Object} 1 +? {::nsf::object::initialized Object} 1 ? {::nsf::is class Object} 1 ? {::nsf::is metaclass Object} 0 ? {Object info superclass} "" @@ -42,6 +43,12 @@ ? {Object info instances o} ::o ? {Object info instances ::o} ::o +Object create o2 { + ? {::nsf::object::exists ::o2} 1 + ? {::nsf::object::initialized ::o2} 0 +} +? {::nsf::object::initialized ::o2} 1 + Class create C0 ? {::nsf::is class C0} 1 ? {::nsf::is metaclass C0} 0 Index: tests/parameters.test =================================================================== diff -u -r58e11ae3135406567181a97b8eac0d88e179a897 -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- tests/parameters.test (.../parameters.test) (revision 58e11ae3135406567181a97b8eac0d88e179a897) +++ tests/parameters.test (.../parameters.test) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -970,19 +970,23 @@ {expected object but got "xxx" for parameter "o"} \ "value is not an object" - #ParamTest slots { - # ::nx::Attribute create os -type object -multivalued true - #} + # + # define multivalued attribute "os" via instance variables of the + # slot object + # ParamTest eval { - :attribute os { - :type object - :multiplicity 1..n - } + :attribute os { + :type object + :multiplicity 1..n + } } - + + ? {ParamTest info method definition os} "::ParamTest public setter os:object,1..n" + ? {p os o} \ "o" \ "value is a list of objects (1 element)" + ? {p os {o c1 d1}} \ "o c1 d1" \ "value is a list of objects (multiple elements)" Index: tests/protected.test =================================================================== diff -u -r4536c2540977c43aaf422800dab048e5d9063b3f -r52a0f3588723b74acd74a83be339c80b5b4a6701 --- tests/protected.test (.../protected.test) (revision 4536c2540977c43aaf422800dab048e5d9063b3f) +++ tests/protected.test (.../protected.test) (revision 52a0f3588723b74acd74a83be339c80b5b4a6701) @@ -74,29 +74,44 @@ ? {c2 bar-SET} 1 ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} +# +# Define SET and foo as redefined-protected +# ? {::nsf::method::property C SET redefine-protected true} 1 -? {catch {C method SET {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} ? {::nsf::method::property C foo redefine-protected true} 1 -? {catch {C method foo {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'foo' of ::C cannot be overwritten. Derive e.g. a sub-class!} + +? {C method SET {a b c} {...}} \ + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine method SET" + +? {C method foo {a b c} {...}} \ + {Method 'foo' of ::C cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine method foo" + # check a predefined protection -? {catch {::nx::Class method create {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} -# try to redefined via alias -? {catch {::nsf::method::alias Class create ::set} errorMsg; set errorMsg} \ - {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} +? {::nx::Class method create {a b c} {...}} \ + {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine method create" + +# try to redefine predefined protected method via alias +? {::nsf::method::alias Class create ::set} \ + {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine alias create" + # try to redefine via forward -? {catch {C forward SET ::set} errorMsg; set errorMsg} \ - {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} +? {C forward SET ::set} \ + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine forward SET" + # try to redefine via setter -? {catch {C attribute SET} errorMsg; set errorMsg} \ - {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} +? {C attribute SET} \ + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \ + "redefine attribute SET" # overwrite-protect object specific method Object create o o method foo {} {return 13} ::nsf::method::property o foo redefine-protected true -? {catch {o method foo {} {return 14}} errorMsg; set errorMsg} \ +? {o method foo {} {return 14}} \ {Method 'foo' of ::o cannot be overwritten. Derive e.g. a sub-class!}