Index: TODO =================================================================== diff -u -r9fa2b6fcc1348e36c652d68e06077c43fd14d92b -r3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a --- TODO (.../TODO) (revision 9fa2b6fcc1348e36c652d68e06077c43fd14d92b) +++ TODO (.../TODO) (revision 3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a) @@ -2097,6 +2097,13 @@ in next) - extended regression test +- Experimental Object-System specific resolver in method bodies + (allows resolving to the "right" next, self, etc. without + namespace imports/paths) +- deactivated automatic namespace path copying for child-objects +- extended regression test + + TODO: - info method definition for attributes? Index: generic/nsf.c =================================================================== diff -u -ra186ae065e3998c2394dd5afd9a882a9b1ff3414 -r3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a --- generic/nsf.c (.../nsf.c) (revision a186ae065e3998c2394dd5afd9a882a9b1ff3414) +++ generic/nsf.c (.../nsf.c) (revision 3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a) @@ -2679,40 +2679,107 @@ /*fprintf(stderr, "InterpColonCmdResolver %s flags %.6x\n", cmdName, flags);*/ - if (!FOR_COLON_RESOLVER(cmdName) || flags & TCL_GLOBAL_ONLY) { - /* ordinary names and global lookups are not for us */ + if ((*cmdName == ':' && *(cmdName + 1) == ':') || flags & TCL_GLOBAL_ONLY) { + /* fully qualified names and global lookups are not for us */ return TCL_CONTINUE; } varFramePtr = Tcl_Interp_varFramePtr(interp); frameFlags = Tcl_CallFrame_isProcCallFrame(varFramePtr); -#if 0 - /* skip over a nonproc frame, in case Tcl stacks it */ - if (frameFlags == 0 && Tcl_CallFrame_callerPtr(varFramePtr)) { + /*fprintf(stderr, "InterpColonCmdResolver frame cmdName %s flags %.6x, frame flags %.6x lambda %d\n", + cmdName, flags, frameFlags, frameFlags & FRAME_IS_LAMBDA);*/ + + /* + * If the resolver is called from a lambda frame, use always the parent frame + */ + if ((frameFlags & FRAME_IS_LAMBDA)) { varFramePtr = (CallFrame *)Tcl_CallFrame_callerPtr(varFramePtr); frameFlags = Tcl_CallFrame_isProcCallFrame(varFramePtr); + } + + /* + * The resolver is called as well, when a body of a method is + * compiled. In these situations, Tcl stacks a nonproc frame, that + * we have to skip. In order to safely identify such situations, we + * stuff into the call flags of the proc frame during the + * compilation step NSF_CSC_CALL_IS_COMPILE. + */ + if (frameFlags == 0 && Tcl_CallFrame_callerPtr(varFramePtr)) { + varFramePtr = (CallFrame *)Tcl_CallFrame_callerPtr(varFramePtr); + frameFlags = Tcl_CallFrame_isProcCallFrame(varFramePtr); + + if ((frameFlags & (FRAME_IS_NSF_METHOD)) == 0 + || (((NsfCallStackContent *)varFramePtr->clientData)->flags & NSF_CSC_CALL_IS_COMPILE) == 0 + ) { + frameFlags = 0; + } else { #if defined(CMD_RESOLVER_TRACE) - fprintf(stderr, "InterpColonCmdResolver uses parent frame\n"); + fprintf(stderr, "InterpColonCmdResolver got parent frame cmdName %s flags %.6x, frame flags %.6x\n", + cmdName, flags, Tcl_CallFrame_isProcCallFrame(varFramePtr)); #endif - } -#endif + } + } #if defined(CMD_RESOLVER_TRACE) - fprintf(stderr, "InterpColonCmdResolver cmdName %s flags %.6x, frame flags %.6x\n",cmdName, - flags, Tcl_CallFrame_isProcCallFrame(varFramePtr)); + fprintf(stderr, "InterpColonCmdResolver cmdName %s flags %.6x, frame flags %.6x\n", + cmdName, flags, Tcl_CallFrame_isProcCallFrame(varFramePtr)); #endif if (frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_OBJECT|FRAME_IS_NSF_CMETHOD )) { + if (*cmdName == ':') { #if defined(CMD_RESOLVER_TRACE) - fprintf(stderr, " ... call colonCmd for %s\n", cmdName); + fprintf(stderr, " ... call colonCmd for %s\n", cmdName); #endif - /* - * We have a cmd starting with ':', we are in an nsf frame, so - * forward to the colonCmd. - */ - *cmdPtr = RUNTIME_STATE(interp)->colonCmd; - return TCL_OK; + /* + * We have a cmd starting with ':', we are in an nsf frame, so + * forward to the colonCmd. + */ + *cmdPtr = RUNTIME_STATE(interp)->colonCmd; + return TCL_OK; + } else { + //xxxxx +#if 1 + /* + * Experimental Object-System specific resolver: If an + * unprefixed method name is found in a body of a method, we try + * to perform a lookup for this method in the namespace of the + * object system for the current object. If this lookup is not + * successful the standard lookups are performed. The + * object-system specific resolver allows to use the "right" + * (unprefixed) "self" or "next" calls without namespace + * imports. + */ + NsfObject *object; + NsfObjectSystem *osPtr; + Tcl_Command cmd; + Tcl_HashTable *cmdTablePtr; + Tcl_HashEntry *entryPtr; + + if (frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) { + object = ((NsfCallStackContent *)varFramePtr->clientData)->self; + } else if (frameFlags & (FRAME_IS_NSF_OBJECT)) { + object = (NsfObject *)(varFramePtr->clientData); + } else { + object = NULL; + } + if (object) { + //xxx + osPtr = GetObjectSystem(object); + cmd = osPtr->rootClass->object.id; + cmdTablePtr = Tcl_Namespace_cmdTablePtr(((Command *)cmd)->nsPtr); + entryPtr = Tcl_CreateHashEntry(cmdTablePtr, cmdName, NULL); + /* fprintf(stderr, "InterpColonCmdResolver OS specific resolver tried to lookup %s for os %s in ns %s\n", + cmdName, ClassName(osPtr->rootClass), ((Command *)cmd)->nsPtr->fullName);*/ + if (entryPtr) { + /*fprintf(stderr, "InterpColonCmdResolver OS specific resolver found %s::%s\n", + ((Command *)cmd)->nsPtr->fullName, cmdName);*/ + *cmdPtr = Tcl_GetHashValue(entryPtr); + return TCL_OK; + } + } +#endif + } } #if defined(CMD_RESOLVER_TRACE) @@ -2755,7 +2822,8 @@ Tcl_SetNamespaceResolvers(nsPtr, /*(Tcl_ResolveCmdProc*)NsColonCmdResolver*/ NULL, NsColonVarResolver, /*(Tcl_ResolveCompiledVarProc*)NsCompiledColonVarResolver*/NULL); -#if 1 +#if 0 + //xxxxx namespace path management /* * In case there is a namespace path set for the parent namespace, * apply this as well to the object namespace to avoid surprises @@ -6375,9 +6443,10 @@ } static int -ByteCompiled(register Tcl_Interp *interp, Proc *procPtr, CONST char *body) { +ByteCompiled(Tcl_Interp *interp, unsigned short *cscFlagsPtr, Proc *procPtr, CONST char *body) { Tcl_Obj *bodyPtr = procPtr->bodyPtr; Namespace *nsPtr = procPtr->cmdPtr->nsPtr; + int result; if (bodyPtr->typePtr == Nsf_OT_byteCodeType) { # if defined(HAVE_TCL_COMPILE_H) @@ -6398,7 +6467,7 @@ || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch)) { - + goto doCompilation; } return TCL_OK; @@ -6408,9 +6477,12 @@ # if defined(HAVE_TCL_COMPILE_H) doCompilation: # endif - return TclProcCompileProc(interp, procPtr, bodyPtr, + *cscFlagsPtr |= NSF_CSC_CALL_IS_COMPILE; + result = TclProcCompileProc(interp, procPtr, bodyPtr, (Namespace *) nsPtr, "body of proc", body); + *cscFlagsPtr &= ~NSF_CSC_CALL_IS_COMPILE; + return result; } } @@ -6458,7 +6530,7 @@ framePtr->objv = objv; framePtr->procPtr = procPtr; framePtr->clientData = cscPtr; - return ByteCompiled(interp, procPtr, TclGetString(objv[0])); + return ByteCompiled(interp, &cscPtr->flags, procPtr, TclGetString(objv[0])); } static void Index: generic/nsfInt.h =================================================================== diff -u -rf0295d889aaf71709c63243685897dc3f11048f1 -r3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a --- generic/nsfInt.h (.../nsfInt.h) (revision f0295d889aaf71709c63243685897dc3f11048f1) +++ generic/nsfInt.h (.../nsfInt.h) (revision 3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a) @@ -650,6 +650,7 @@ #define NSF_CSC_CALL_IS_NEXT 1 #define NSF_CSC_CALL_IS_GUARD 2 #define NSF_CSC_CALL_IS_ENSEMBLE 4 +#define NSF_CSC_CALL_IS_COMPILE 8 #define NSF_CSC_IMMEDIATE 0x0020 #define NSF_CSC_FORCE_FRAME 0x0040 #define NSF_CSC_CALL_IS_NRE 0x0100 Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -rb0d97485503d32672dd3691131ce51bdf3923881 -r3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision b0d97485503d32672dd3691131ce51bdf3923881) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a) @@ -53,7 +53,7 @@ #namespace import ::nx::Attribute # if we do this, "::xotcl::Class create Role -superclass Attribute" will fail. #interp alias {} ::xotcl::Attribute {} ::nx::Attribute - ::nx::Class create ::xotcl::Attribute -superclass ::nx::Attribute + ::nx::MetaSlot create ::xotcl::Attribute -superclass ::nx::Attribute proc ::xotcl::self {{arg ""}} { switch $arg { @@ -68,7 +68,7 @@ # @object ::xotcl::Object # - # Xotcl programs are constructed out of objects. This class + # XOTcl programs are constructed out of objects. This class # describes common structural and behavioural features for all XOTcl # objects. It is the root object-class in the XOTcl 2 object system. Index: tests/contains.test =================================================================== diff -u -rfa93101c8752ada9299561f075b61c2e6144e3f5 -r3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a --- tests/contains.test (.../contains.test) (revision fa93101c8752ada9299561f075b61c2e6144e3f5) +++ tests/contains.test (.../contains.test) (revision 3d4cb79342d1f74cdcc39d6d8b87e9c475f2706a) @@ -50,10 +50,27 @@ Tree create 1.3 -label 1.3 }] + + +# +# Test resolving next without namespace import/path +# namespace path "" +# make sure, we have no next defined +? {info command ::next} "" +nx::Class create C { + :public method foo {} {puts "call next";next}; + :create c1 +} +? {c1 foo} "" +? {c1 foo} "" + + # Test resolving of implicit namespaces in relationcmds (here # superclass) in the nx namespace. +namespace path "" + namespace eval ::nx { #puts stderr =====1