Index: generic/gentclAPI.decls =================================================================== diff -u -rbf9bae94d157de9bbd4c398f6a3a9a4d93626025 -r962c96dcc0ddc25782570a831c104fb2b955891d --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision bf9bae94d157de9bbd4c398f6a3a9a4d93626025) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -63,7 +63,7 @@ } xotclCmd methodproperty XOTclMethodPropertyCmd { {-argName "object" -required 1 -type object} - {-argName "methodName" -required 1} + {-argName "methodName" -required 1 -type tclobj} {-argName "-per-object"} {-argName "methodproperty" -required 1 -type "protected|public|static|slotobj"} {-argName "value" -type tclobj} Index: generic/predefined.h =================================================================== diff -u -ra59ed987404cf38f027209a4e140569c62721bd6 -r962c96dcc0ddc25782570a831c104fb2b955891d --- generic/predefined.h (.../predefined.h) (revision a59ed987404cf38f027209a4e140569c62721bd6) +++ generic/predefined.h (.../predefined.h) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -33,7 +33,6 @@ "set prefix class}\n" "set result [::xotcl::dispatch [self] ::xotcl::cmd::${cls}::$prefix-method \\\n" "$name $arguments $body {*}$conditions]\n" -"puts stderr result=$result\n" "if {$protected} {::xotcl::methodproperty [self] $name protected true}\n" "return $result}\n" "::xotcl::dispatch Object ::xotcl::cmd::Class::class-method method {\n" @@ -44,12 +43,26 @@ "if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n" "set result [::xotcl::dispatch [self] ::xotcl::cmd::Object::object-method \\\n" "$name $arguments $body {*}$conditions]\n" -"puts stderr result=$result\n" "if {$protected} {::xotcl::methodproperty [self] $name -per-object protected true}\n" "return $result}\n" -"Class method unknown {args} {\n" -"puts stderr \"use '[self] create $args', not '[self] $args'\"\n" -"eval my create $args}\n" +"Object method -public public {args} {\n" +"set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]\n" +"if {$p == -1} {error \"$args is not a method defining method\"}\n" +"set r [{*}.$args]\n" +"::xotcl::methodproperty [self] $r protected false\n" +"return $r}\n" +"Object method -public protected {args} {\n" +"set p [lsearch -regexp $args {^(method|alias|forward|setter)$}]\n" +"if {$p == -1} {error \"$args is not a method defining command\"}\n" +"set r [{*}.$args]\n" +"::xotcl::methodproperty [self] $r [self proc] true\n" +"return $r}\n" +"Class method -public object {args} {\n" +"set p [expr {[lsearch -regexp $args {^(method|alias|forward|setter)$}] + 1}]\n" +"set cmd [linsert $args $p \"-per-object\"]\n" +"return [{*}.$cmd]}\n" +"Class method unknown {m args} {\n" +"error \"Method '$m' unknown for [self]. Consider '[self] create $m $args' instead of '[self] $m $args'\"}\n" "Object method unknown {m args} {\n" "if {![self isnext]} {\n" "error \"[self]: unable to dispatch method '$m'\"}}\n" Index: generic/predefined.xotcl =================================================================== diff -u -ra59ed987404cf38f027209a4e140569c62721bd6 -r962c96dcc0ddc25782570a831c104fb2b955891d --- generic/predefined.xotcl (.../predefined.xotcl) (revision a59ed987404cf38f027209a4e140569c62721bd6) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -88,11 +88,37 @@ return $result } - Class method unknown {args} { - puts stderr "use '[self] create $args', not '[self] $args'" - eval my create $args + # define method modifiers "object", "public" and "protected" + Object method -public public {args} { + set p [lsearch -regexp $args {^(method|alias|forward|setter)$}] + if {$p == -1} {error "$args is not a method defining method"} + set r [{*}.$args] + ::xotcl::methodproperty [self] $r protected false + return $r } + Object method -public protected {args} { + set p [lsearch -regexp $args {^(method|alias|forward|setter)$}] + if {$p == -1} {error "$args is not a method defining command"} + set r [{*}.$args] + ::xotcl::methodproperty [self] $r [self proc] true + return $r + } + + Class method -public object {args} { + set p [expr {[lsearch -regexp $args {^(method|alias|forward|setter)$}] + 1}] + set cmd [linsert $args $p "-per-object"] + return [{*}.$cmd] + } + + # + # unknown handlers + # + Class method unknown {m args} { + error "Method '$m' unknown for [self]. Consider '[self] create $m $args' instead of '[self] $m $args'" + #eval my create $args + } + Object method unknown {m args} { if {![self isnext]} { error "[self]: unable to dispatch method '$m'" Index: generic/tclAPI.h =================================================================== diff -u -rbf9bae94d157de9bbd4c398f6a3a9a4d93626025 -r962c96dcc0ddc25782570a831c104fb2b955891d --- generic/tclAPI.h (.../tclAPI.h) (revision bf9bae94d157de9bbd4c398f6a3a9a4d93626025) +++ generic/tclAPI.h (.../tclAPI.h) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -264,7 +264,7 @@ static int XOTclInstvarCmd(Tcl_Interp *interp, XOTclObject *withObject, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclInterpObjCmd(Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[]); static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value); -static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withPer_object, int methodproperty, Tcl_Obj *value); +static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *methodName, int withPer_object, int methodproperty, Tcl_Obj *value); static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclNSCopyCmds(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int XOTclNSCopyVars(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); @@ -1975,7 +1975,7 @@ return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; - char *methodName = (char *)pc.clientData[1]; + Tcl_Obj *methodName = (Tcl_Obj *)pc.clientData[1]; int withPer_object = (int )pc.clientData[2]; int methodproperty = (int )pc.clientData[3]; Tcl_Obj *value = (Tcl_Obj *)pc.clientData[4]; @@ -2459,7 +2459,7 @@ }, {"::xotcl::methodproperty", XOTclMethodPropertyCmdStub, 5, { {"object", 1, 0, convertToObject}, - {"methodName", 1, 0, convertToString}, + {"methodName", 1, 0, convertToTclobj}, {"-per-object", 0, 0, convertToString}, {"methodproperty", 1, 0, convertToMethodproperty}, {"value", 0, 0, convertToTclobj}} Index: generic/xotcl.c =================================================================== diff -u -ra59ed987404cf38f027209a4e140569c62721bd6 -r962c96dcc0ddc25782570a831c104fb2b955891d --- generic/xotcl.c (.../xotcl.c) (revision a59ed987404cf38f027209a4e140569c62721bd6) +++ generic/xotcl.c (.../xotcl.c) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -107,9 +107,10 @@ static int AliasAdd(Tcl_Interp *interp, Tcl_Obj *cmdName, CONST char *methodName, int withPer_object, char *cmd); static int AliasDelete(Tcl_Interp *interp, Tcl_Obj *cmdName, CONST char *methodName, int withPer_object); static Tcl_Obj *AliasGet(Tcl_Interp *interp, Tcl_Obj *cmdName, CONST char *methodName, int withPer_object); -static int ListMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName, Tcl_Command cmd, - int subcmd, int withPer_object); +static int ListMethodName(Tcl_Interp *interp, XOTclObject *object, int withPer_object, + CONST char *methodName); + typedef enum { CALLING_LEVEL, ACTIVE_LEVEL } CallStackLevel; typedef struct callFrameContext { @@ -5783,10 +5784,11 @@ GetObjectFromObj(interp, cmdObj, &o); if (o != lastSelf) { /*fprintf(stderr, "+++ protected method %s is not invoked\n", methodName);*/ + /* allow unknown-handler to handle this case */ unknown = 1; fprintf(stderr, "+++ %s is protected, therefore maybe unknown %p %s lastself=%p o=%p cd %p flags = %.6x\n", methodName, cmdObj, ObjStr(cmdObj), lastSelf, o, clientData, flags); - tcl85showStack(interp); + /*tcl85showStack(interp);*/ } } @@ -6390,11 +6392,7 @@ Tcl_Command_flags((Tcl_Command)procPtr->cmdPtr) |= XOTCL_CMD_PROTECTED_METHOD; } #endif - fprintf(stderr, "CALL listMethod for %s %p\n", methodName, procPtr->cmdPtr); - result = ListMethod(interp, object, methodName, - (Tcl_Command)procPtr->cmdPtr, 3 /*InfomethodsubcmdNameIdx*/, - withPer_object); - fprintf(stderr, " listmethod returns %s\n", ObjStr(Tcl_GetObjResult(interp))); + result = ListMethodName(interp, object, withPer_object, methodName); } } Tcl_PopCallFrame(interp); @@ -6410,8 +6408,6 @@ #endif DECR_REF_COUNT(ov[3]); - fprintf(stderr, " makeproc returns %s\n", ObjStr(Tcl_GetObjResult(interp))); - return result; } @@ -6462,7 +6458,6 @@ /* could be a filter => recompute filter order */ FilterComputeDefined(interp, obj); } - fprintf(stderr, " makemethod returns %s\n", ObjStr(Tcl_GetObjResult(interp))); return result; } @@ -9650,6 +9645,16 @@ } static int +ListMethodName(Tcl_Interp *interp, XOTclObject *object, int withPer_object, CONST char *methodName) { + Tcl_Obj *resultObj = Tcl_NewStringObj(withPer_object ? "" : "::xotcl::classes", -1); + Tcl_AppendObjToObj(resultObj, object->cmdName); + Tcl_AppendStringsToObj(resultObj, "::", methodName, (char *) NULL); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + + +static int ListMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName, Tcl_Command cmd, int subcmd, int withPer_object) { @@ -9671,11 +9676,7 @@ switch (subcmd) { case InfomethodsubcmdNameIdx: { - resultObj = Tcl_NewStringObj(withPer_object ? "" : "::xotcl::classes", -1); - Tcl_AppendObjToObj(resultObj, object->cmdName); - Tcl_AppendStringsToObj(resultObj, "::", methodName, (char *) NULL); - Tcl_SetObjResult(interp, resultObj); - return TCL_OK; + return ListMethodName(interp, object, withPer_object, methodName); } case InfomethodsubcmdArgsIdx: { @@ -10174,7 +10175,8 @@ Tcl_ObjCmdProc *objProc, *newObjProc = NULL; Tcl_CmdDeleteProc *deleteProc = NULL; AliasCmdClientData *tcd = NULL; /* make compiler happy */ - Tcl_Command cmd, newCmd; + Tcl_Command cmd, newCmd = NULL; + Tcl_Namespace *nsPtr; int flags, result; char allocation; @@ -10288,13 +10290,17 @@ XOTclClass *cl = (XOTclClass *)object; result = XOTclAddInstanceMethod(interp, (XOTcl_Class *)cl, methodName, objProc, tcd, deleteProc, flags); - newCmd = FindMethod(cl->nsPtr, methodName); + nsPtr = cl->nsPtr; } else { result = XOTclAddObjectMethod(interp, (XOTcl_Object*)object, methodName, objProc, tcd, deleteProc, flags); - newCmd = FindMethod(object->nsPtr, methodName); + nsPtr = object->nsPtr; } + if (result == TCL_OK) { + newCmd = FindMethod(nsPtr, methodName); + } + if (newObjProc) { /* * Define the reference chain like for 'namespace import' to @@ -10316,6 +10322,8 @@ Tcl_DStringAppend(dsPtr, ObjStr(cmdName), -1); AliasAdd(interp, object->cmdName, methodName, allocation == 'o', Tcl_DStringValue(dsPtr)); Tcl_DStringFree(dsPtr); + + result = ListMethodName(interp, object, allocation == 'o', methodName); } return result; @@ -10626,39 +10634,50 @@ return TCL_OK; } -static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, +static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *methodObj, int withPer_object, int methodproperty, Tcl_Obj *value) { - XOTclClass *cl; + char *methodName = ObjStr(methodObj); Tcl_Command cmd = NULL; - char allocation; - - if (XOTclObjectIsClass(object)) { - cl = (XOTclClass *)object; - allocation = 'c'; - } else { - cl = NULL; - allocation = 'o'; - } - - if (withPer_object) { - allocation = 'o'; - } - - if (allocation == 'o') { - if (object->nsPtr) - cmd = FindMethod(object->nsPtr, methodName); + + if (*methodName == ':') { + cmd = Tcl_GetCommandFromObj(interp, methodObj); if (!cmd) { return XOTclVarErrMsg(interp, "Cannot lookup object method '", - methodName, "' for object ", objectName(object), - (char *) NULL); + methodName, "' for object ", objectName(object), + (char *) NULL); } } else { - if (cl->nsPtr) - cmd = FindMethod(cl->nsPtr, methodName); - if (!cmd) - return XOTclVarErrMsg(interp, "Cannot lookup method '", - methodName, "' from class ", objectName(object), - (char *) NULL); + XOTclClass *cl; + char allocation; + + if (XOTclObjectIsClass(object)) { + cl = (XOTclClass *)object; + allocation = 'c'; + } else { + cl = NULL; + allocation = 'o'; + } + + if (withPer_object) { + allocation = 'o'; + } + + if (allocation == 'o') { + if (object->nsPtr) + cmd = FindMethod(object->nsPtr, methodName); + if (!cmd) { + return XOTclVarErrMsg(interp, "Cannot lookup object method '", + methodName, "' for object ", objectName(object), + (char *) NULL); + } + } else { + if (cl->nsPtr) + cmd = FindMethod(cl->nsPtr, methodName); + if (!cmd) + return XOTclVarErrMsg(interp, "Cannot lookup method '", + methodName, "' from class ", objectName(object), + (char *) NULL); + } } if (methodproperty == MethodpropertyProtectedIdx @@ -12035,7 +12054,7 @@ return result; } -static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *method, +static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *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[]) { @@ -12046,10 +12065,14 @@ withObjscope, withOnerror, withVerbose, target, nobjc, nobjv, &tcd); if (result == TCL_OK) { - tcd->obj = obj; - result = XOTclAddObjectMethod(interp, (XOTcl_Object *)obj, NSTail(ObjStr(method)), + CONST char *methodName = NSTail(ObjStr(method)); + tcd->obj = object; + result = XOTclAddObjectMethod(interp, (XOTcl_Object *)object, methodName, (Tcl_ObjCmdProc*)XOTclForwardMethod, (ClientData)tcd, forwardCmdDeleteProc, 0); + if (result == TCL_OK) { + result = ListMethodName(interp, object, 1, methodName); + } } return result; } @@ -12453,15 +12476,26 @@ } /* TODO move me at the right place */ -static int XOTclCSetterMethod(Tcl_Interp *interp, XOTclClass *cl, int withPer_object, char *name) { +static int XOTclCSetterMethod(Tcl_Interp *interp, XOTclClass *cl, int withPer_object, char *methodName) { + int result; if (withPer_object) { - return XOTclAddObjectMethod(interp, (XOTcl_Object*) cl, name, (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); + result = XOTclAddObjectMethod(interp, (XOTcl_Object*) cl, methodName, (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); } else { - return XOTclAddInstanceMethod(interp, (XOTcl_Class *)cl, name, (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); + result = XOTclAddInstanceMethod(interp, (XOTcl_Class *)cl, methodName, (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); } + if (result == TCL_OK) { + result = ListMethodName(interp, &cl->object, withPer_object, methodName); + } + return result; } -static int XOTclOSetterMethod(Tcl_Interp *interp, XOTclObject *object, char *name) { - return XOTclAddObjectMethod(interp, (XOTcl_Object*) object, name, (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); + +static int XOTclOSetterMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { + int result = XOTclAddObjectMethod(interp, (XOTcl_Object*) object, methodName, + (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0, 0); + if (result == TCL_OK) { + result = ListMethodName(interp, object, 1, methodName); + } + return result; } /* TODO move me at the right place */ @@ -12493,6 +12527,7 @@ Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { forwardCmdClientData *tcd; int result; + CONST char *methodName; result = forwardProcessOptions(interp, method, withDefault, withEarlybinding, withMethodprefix, @@ -12501,17 +12536,21 @@ if (result != TCL_OK) { return result; } + methodName = NSTail(ObjStr(method)); if (withPer_object) { tcd->obj = &cl->object; - result = XOTclAddObjectMethod(interp, (XOTcl_Object *)cl, NSTail(ObjStr(method)), + result = XOTclAddObjectMethod(interp, (XOTcl_Object *)cl, methodName, (Tcl_ObjCmdProc*)XOTclForwardMethod, (ClientData)tcd, forwardCmdDeleteProc, 0); } else { tcd->obj = &cl->object; - result = XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, NSTail(ObjStr(method)), + result = XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, methodName, (Tcl_ObjCmdProc*)XOTclForwardMethod, (ClientData)tcd, forwardCmdDeleteProc, 0); } + if (result == TCL_OK) { + result = ListMethodName(interp, &cl->object, withPer_object, methodName); + } return result; } Index: tests/method-modifiers.xotcl =================================================================== diff -u --- tests/method-modifiers.xotcl (revision 0) +++ tests/method-modifiers.xotcl (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -0,0 +1,159 @@ +package require XOTcl +package require xotcl::test + +proc ? {cmd expected {msg ""}} { + set count 10 + if {$msg ne ""} { + set t [Test new -cmd $cmd -count $count -msg $msg] + } else { + set t [Test new -cmd $cmd -count $count] + } + $t expected $expected + $t run +} + +::xotcl::use xotcl2 + +Class create C { + # methods + .method plain_method {} {return [self proc]} + .public method public_method {} {return [self proc]} + .protected method protected_method {} {return [self proc]} + + # forwards + .forward plain_forward %self plain_method + .public forward public_forward %self public_method + .protected forward protected_forward %self protected_method + + # setter + .setter plain_setter + .public setter public_setter + .protected setter protected_setter + + # alias + .alias plain_alias [C info method name plain_method] + .public alias public_alias [C info method name public_method] + .protected alias protected_alias [C info method name protected_method] + + # object + .object method plain_object_method {} {return [self proc]} + .object public method public_object_method {} {return [self proc]} + .object protected method protected_object_method {} {return [self proc]} + .object forward plain_object_forward %self plain_object_method + .object public forward public_object_forward %self public_object_method + .object protected forward protected_object_forward %self protected_object_method + .object setter plain_object_setter + .object public setter public_object_setter + .object protected setter protected_object_setter + .object alias plain_object_alias [.info -per-object method name plain_object_method] + .object public alias public_object_alias [.info -per-object method name public_object_method] + .object protected alias protected_object_alias [.info -per-object method name protected_object_method] +} +C create c1 { + # methods + .method plain_object_method {} {return [self proc]} + .public method public_object_method {} {return [self proc]} + .protected method protected_object_method {} {return [self proc]} + + # forwards + .forward plain_object_forward %self plain_object_method + .public forward public_object_forward %self public_object_method + .protected forward protected_object_forward %self protected_object_method + + # setter + .setter plain_object_setter + .public setter public_object_setter + .protected setter protected_object_setter + + # alias + .alias plain_object_alias [.info method name plain_object_method] + .public alias public_object_alias [.info method name public_object_method] + .protected alias protected_object_alias [.info method name protected_object_method] +} +C public setter s0 +C protected setter s1 +? {c1 s0 0} 0 +? {::xotcl::dispatch c1 s1 1} 1 +C object setter s3 +? {C s3 3} 3 + +# create a fresh object (different from c1) +C create c2 + +# test scripted class level methods +? {c2 plain_method} "plain_method" +? {c2 public_method} "public_method" +? {catch {c2 protected_method}} 1 +? {::xotcl::dispatch c2 protected_method} "protected_method" + +# class level forwards +? {c2 plain_forward} "plain_method" +? {c2 public_forward} "public_method" +? {catch {c2 protected_forward}} 1 +? {::xotcl::dispatch c2 protected_forward} "protected_method" + +# class level setter +? {c2 plain_setter 1} "1" +? {c2 public_setter 2} "2" +? {catch {c2 protected_setter 3}} 1 +? {::xotcl::dispatch c2 protected_setter 4} "4" + +# class level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +? {c2 plain_alias} "plain_method" +? {c2 public_alias} "public_method" +? {catch {c2 protected_alias}} 1 +? {::xotcl::dispatch c2 protected_alias} "protected_method" + +########### + +# scripted class-object level methods +? {C plain_object_method} "plain_object_method" +? {C public_object_method} "public_object_method" +? {catch {C protected_object_method}} 1 +? {::xotcl::dispatch C protected_object_method} "protected_object_method" + +# class-object level forwards +? {C plain_object_forward} "plain_object_method" +? {C public_object_forward} "public_object_method" +? {catch {C protected_object_forward}} 1 +? {::xotcl::dispatch C protected_object_forward} "protected_object_method" + +# class-object level setter +? {C plain_object_setter 1} "1" +? {C public_object_setter 2} "2" +? {catch {C protected_object_setter 3}} 1 +? {::xotcl::dispatch C protected_object_setter 4} "4" + +# class-object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +? {C plain_object_alias} "plain_object_method" +? {C public_object_alias} "public_object_method" +? {catch {C protected_object_alias}} 1 +? {::xotcl::dispatch C protected_object_alias} "protected_object_method" + +########### + +# scripted object level methods +? {c1 plain_object_method} "plain_object_method" +? {c1 public_object_method} "public_object_method" +? {catch {c1 protected_object_method}} 1 +? {::xotcl::dispatch c1 protected_object_method} "protected_object_method" + +# object level forwards +? {c1 plain_object_forward} "plain_object_method" +? {c1 public_object_forward} "public_object_method" +? {catch {c1 protected_object_forward}} 1 +? {::xotcl::dispatch c1 protected_object_forward} "protected_object_method" + +# object level setter +? {c1 plain_object_setter 1} "1" +? {c1 public_object_setter 2} "2" +? {catch {c1 protected_object_setter 3}} 1 +? {::xotcl::dispatch c1 protected_object_setter 4} "4" + +# object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? +? {c1 plain_object_alias} "plain_object_method" +? {c1 public_object_alias} "public_object_method" +? {catch {c1 protected_object_alias}} 1 +? {::xotcl::dispatch c1 protected_object_alias} "protected_object_method" + + Index: tests/testx.xotcl =================================================================== diff -u -rbf9bae94d157de9bbd4c398f6a3a9a4d93626025 -r962c96dcc0ddc25782570a831c104fb2b955891d --- tests/testx.xotcl (.../testx.xotcl) (revision bf9bae94d157de9bbd4c398f6a3a9a4d93626025) +++ tests/testx.xotcl (.../testx.xotcl) (revision 962c96dcc0ddc25782570a831c104fb2b955891d) @@ -3368,10 +3368,10 @@ ::errorCheck [e1 x] 1 "instparameter cmd 1" ::errorCheck [e1 x 2] 2 "instparameter cmd 2" ::errorCheck [e1 x] 2 "instparameter cmd 3" - ::errorCheck [e1 parametercmd y] "" "parametercmd 1" + ::errorCheck [e1 parametercmd y] "::e1::y" "parametercmd 1" ::errorCheck [e1 y 3] 3 "parametercmd 2" ::errorCheck [e1 y] 3 "parametercmd 3" - ::errorCheck [e1 forward regexp -objscope] "" "forward 1" + ::errorCheck [e1 forward regexp -objscope] "::e1::regexp" "forward 1" ::errorCheck [e1 regexp (y) xyz _ X] "1" "forward 2" ::errorCheck [e1 exists X] "1" "forward 3" ::errorCheck [e1 q] q "self proc"