Index: TODO =================================================================== diff -u -r2ca66aec9ed16d36076d6b9c959642ee13d08647 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- TODO (.../TODO) (revision 2ca66aec9ed16d36076d6b9c959642ee13d08647) +++ TODO (.../TODO) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -2193,6 +2193,12 @@ of the same object system - add regression test +- removed c-implementation of method vwait, it was replaced + by "vwait :varName". We had to allow flag TCL_GLOBAL_ONLY + in InterpColonVarResolver(), since Tcl vwait implementation + calls it with that flag. +- added a scripted implementation for vwait in xotcl2 + TODO: - doc: NextScriptingLanguage/index.html: @@ -2223,7 +2229,6 @@ - do we need contains in nx? -- do we need vwait in nx? Plain Tcl "vwait :varName" should do it. - are the oneline hook definitions like Class protected class-object method __unknown {name} {} needed? Index: generic/gentclAPI.decls =================================================================== diff -u -rdb9cc86bb6df8dadf59f951a504c908fb8d14ef0 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision db9cc86bb6df8dadf59f951a504c908fb8d14ef0) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -214,9 +214,9 @@ objectMethod volatile NsfOVolatileMethod { } -objectMethod vwait NsfOVwaitMethod { - {-argName "varName" -required 1} -} +#objectMethod vwait NsfOVwaitMethod { +# {-argName "varName" -required 1} +#} # # class methods Index: generic/nsf.c =================================================================== diff -u -re979a7fbb725c874f4900258e7537aaf29c0fbae -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- generic/nsf.c (.../nsf.c) (revision e979a7fbb725c874f4900258e7537aaf29c0fbae) +++ generic/nsf.c (.../nsf.c) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -2796,11 +2796,15 @@ Tcl_Obj *keyObj; Tcl_Var var; - if (!FOR_COLON_RESOLVER(varName) || (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))) { + /* + * TCL_GLOBAL_ONLY is removed, since "vwait :varName" is called with + * with this flag. + */ + if (!FOR_COLON_RESOLVER(varName) || (flags & (/*TCL_GLOBAL_ONLY|*/TCL_NAMESPACE_ONLY))) { /* ordinary names and global lookups are not for us */ #if defined(VAR_RESOLVER_TRACE) - fprintf(stderr, "InterpColonVarResolver '%s' flags %.6x not for us nsPtr %p\n", - varName, flags, nsPtr); + fprintf(stderr, "InterpColonVarResolver '%s' flags %.6x not for us\n", + varName, flags); #endif return TCL_CONTINUE; } @@ -3308,22 +3312,6 @@ } } -/* - * ensure that a variable exists on object varTablePtr or nsPtr->varTablePtr, - * if necessary create it. Return Var* if successful, otherwise 0 - */ -static Var * -NSRequireVariableOnObj(Tcl_Interp *interp, NsfObject *object, CONST char *name, int flgs) { - CallFrame frame, *framePtr = &frame; - Var *varPtr, *arrayPtr; - - Nsf_PushFrameObj(interp, object, framePtr); - varPtr = TclLookupVar(interp, name, 0, flgs, "obj vwait", - /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); - Nsf_PopFrameObj(interp, framePtr); - return varPtr; -} - static int Nsf_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command cmd) { CallStackClearCmdReferences(interp, cmd); @@ -12189,7 +12177,23 @@ return result; } +#if NSF_VWAIT /* + * ensure that a variable exists on object varTablePtr or nsPtr->varTablePtr, + * if necessary create it. Return Var* if successful, otherwise 0 + */ +static Var * +NSRequireVariableOnObj(Tcl_Interp *interp, NsfObject *object, CONST char *name, int flgs) { + CallFrame frame, *framePtr = &frame; + Var *varPtr, *arrayPtr; + + Nsf_PushFrameObj(interp, object, framePtr); + varPtr = TclLookupVar(interp, name, 0, flgs, "obj vwait", + /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); + Nsf_PopFrameObj(interp, framePtr); + return varPtr; +} +/* * copied from Tcl, since not exported */ static char * @@ -12205,6 +12209,7 @@ *donePtr = 1; return (char *) NULL; } +#endif static int NsfProcAliasMethod(ClientData clientData, @@ -16983,6 +16988,7 @@ return result; } +#if NSF_VWAIT /* objectMethod vwait NsfOVwaitMethod { {-argName "varname" -required 1} @@ -17031,7 +17037,7 @@ } return TCL_OK; } - +#endif /*************************** * End Object Methods ***************************/ Index: generic/nsf.h =================================================================== diff -u -rf1b7088e41847bcf6e366f8e53cdc33318ea07c4 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- generic/nsf.h (.../nsf.h) (revision f1b7088e41847bcf6e366f8e53cdc33318ea07c4) +++ generic/nsf.h (.../nsf.h) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -111,8 +111,6 @@ #define NRE_CALLBACK_TRACE 1 */ -//#define PARSE_TRACE_FULL 1 - /* * Sanity checks and dependencies for optional compile flags */ Index: generic/tclAPI.h =================================================================== diff -u -r564b282ab8a82850c60b8f0ef8a23a6719fbcc77 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- generic/tclAPI.h (.../tclAPI.h) (revision 564b282ab8a82850c60b8f0ef8a23a6719fbcc77) +++ generic/tclAPI.h (.../tclAPI.h) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -261,7 +261,6 @@ static int NsfOUplevelMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfOUpvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int NsfOVwaitMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoChildrenMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -345,7 +344,6 @@ static int NsfOUplevelMethod(Tcl_Interp *interp, NsfObject *obj, int objc, Tcl_Obj *CONST objv[]); static int NsfOUpvarMethod(Tcl_Interp *interp, NsfObject *obj, int objc, Tcl_Obj *CONST objv[]); static int NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *obj); -static int NsfOVwaitMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *varName); static int NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType, CONST char *pattern); static int NsfObjInfoClassMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfObjInfoFilterguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *fileName); @@ -430,7 +428,6 @@ NsfOUplevelMethodIdx, NsfOUpvarMethodIdx, NsfOVolatileMethodIdx, - NsfOVwaitMethodIdx, NsfObjInfoChildrenMethodIdx, NsfObjInfoClassMethodIdx, NsfObjInfoFilterguardMethodIdx, @@ -1660,25 +1657,6 @@ } static int -NsfOVwaitMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - ParseContext pc; - NsfObject *obj = (NsfObject *)clientData; - if (!obj) return NsfObjErrType(interp, NULL, objv[0], "Object", NULL); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[NsfOVwaitMethodIdx].paramDefs, - method_definitions[NsfOVwaitMethodIdx].nrParameters, 1, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - CONST char *varName = (CONST char *)pc.clientData[0]; - - assert(pc.status == 0); - return NsfOVwaitMethod(interp, obj, varName); - - } -} - -static int NsfObjInfoChildrenMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; NsfObject *obj = (NsfObject *)clientData; @@ -2341,9 +2319,6 @@ {"::nsf::methods::object::volatile", NsfOVolatileMethodStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::methods::object::vwait", NsfOVwaitMethodStub, 1, { - {"varName", NSF_ARG_REQUIRED, 0, ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} -}, {"::nsf::methods::object::info::children", NsfObjInfoChildrenMethodStub, 2, { {"-type", 0, 1, ConvertToClass, NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"pattern", 0, 0, ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r11f46f5e2d22382d2b7f89e2a8e051b2c919de90 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 11f46f5e2d22382d2b7f89e2a8e051b2c919de90) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -212,17 +212,28 @@ # Bar info hasnamespace; # returns 0 # }}} + # provide some Tcl-commands as methods for ::xotcl::Object + foreach cmd {array append eval incr lappend set subst unset trace} { + ::nsf::alias Object $cmd -frame object ::$cmd + } + # @method ::xotcl::Object#vwait # # A method variant of the Tcl {{{vwait}}} command. You can use it to # have the {{{interp}}} enter an event loop until the specified # variable {{{varname}}} is set on the object. # - # @param varname The name of the signalling object variable. + # @param varName The name of the signalling object variable. - # provide some Tcl-commands as methods for ::xotcl::Object - foreach cmd {array append eval incr lappend set subst unset trace} { - ::nsf::alias Object $cmd -frame object ::$cmd + ::nsf::method Object vwait {varName} { + if {[regexp {:[^:]*} $varName]} { + error "invalid varName '$varName'; only plain or fully qualified variable names allowed" + } + if {[string match ::* $varName]} { + ::vwait $varName + } else { + ::vwait :$varName + } } # provide the standard command set for ::xotcl::Class Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -rf0295d889aaf71709c63243685897dc3f11048f1 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision f0295d889aaf71709c63243685897dc3f11048f1) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -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 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 -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 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 [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 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 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 vwait" "B info methods -nocmds" namespace eval a { proc o args {return o} Index: tests/info-method.test =================================================================== diff -u -r2b4d30902f8badbef6b5c128bfdafe91c6d01695 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- tests/info-method.test (.../info-method.test) (revision 2b4d30902f8badbef6b5c128bfdafe91c6d01695) +++ tests/info-method.test (.../info-method.test) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -68,8 +68,8 @@ ? {::nx::Object info lookup methods -source application} "" ? {::nx::Class info lookup methods -source application} "" - set object_methods "alias attribute class configure contains copy destroy eval filter forward info method mixin move protected public require volatile vwait" - set class_methods "alias alloc attribute attributes class class-object configure contains copy create dealloc destroy eval filter forward info method mixin move new protected public require superclass volatile vwait" + set object_methods "alias attribute class configure contains copy destroy eval filter forward info method mixin move protected public require volatile" + set class_methods "alias alloc attribute attributes class class-object configure contains copy create dealloc destroy eval filter forward info method mixin move new protected public require superclass volatile" ? {lsort [::nx::Object info lookup methods -source baseclasses]} $class_methods ? {lsort [::nx::Class info lookup methods -source baseclasses]} $class_methods Index: tests/varresolution.test =================================================================== diff -u -r41e9eeaee026cfb812202269fa27f623d4ec67e1 -r28fd214e129bc6c2384a2ef587a2be8b480c7248 --- tests/varresolution.test (.../varresolution.test) (revision 41e9eeaee026cfb812202269fa27f623d4ec67e1) +++ tests/varresolution.test (.../varresolution.test) (revision 28fd214e129bc6c2384a2ef587a2be8b480c7248) @@ -668,6 +668,40 @@ after 10 {set ::X 1} vwait X +# +# Test vwait with colon variable and vwait method +# +Object create o { + set :x 0 + :public method foo {} {incr :x} + :public method vwait {varName} { + if {[regexp {:[^:]*} $varName]} { + error "invalid varName '$varName'; only plain or fully qualified variable names allowed" + } + if {[string match ::* $varName]} { + ::vwait $varName + } else { + ::vwait :$varName + } + } + # + # Tcl vwait command with instance variable + # + after 10 {o foo} + #puts stderr ===waiting + vwait :x + #puts stderr ===waiting-DONE + # + # vwait method + # + after 10 {o foo} + #puts stderr ===waiting + :vwait x + #puts stderr ===waiting-DONE + ? {o vwait :x} {invalid varName ':x'; only plain or fully qualified variable names allowed} +} +o destroy + ? {set ::C} 0 ? {f1 eval {set :c}} 2