Index: TODO =================================================================== diff -u -rb3c57743ba237eec2a7bae9f920d8728997766cf -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- TODO (.../TODO) (revision b3c57743ba237eec2a7bae9f920d8728997766cf) +++ TODO (.../TODO) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -1902,31 +1902,54 @@ appears to be included in tcl.m4 (since a while). Many thanks to Victor Guerra for noticing it. -TODO: +- perform relation handling in objectparameters outside of object-frame -- For preexisting namespaces, we do not set the deleteProc. - Is this desired? Should nsPtr->deleteProc be moved to - NsfNamespaceInit()? +- For preexisting namespaces, we do not set the deleteProc. Is this + desired? Should nsPtr->deleteProc be moved to NsfNamespaceInit()? + .... It is ok on the current labor distribution between object and + namespace: if an object is deleted, it takes care about the deletion + of subobjects, not the namespace. However, it might be an option in + the future to overthink this strategy and to bush (sub)object + deletion into the namespace deletion. +- work on replacing SKIP_LEVELS by SKIP_LAMBDA for openacs (works with + regression test, has problems with OrderedComposite::ChildManager.init) + Note concerning treating CMETHOD_FRAME like METHOD_FRAMES: we did + this change for NsfCallStackFindLastInvocation(), but nsfStack.c has + still several occurences, where they are treated differently. + +- changed relation handling by evaluating the relationcmd in the parent + context to keep evaluation order. +- extend introspection "nsf::configure objectsystem": the command + returns now all system methods in the syntax of nsf::createobjectsystem +- "nsf::createobjectsystem" creates now a warning when an existing + objectsystem is redefined and ignores the new definition attempt. + This was done with the purpose to allow + "package forget nx; package require nx" +- Allow overwriting of redefine protected method during bootstrap + to ease "package forget nx; package require nx" +- forward had just "-objscope", no general "-frame method|object". + Since forwarder have client data, they always push a method frame. + So, the situation is different to nsd::alias and ::nsf::dispatch. + Therefore, the flag "-objscope" was renamed to "-objectframe" + to provide better consistency with "-frame object" +- fixed bug, where error handling of invalid options in + ForwardProcessOptions() could lead to a crash +- return forwardoption "-earlybinding" via instrospection +- extended regression test + + +TODO: + - "-returns" * leave syntax as is for method? * add flag to alias and forward? - * handle "returns" in serializer + * handle "-returns" in serializer -- forward has just "-objscope", no general "-frame method|object". - Since forwarder have client data, they always push a method frame. - So, the situation is different to nsd::alias and ::nsf::dispatch. - not sure, if we should rename "-objscope" to something different, - such as e.g. "-objectframe". + - extend coro regression test -- work on replacing SKIP_LEVELS by SKIP_LAMBDA for openacs (works with - regression test, has problems with OrderedComposite::ChildManager.init) - Note concerning treating CMETHOD_FRAME like METHOD_FRAMES: we did - this change for NsfCallStackFindLastInvocation(), but nsfStack.c has - still several occurences, where they are treated differently. - - C-interface * rework C-interface * maybe for post-alpha, but we have be first clear @@ -2077,6 +2100,9 @@ "p:integer,multivalued" => "-name p -type integer -multivalued" "x:type,arg=::D d1" => "-name x -type type -arg ::D -default d1" + * rework implict namespace completion (NameInNamespaceObj(), + maybe based on BeginOfCallChain()). + * use parameter syntax in genTclAPI * it could be possible to reduce stack frames in ensembles. Just a Index: generic/gentclAPI.decls =================================================================== diff -u -rd884e8166428ad9dae6c39cb16c8324953b69b11 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision d884e8166428ad9dae6c39cb16c8324953b69b11) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -70,7 +70,7 @@ {-argName "-default" -nrargs 1 -type tclobj} {-argName "-earlybinding"} {-argName "-methodprefix" -nrargs 1 -type tclobj} - {-argName "-objscope"} + {-argName "-objframe"} {-argName "-onerror" -nrargs 1 -type tclobj} {-argName "-verbose"} {-argName "target" -type tclobj} Index: generic/nsf.c =================================================================== diff -u -rf39b258e182cd2c9df32890902ef89490e0d77d8 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- generic/nsf.c (.../nsf.c) (revision f39b258e182cd2c9df32890902ef89490e0d77d8) +++ generic/nsf.c (.../nsf.c) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -112,7 +112,7 @@ int hasNonposArgs; int nr_args; Tcl_Obj *args; - int objscope; + int objframe; Tcl_Obj *onerror; Tcl_Obj *prefix; int nr_subcommands; @@ -3223,9 +3223,18 @@ if (ok) { result = TCL_OK; } else { - result = NsfVarErrMsg(interp, "Method '", methodName, "' of ", objectName(object), - " can not be overwritten. Derive e.g. a sub-class!", + /* + * We could test, whether we are bootstrapping the "right" object + * system, and allow only overwrites for the current bootstrap + * object system, but this seems neccessary by now. + */ + Tcl_Obj *bootstrapObj = Tcl_GetVar2Ex(interp, "::nsf::bootstrap", NULL, TCL_GLOBAL_ONLY); + fprintf(stderr, "bootStrapObv = %p\n", bootstrapObj); + if (bootstrapObj == NULL) { + result = NsfVarErrMsg(interp, "Method '", methodName, "' of ", objectName(object), + " cannot be overwritten. Derive e.g. a sub-class!", (char *) NULL); + } } ObjectSystemsCheckSystemMethod(interp, methodName, GetObjectSystem(object)); @@ -3894,7 +3903,7 @@ return TCL_OK; /* we do not check assertion modifying methods, otherwise - we can not react in catch on a runtime assertion check failure */ + we cannot react in catch on a runtime assertion check failure */ #if 1 /* TODO: the following check operations is XOTcl1 legacy and is not @@ -8323,7 +8332,7 @@ NsfGlobalStrings[NSF_METHOD_PARAMETER_SLOT_OBJ]) != 0) { if (RUNTIME_STATE(interp)->debugLevel > 0) { - fprintf(stderr, "**** checker method %s defined on %s shadows built-in converter\n", + fprintf(stderr, "Warning: checker method %s defined on %s shadows built-in converter\n", converterNameString, objectName(paramObj)); } @@ -8606,7 +8615,7 @@ static int ForwardProcessOptions(Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, + int withObjframe, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int objc, Tcl_Obj * CONST objv[], ForwardCmdClientData **tcdp) { ForwardCmdClientData *tcd; @@ -8636,11 +8645,11 @@ tcd->onerror = withOnerror; INCR_REF_COUNT(tcd->onerror); } - tcd->objscope = withObjscope; + tcd->objframe = withObjframe; tcd->verbose = withVerbose; tcd->needobjmap = 0; tcd->cmdName = target; - /*fprintf(stderr, "...forwardprocess objc %d\n", objc);*/ + /*fprintf(stderr, "...forwardprocess objc %d, cmdName %p %s\n", objc, target, ObjStr(target));*/ for (i=0; icmdName), tcd->args?ObjStr(tcd->args):"NULL", tcd->nr_args);*/ - if (tcd->objscope) { + if (tcd->objframe) { /* when we evaluating objscope, and define ... - o forward append -objscope append + o forward append -objframe append a call to o append ... would lead to a recursive call; so we add the appropriate namespace @@ -8683,9 +8692,10 @@ if (withEarlybinding) { Tcl_Command cmd = Tcl_GetCommandFromObj(interp, tcd->cmdName); - if (cmd == NULL) - return NsfVarErrMsg(interp, "cannot lookup command '", ObjStr(tcd->cmdName), "'", (char *) NULL); - + if (cmd == NULL) { + result = NsfVarErrMsg(interp, "cannot lookup command '", ObjStr(tcd->cmdName), "'", (char *) NULL); + goto forward_process_options_exit; + } tcd->objProc = Tcl_Command_objProc(cmd); if (tcd->objProc == NsfObjDispatch /* don't do direct invoke on nsf objects */ || tcd->objProc == TclObjInterpProc /* don't do direct invoke on tcl procs */ @@ -8698,7 +8708,8 @@ } tcd->passthrough = !tcd->args && *(ObjStr(tcd->cmdName)) != '%' && tcd->objProc; - + + forward_process_options_exit: /*fprintf(stderr, "forward args = %p, name = '%s'\n", tcd->args, ObjStr(tcd->cmdName));*/ if (result == TCL_OK) { *tcdp = tcd; @@ -10982,7 +10993,7 @@ fprintf(stderr, "forwarder calls '%s'\n", ObjStr(cmd)); DECR_REF_COUNT(cmd); } - if (tcd->objscope) { + if (tcd->objframe) { Nsf_PushFrameObj(interp, object, framePtr); } if (tcd->objProc) { @@ -11001,7 +11012,7 @@ result = Tcl_EvalObjv(interp, objc, objv, 0); } - if (tcd->objscope) { + if (tcd->objframe) { Nsf_PopFrameObj(interp, framePtr); } if (result == TCL_ERROR && tcd && tcd->onerror) { @@ -12026,9 +12037,12 @@ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-default", -1)); Tcl_ListObjAppendElement(interp, listObj, tcd->subcommands); } - if (tcd->objscope) { - Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-objscope", -1)); + if (tcd->objProc) { + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-earlybinding", -1)); } + if (tcd->objframe) { + Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-objframe", -1)); + } Tcl_ListObjAppendElement(interp, listObj, tcd->cmdName); if (tcd->args) { Tcl_Obj **args; @@ -12043,7 +12057,7 @@ static void AppendMethodRegistration(Tcl_Interp *interp, Tcl_Obj *listObj, CONST char *registerCmdName, NsfObject *object, CONST char *methodName, Tcl_Command cmd, - int withObjscope, int withPer_object, int withProtection) { + int withObjframe, int withPer_object, int withProtection) { Tcl_ListObjAppendElement(interp, listObj, object->cmdName); if (withProtection) { Tcl_ListObjAppendElement(interp, listObj, @@ -12057,7 +12071,7 @@ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(registerCmdName, -1)); Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(methodName, -1)); - if (withObjscope) { + if (withObjframe) { Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-frame", 6)); Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6)); } @@ -12833,7 +12847,6 @@ {-argName "-per-object"} {-argName "methodName"} {-argName "-frame" -required 0 -nrargs 1 -type "method|object|default" -default "default"} - {-argName "-objscope"} {-argName "cmdName" -required 1 -type tclobj} } */ @@ -13043,8 +13056,22 @@ for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr; osPtr = osPtr->nextPtr) { Tcl_Obj *osObj = Tcl_NewListObj(0, NULL); + Tcl_Obj *systemMethods = Tcl_NewListObj(0, NULL); + int idx; + Tcl_ListObjAppendElement(interp, osObj, osPtr->rootClass->object.cmdName); Tcl_ListObjAppendElement(interp, osObj, osPtr->rootMetaClass->object.cmdName); + + for (idx = 0; Nsf_SytemMethodOpts[idx]; idx++) { + /*fprintf(stderr, "opt %s %s\n", Nsf_SytemMethodOpts[idx], + osPtr->methods[idx] ? ObjStr(osPtr->methods[idx]) : "NULL");*/ + if (osPtr->methods[idx] == NULL) { + continue; + } + Tcl_ListObjAppendElement(interp, systemMethods, Tcl_NewStringObj(Nsf_SytemMethodOpts[idx], -1)); + Tcl_ListObjAppendElement(interp, systemMethods, osPtr->methods[idx]); + } + Tcl_ListObjAppendElement(interp, osObj, systemMethods); Tcl_ListObjAppendElement(interp, list, osObj); } Tcl_SetObjResult(interp, list); @@ -13122,12 +13149,31 @@ */ static int NsfCreateObjectSystemCmd(Tcl_Interp *interp, Tcl_Obj *Object, Tcl_Obj *Class, Tcl_Obj *systemMethodsObj) { - NsfClass *theobj; - NsfClass *thecls; + NsfClass *theobj = NULL, *thecls = NULL; + Tcl_Obj *object, *class; + char *objectName = ObjStr(Object); + char *className = ObjStr(Class); NsfObjectSystem *osPtr = NEW(NsfObjectSystem); memset(osPtr, 0, sizeof(NsfObjectSystem)); + object = isAbsolutePath(objectName) ? Object : + NameInNamespaceObj(interp, objectName, CallingNameSpace(interp)); + class = isAbsolutePath(className) ? Class : + NameInNamespaceObj(interp, className, CallingNameSpace(interp)); + + GetClassFromObj(interp, object, &theobj, NULL); + GetClassFromObj(interp, class, &thecls, NULL); + if (theobj || thecls) { + + ObjectSystemFree(interp, osPtr); + if (RUNTIME_STATE(interp)->debugLevel > 0) { + fprintf(stderr, "Warning: Base class exists already; ignoring definition.\n"); + } + return TCL_OK; + /* fprintf(stderr, "CreateObjectSystem created base classes \n"); */ + } + if (systemMethodsObj) { int oc, i, idx, result; Tcl_Obj **ov; @@ -13159,18 +13205,10 @@ the basic metaclass Class, and store them in the RUNTIME STATE if successful */ - {Tcl_Obj *object, *class; - char *objectName = ObjStr(Object); - char *className = ObjStr(Class); - object = isAbsolutePath(objectName) ? Object : - NameInNamespaceObj(interp, objectName, CallingNameSpace(interp)); - class = isAbsolutePath(className) ? Class : - NameInNamespaceObj(interp, className, CallingNameSpace(interp)); - - theobj = PrimitiveCCreate(interp, object, NULL, NULL); - thecls = PrimitiveCCreate(interp, class, NULL, NULL); + theobj = PrimitiveCCreate(interp, object, NULL, NULL); + thecls = PrimitiveCCreate(interp, class, NULL, NULL); /* fprintf(stderr, "CreateObjectSystem created base classes \n"); */ - } + #if defined(NSF_PROFILE) NsfProfileInit(interp); #endif @@ -13425,7 +13463,7 @@ {-argName "-default" -nrargs 1 -type tclobj} {-argName "-earlybinding"} {-argName "-methodprefix" -nrargs 1 -type tclobj} - {-argName "-objscope"} + {-argName "-objframe"} {-argName "-onerror" -nrargs 1 -type tclobj} {-argName "-verbose"} {-argName "target" -type tclobj} @@ -13437,14 +13475,14 @@ NsfObject *object, int withPer_object, Tcl_Obj *methodObj, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, + int withObjframe, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { ForwardCmdClientData *tcd = NULL; int result; result = ForwardProcessOptions(interp, methodObj, withDefault, withEarlybinding, withMethodprefix, - withObjscope, withOnerror, withVerbose, + withObjframe, withOnerror, withVerbose, target, nobjc, nobjv, &tcd); if (result == TCL_OK) { CONST char *methodName = NSTail(ObjStr(methodObj)); @@ -13467,7 +13505,7 @@ } } - if (result != TCL_OK) { + if (result != TCL_OK && tcd) { ForwardCmdDeleteProc((ClientData)tcd); } return result; @@ -15022,18 +15060,26 @@ continue; } -#if 0 /* previous code to handle relations */ if (paramPtr->converter == ConvertToRelation) { ClientData relIdx; Tcl_Obj *relationObj = paramPtr->converterArg ? paramPtr->converterArg : paramPtr->nameObj, *outObjPtr; - + CallFrame *varFramePtr = Tcl_Interp_varFramePtr(interp); + + /* + * Execute relation cmd in the context above the object frame, + * since the object frame changes the current namespace as + * well. References to classes with implicit namespaces might + * fail otherwise. + */ + Tcl_Interp_varFramePtr(interp) = varFramePtr->callerPtr; result = ConvertToRelationtype(interp, relationObj, paramPtr, &relIdx, &outObjPtr); if (result == TCL_OK) { result = NsfRelationCmd(interp, object, PTR2INT(relIdx), newValue); } + Tcl_Interp_varFramePtr(interp) = varFramePtr; if (result != TCL_OK) { Nsf_PopFrameObj(interp, framePtr); @@ -15043,27 +15089,22 @@ /* done with relation handling */ continue; } -#else - if (paramPtr->converter == ConvertToRelation) { - continue; - } -#endif /* special setter for init commands */ if (paramPtr->flags & (NSF_ARG_INITCMD|NSF_ARG_METHOD)) { CallFrame *varFramePtr = Tcl_Interp_varFramePtr(interp); NsfCallStackContent csc, *cscPtr = &csc; CallFrame frame2, *framePtr2 = &frame2; - /* The current callframe of configure uses an objscope, such + /* The current callframe of configure uses an objframe, such that setvar etc. are able to access variables like "a" as a local variable. However, in the init block, we do not like that behavior, since this should look like like a proc body. So we push yet another callframe without providing the varframe. The new frame will have the namespace of the caller to avoid - the current objscope. Nsf_PushFrameCsc() will establish + the current objframe. Nsf_PushFrameCsc() will establish a CMETHOD frame. */ @@ -15141,39 +15182,8 @@ remainingArgsc = pc.objc - paramDefs->nrParams; /* - * Perform relation handling outsite of the Object-Frame + * Call residualargs when we have varargs and left over arguments */ - for (i=1, paramPtr = paramDefs->paramsPtr; paramPtr->name; paramPtr++, i++) { - ClientData relIdx; - Tcl_Obj *relationObj, *outObjPtr; - - if (paramPtr->converter != ConvertToRelation) { - /* just handle relations here */ - continue; - } - - newValue = pc.full_objv[i]; - if (newValue == NsfGlobalObjs[NSF___UNKNOWN__]) { - /* nothing to do here */ - continue; - } - - relationObj = paramPtr->converterArg ? paramPtr->converterArg : paramPtr->nameObj; - result = ConvertToRelationtype(interp, relationObj, paramPtr, &relIdx, &outObjPtr); - if (result == TCL_OK) { - result = NsfRelationCmd(interp, object, PTR2INT(relIdx), newValue); - } - - if (result != TCL_OK) { - ParseContextRelease(&pc); - goto configure_exit; - } - } - - - /* - Call residualargs when we have varargs and left over arguments - */ if (pc.varArgs && remainingArgsc > 0) { Tcl_Obj *methodObj; @@ -15718,7 +15728,7 @@ } else { parentNsPtr = CallingNameSpace(interp); nameObj = tmpName = NameInNamespaceObj(interp, nameString, parentNsPtr); - if (strchr(nameString, ':')>0) { + if (strchr(nameString, ':') > 0) { parentNsPtr = NULL; } INCR_REF_COUNT(tmpName); @@ -17100,7 +17110,7 @@ */ if (object->refCount != 1) { if (RUNTIME_STATE(interp)->debugLevel > 0) { - fprintf(stderr, "*** have to fix refcount for obj %p refcount %d",object, object->refCount); + fprintf(stderr, "Warning: have to fix refcount for obj %p refcount %d",object, object->refCount); if (object->refCount > 1) { fprintf(stderr, " (name %s)", objectName(object)); } Index: generic/tclAPI.h =================================================================== diff -u -rf1b65a9694a721be01a9a2acaff5ee093456b2bd -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- generic/tclAPI.h (.../tclAPI.h) (revision f1b65a9694a721be01a9a2acaff5ee093456b2bd) +++ generic/tclAPI.h (.../tclAPI.h) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -301,7 +301,7 @@ static int NsfDispatchCmd(Tcl_Interp *interp, NsfObject *object, int withFrame, Tcl_Obj *command, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfExistsVarCmd(Tcl_Interp *interp, NsfObject *object, CONST char *varname); static int NsfFinalizeObjCmd(Tcl_Interp *interp); -static int NsfForwardCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); +static int NsfForwardCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjframe, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfImportvarCmd(Tcl_Interp *interp, NsfObject *object, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfInterpObjCmd(Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[]); static int NsfInvalidateObjectParameterCmd(Tcl_Interp *interp, NsfClass *class); @@ -1083,13 +1083,13 @@ Tcl_Obj *withDefault = (Tcl_Obj *)pc.clientData[3]; int withEarlybinding = (int )PTR2INT(pc.clientData[4]); Tcl_Obj *withMethodprefix = (Tcl_Obj *)pc.clientData[5]; - int withObjscope = (int )PTR2INT(pc.clientData[6]); + int withObjframe = (int )PTR2INT(pc.clientData[6]); Tcl_Obj *withOnerror = (Tcl_Obj *)pc.clientData[7]; int withVerbose = (int )PTR2INT(pc.clientData[8]); Tcl_Obj *target = (Tcl_Obj *)pc.clientData[9]; assert(pc.status == 0); - return NsfForwardCmd(interp, object, withPer_object, method, withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, objc-pc.lastobjc, objv+pc.lastobjc); + return NsfForwardCmd(interp, object, withPer_object, method, withDefault, withEarlybinding, withMethodprefix, withObjframe, withOnerror, withVerbose, target, objc-pc.lastobjc, objv+pc.lastobjc); } } @@ -2171,7 +2171,7 @@ {"-default", 0, 1, ConvertToTclobj}, {"-earlybinding", 0, 0, ConvertToString}, {"-methodprefix", 0, 1, ConvertToTclobj}, - {"-objscope", 0, 0, ConvertToString}, + {"-objframe", 0, 0, ConvertToString}, {"-onerror", 0, 1, ConvertToTclobj}, {"-verbose", 0, 0, ConvertToString}, {"target", 0, 0, ConvertToTclobj}, Index: library/nx/nx.tcl =================================================================== diff -u -r96716c484bb18d390fef1eecdca764b56121dc4d -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- library/nx/nx.tcl (.../nx.tcl) (revision 96716c484bb18d390fef1eecdca764b56121dc4d) +++ library/nx/nx.tcl (.../nx.tcl) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -6,8 +6,9 @@ # By setting the variable bootstrap, we can check later, whether we # are in bootstrapping mode # - set bootstrap 1 + set ::nsf::bootstrap ::nx + puts stderr ====[::nsf::configure objectsystem] # # First create the ::nx object system. # @@ -503,6 +504,8 @@ foreach m [::nsf::dispatch ::nx::Object::slot::__info ::nsf::methods::object::info::methods] { if {[::nsf::dispatch ::nx::Object::slot::__info ::nsf::methods::object::info::method type $m] eq "object"} continue set definition [::nsf::dispatch ::nx::Object::slot::__info ::nsf::methods::object::info::method definition $m] + # The following line is just for the redefinition case, after a "package forget" + if {[lindex $definition 2] eq "method"} continue ::nx::Class::slot::__info {*}[lrange $definition 1 end] unset definition } @@ -1561,7 +1564,7 @@ set ::nx::confdir ~/.nx set ::nx::logdir $::nx::confdir/log - unset bootstrap + unset ::nsf::bootstrap } if {[::nsf::configure debug] > 1} { foreach ns {::nsf ::nx} { Index: library/serialize/serializer.tcl =================================================================== diff -u -ref1f9efa0bc697404c0aa5322bbd5cc2d7796c2c -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- library/serialize/serializer.tcl (.../serializer.tcl) (revision ef1f9efa0bc697404c0aa5322bbd5cc2d7796c2c) +++ library/serialize/serializer.tcl (.../serializer.tcl) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -371,7 +371,10 @@ set r [subst { set ::nsf::__filterstate \[::nsf::configure filter off\] #::nx::Slot mixin add ::nx::Slot::Nocheck - ::nsf::configure softrecreate [::nsf::configure softrecreate] + + foreach option {debug softrecreate keepinitcmd checkresults checkarguments} { + ::nsf::configure $option [::nsf::configure $option] + } ::nsf::exithandler set [list [::nsf::exithandler get]] }]\n :resetPattern Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r52107aa7990f04b8e2a330ff45c70c2f9de272e7 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 52107aa7990f04b8e2a330ff45c70c2f9de272e7) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -11,6 +11,8 @@ set ::xotcl::version 2.0 set ::xotcl::patchlevel .0 + set ::nsf::bootstrap ::xotcl + # # Perform the basic setup of XOTcl. First, let us allocate the # basic classes of XOTcl. This call creates the classes @@ -269,9 +271,51 @@ } # define forward methods - ::nsf::forward Object forward ::nsf::forward %self -per-object - ::nsf::forward Class instforward ::nsf::forward %self + # + # We could nearly define forward via forwarder + # + # ::nsf::forward Object forward ::nsf::forward %self -per-object + # ::nsf::forward Class instforward ::nsf::forward %self + # + # but since we changed the name of -objscope in nsf to -objframe, we + # have to provide the definition the hard way via methods. + + Object instproc forward { + method + -default -earlybinding:switch -methodprefix -objscope:switch -onerror -verbose:switch + target:optional args + } { + set arglist [list] + if {[info exists default]} {lappend arglist -default $default} + if {$earlybinding} {lappend arglist "-earlybinding"} + if {[info exists methodprefix]} {lappend arglist -methodprefix $methodprefix} + if {$objscope} {lappend arglist "-objframe"} + if {[info exists onerror]} {lappend arglist -onerror $onerror} + if {$verbose} {lappend arglist -verbose} + if {[info exists target]} {lappend arglist $target} + if {[llength $args] > 0} {lappend arglist {*}$args} + set r [::nsf::forward [self] -per-object $method {*}$arglist] + return $r + } + Class instproc instforward { + method + -default -earlybinding:switch -methodprefix -objscope:switch -onerror -verbose:switch + target:optional args + } { + set arglist [list] + if {[info exists default]} {lappend arglist -default $default} + if {$earlybinding} {lappend arglist "-earlybinding"} + if {[info exists methodprefix]} {lappend arglist -methodprefix $methodprefix} + if {$objscope} {lappend arglist "-objframe"} + if {[info exists onerror]} {lappend arglist -onerror $onerror} + if {$verbose} {lappend arglist -verbose} + if {[info exists target]} {lappend arglist $target} + if {[llength $args] > 0} {lappend arglist {*}$args} + set r [::nsf::forward [self] $method {*}$arglist] + return $r + } + Class instproc unknown {args} { #puts stderr "use '[self] create $args', not '[self] $args'" uplevel [list [self] create {*}$args] @@ -451,6 +495,20 @@ error "procedure \"$method\" doesn't have an argument \"$varName\"" } + proc ::xotcl::info_forward_options {list} { + set result [list] + set i 0 + foreach w $list { + switch -glob -- $w { + -objframe {lappend result -objscope} + -* {lappend result $w} + default {lappend result {*}[lrange $list $i end]} + } + incr i + } + return $result + } + # define temporary method "alias" Object instproc alias {name cmd} {::nsf::alias [self] $name $cmd} @@ -547,8 +605,15 @@ } :alias instfilter ::nsf::methods::class::info::filtermethods :alias instfilterguard ::nsf::methods::class::info::filterguard - :alias instforward ::nsf::methods::class::info::forward - + #:alias instforward ::nsf::methods::class::info::forward + :proc instforward {-definition:switch name:optional} { + if {$definition} { + set def [my ::nsf::methods::class::info::forward -definition $name] + return [::xotcl::info_forward_options $def] + } else { + return [my ::nsf::methods::class::info::forward [self args]] + } + } :proc instinvar {} {::nsf::assertion [self] class-invar} :alias instmixin ::nsf::methods::class::info::mixinclasses :alias instmixinguard ::nsf::methods::class::info::mixinguard @@ -961,6 +1026,7 @@ } unset -nocomplain cmd + unset ::nsf::bootstrap # Documentation stub object -> just ignore per default. # if xoDoc is loaded, documentation will be activated Index: library/xotcl/tests/slottest.xotcl =================================================================== diff -u -r1b583476882fea7df04664f551cf87d99c8a0da0 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 1b583476882fea7df04664f551cf87d99c8a0da0) +++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -193,11 +193,13 @@ ::nsf::alias o1 Set -frame object ::set ? {o1 Set i 1} 1 "aliased object tcl set" ? {o1 Set i} 1 "aliased object tcl set" + ::xotcl::Object instforward SSet -earlybinding -objscope ::set ? {o1 SSet i 1} 1 "forward earlybinding tcl set" ? {o1 SSet i} 1 "forward earlybinding tcl set" -#exit +? {::xotcl::Object info instforward -definition SSet} "-earlybinding -objscope ::set" + o1 set z 100 #o1 forward z o1 [list %argclindex [list set set]] %proc #o1 proc get name {my set $name} Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -r1b583476882fea7df04664f551cf87d99c8a0da0 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 1b583476882fea7df04664f551cf87d99c8a0da0) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -3155,13 +3155,13 @@ ::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 hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc proc procsearch self setFilter signature unknown" "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" "b info methods -nocmds" - ::errorCheck [lsort [b info methods -noprocs]] "append array autoname class cleanup configure destroy eval exists filter filterguard forward incr info instvar invar lappend mixin mixinguard noinit parametercmd requireNamespace residualargs set subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" - ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract check extractConfigureArg f filtersearch hasclass init isclass ismetaclass ismixin isobject istype method myProc myProc2 objectparameter objproc proc procsearch self setFilter signature unknown" "b info methods -nocmds -nomixins" + ::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 vwait" "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 objectparameter objproc proc procsearch self setFilter signature unknown" "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 hasclass init instproc isclass ismetaclass ismixin isobject istype method objectparameter proc procsearch self setFilter signature unknown uses" "B info methods -nocmds" + ::errorCheck [lsort [B info methods -nocmds]] "abstract allinstances check extractConfigureArg f filtersearch forward hasclass init instforward instproc isclass ismetaclass ismixin isobject istype method objectparameter proc procsearch self setFilter signature unknown uses" "B info methods -nocmds" namespace eval a { proc o args {return o} Index: tests/contains.test =================================================================== diff -u -r5fa3584b0f682d4103c39af82357713871f1de0c -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/contains.test (.../contains.test) (revision 5fa3584b0f682d4103c39af82357713871f1de0c) +++ tests/contains.test (.../contains.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -2,9 +2,8 @@ package require nx namespace path nx -# Don't use test, since test and contains redefines new, -# so we ahe a conflict.... -#package require nx::test +# Don't use test, since both, package test and contains redefine "new", +# so we have a conflict.... proc ? {cmd expected {msg ""}} { #puts "??? $cmd" @@ -51,4 +50,30 @@ Tree create 1.3 -label 1.3 }] +namespace path "" + +# Test resolving of implicit namespaces in relationcmds (here +# superclass) in the nx namespace. +namespace eval ::nx { + + #puts stderr =====1 + set c [Class create C -superclass Class { + :class-object method foo {} {;} + }] + ? {set c} ::C + + # recreate + set c [Class create C -superclass Class ] + ? {set c} ::C + #puts stderr =====3 +} + + +package forget nx +package req nx + +package require XOTcl +package forget XOTcl +package require XOTcl + puts stderr ===EXIT \ No newline at end of file Index: tests/forward.test =================================================================== diff -u -r8bfe3ac01fe62c1917587fc5fe76952d3ff8f397 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/forward.test (.../forward.test) (revision 8bfe3ac01fe62c1917587fc5fe76952d3ff8f397) +++ tests/forward.test (.../forward.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -22,7 +22,7 @@ Test case inscope { Class create X { :attribute {x 1} - :public forward Incr -objscope incr + :public forward Incr -objframe incr } X create x1 -x 100 @@ -113,7 +113,7 @@ Test case incr { Object create obj { set :x 1 - :public forward i1 -objscope incr x + :public forward i1 -objframe incr x } ? {obj i1} 2 @@ -143,7 +143,7 @@ # check introspection for objects Object create obj { - :public forward i1 -objscope incr x + :public forward i1 -objframe incr x :public forward Mixin mixin %1 %self :public forward foo target %proc %self %%self %%p :public forward addOne expr 1 + @@ -153,7 +153,7 @@ ? {obj info method definition Mixin} "::obj public forward Mixin mixin %1 %self" ? {obj info method definition addOne} "::obj public forward addOne expr 1 +" ? {obj info method definition foo} "::obj public forward foo target %proc %self %%self %%p" - ? {obj info method definition i1} "::obj public forward i1 -objscope ::incr x" + ? {obj info method definition i1} "::obj public forward i1 -objframe ::incr x" } ########################################### @@ -176,7 +176,7 @@ Test case optional-target { Object create obj { set :x 2 - :public forward append -objscope + :public forward append -objframe } ? {obj append x y z} 2yz @@ -361,7 +361,7 @@ # forward to expr + callstack ########################################### Test case callstack { - Object public forward expr -objscope + Object public forward expr -objframe Class create C { :method xx {} {current} Index: tests/method-modifiers.test =================================================================== diff -u -rf39b258e182cd2c9df32890902ef89490e0d77d8 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/method-modifiers.test (.../method-modifiers.test) (revision f39b258e182cd2c9df32890902ef89490e0d77d8) +++ tests/method-modifiers.test (.../method-modifiers.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -204,12 +204,11 @@ :class-object mixin add M4 } - # FIXME - #? {lsort [C class-object info mixin classes]} "::M2 ::M4" - ? {lsort [C class-object info mixin classes]} "::M2" - # FIXME - #? {lsort [C info mixin classes]} "::M1 ::M3" - ? {lsort [C info mixin classes]} "::M1" + ? {lsort [C class-object info mixin classes]} "::M2 ::M4" + #? {lsort [C class-object info mixin classes]} "::M2" + + ? {lsort [C info mixin classes]} "::M1 ::M3" + #? {lsort [C info mixin classes]} "::M1" C destroy M1 destroy; M2 destroy; M3 destroy; M4 destroy; } Index: tests/object-system.test =================================================================== diff -u -r84c5ee62a46e8fab7b9cc481c87290d387baced9 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/object-system.test (.../object-system.test) (revision 84c5ee62a46e8fab7b9cc481c87290d387baced9) +++ tests/object-system.test (.../object-system.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -17,6 +17,8 @@ } } +? {::nsf::configure objectsystem} "{::nx::Object ::nx::Class {-class.alloc alloc -class.create create -class.dealloc dealloc -class.recreate recreate -class.requireobject __unknown -object.configure configure -object.defaultmethod defaultmethod -object.destroy destroy -object.init init -object.move move -object.objectparameter objectparameter -object.residualargs residualargs -object.unknown unknown}}" + ? {::nsf::isobject Object} 1 ? {::nsf::is class Object} 1 ? {::nsf::is metaclass Object} 0 Index: tests/parameters.test =================================================================== diff -u -r96716c484bb18d390fef1eecdca764b56121dc4d -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/parameters.test (.../parameters.test) (revision 96716c484bb18d390fef1eecdca764b56121dc4d) +++ tests/parameters.test (.../parameters.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -566,7 +566,7 @@ "query instparams for scripted method 'method'" ? {Object info method parameter ::nsf::forward} \ - "object -per-object method -default -earlybinding -methodprefix -objscope -onerror -verbose target:optional args" \ + "object -per-object method -default -earlybinding -methodprefix -objframe -onerror -verbose target:optional args" \ "query parameter for C-defined cmd 'nsf::forward'" Object require method autoname Index: tests/protected.test =================================================================== diff -u -r84c5ee62a46e8fab7b9cc481c87290d387baced9 -rfc4e3f5f6a94ef7324baffab90d58cd7eb513907 --- tests/protected.test (.../protected.test) (revision 84c5ee62a46e8fab7b9cc481c87290d387baced9) +++ tests/protected.test (.../protected.test) (revision fc4e3f5f6a94ef7324baffab90d58cd7eb513907) @@ -76,27 +76,27 @@ ? {::nsf::methodproperty C SET redefine-protected true} 1 ? {catch {C method SET {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!} + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} ? {::nsf::methodproperty C foo redefine-protected true} 1 ? {catch {C method foo {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'foo' of ::C can not be overwritten. Derive e.g. a sub-class!} + {Method 'foo' of ::C cannot be overwritten. Derive e.g. a sub-class!} # check a predefined protection ? {catch {::nx::Class method dealloc {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'dealloc' of ::nx::Class can not be overwritten. Derive e.g. a sub-class!} + {Method 'dealloc' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} # try to redefined via alias ? {catch {::nsf::alias Class dealloc ::set} errorMsg; set errorMsg} \ - {Method 'dealloc' of ::nx::Class can not be overwritten. Derive e.g. a sub-class!} + {Method 'dealloc' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} # try to redefine via forward ? {catch {C forward SET ::set} errorMsg; set errorMsg} \ - {Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!} + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} # try to redefine via setter ? {catch {C setter SET} errorMsg; set errorMsg} \ - {Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!} + {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} # overwrite-protect object specific method Object create o o method foo {} {return 13} ::nsf::methodproperty o foo redefine-protected true ? {catch {o method foo {} {return 14}} errorMsg; set errorMsg} \ - {Method 'foo' of ::o can not be overwritten. Derive e.g. a sub-class!} + {Method 'foo' of ::o cannot be overwritten. Derive e.g. a sub-class!}