Index: TODO =================================================================== diff -u -r6f127ecf78a90478bc889376cb0cb0c05d55b451 -r915842c26db98121eb7ed1c6adfbe499ce586cac --- TODO (.../TODO) (revision 6f127ecf78a90478bc889376cb0cb0c05d55b451) +++ TODO (.../TODO) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -1201,8 +1201,14 @@ - documented incompatiblity of object-invocation via method interface (due to ensemble objects) in migration guide -TODO: +- implemented XOTclObjInfoHasMixinMethod() and XOTclObjInfoHasTypeMethod() +- renamed "$obj info hasnamespace" to "$obj info has namespace" +- added "$obj info has mixin $class" +- added "$obj info has type $class" +- extended regression test for parametercheck/objectproperty/is +TODO: +- rename ObjectInfo2 & ClassInfo2 - check "my" vs. "nsf::dispatch" in xotcl2.tcl - overthink decision about not showing "child objects" per default in "info methods" Index: generic/gentclAPI.decls =================================================================== diff -u -r96cbacb0f5b6fa72d1176219a9caf4d781bdaada -r915842c26db98121eb7ed1c6adfbe499ce586cac --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 96cbacb0f5b6fa72d1176219a9caf4d781bdaada) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -251,8 +251,14 @@ {-argName "-definition"} {-argName "name"} } +objectInfoMethod hasmixin XOTclObjInfoHasMixinMethod { + {-argName "class" -type class} +} objectInfoMethod hasnamespace XOTclObjInfoHasnamespaceMethod { } +objectInfoMethod hastype XOTclObjInfoHasTypeMethod { + {-argName "class" -type class} +} objectInfoMethod method XOTclObjInfoMethodMethod { {-argName "infomethodsubcmd" -type "args|body|definition|handle|parameter|parametersyntax|type|precondition|postcondition"} {-argName "name"} Index: generic/tclAPI.h =================================================================== diff -u -r1a67ad0bf0b5c2092e1558d13659bad489f5bb75 -r915842c26db98121eb7ed1c6adfbe499ce586cac --- generic/tclAPI.h (.../tclAPI.h) (revision 1a67ad0bf0b5c2092e1558d13659bad489f5bb75) +++ generic/tclAPI.h (.../tclAPI.h) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -188,6 +188,8 @@ static int XOTclObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoFiltermethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoHasMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoHasTypeMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoHasnamespaceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoMethodMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -265,6 +267,8 @@ static int XOTclObjInfoFilterguardMethod(Tcl_Interp *interp, XOTclObject *obj, CONST char *filter); static int XOTclObjInfoFiltermethodsMethod(Tcl_Interp *interp, XOTclObject *obj, int withGuards, int withOrder, CONST char *pattern); static int XOTclObjInfoForwardMethod(Tcl_Interp *interp, XOTclObject *obj, int withDefinition, CONST char *name); +static int XOTclObjInfoHasMixinMethod(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *class); +static int XOTclObjInfoHasTypeMethod(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *class); static int XOTclObjInfoHasnamespaceMethod(Tcl_Interp *interp, XOTclObject *obj); static int XOTclObjInfoMethodMethod(Tcl_Interp *interp, XOTclObject *obj, int infomethodsubcmd, CONST char *name); static int XOTclObjInfoMethodsMethod(Tcl_Interp *interp, XOTclObject *obj, int withMethodtype, int withCallprotection, int withNomixins, int withIncontext, CONST char *pattern); @@ -343,6 +347,8 @@ XOTclObjInfoFilterguardMethodIdx, XOTclObjInfoFiltermethodsMethodIdx, XOTclObjInfoForwardMethodIdx, + XOTclObjInfoHasMixinMethodIdx, + XOTclObjInfoHasTypeMethodIdx, XOTclObjInfoHasnamespaceMethodIdx, XOTclObjInfoMethodMethodIdx, XOTclObjInfoMethodsMethodIdx, @@ -1201,6 +1207,44 @@ } static int +XOTclObjInfoHasMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclObject *obj = (XOTclObject *)clientData; + if (!obj) return XOTclObjErrType(interp, objv[0], "Object", ""); + if (ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[XOTclObjInfoHasMixinMethodIdx].paramDefs, + method_definitions[XOTclObjInfoHasMixinMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclClass *class = (XOTclClass *)pc.clientData[0]; + + parseContextRelease(&pc); + return XOTclObjInfoHasMixinMethod(interp, obj, class); + + } +} + +static int +XOTclObjInfoHasTypeMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclObject *obj = (XOTclObject *)clientData; + if (!obj) return XOTclObjErrType(interp, objv[0], "Object", ""); + if (ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[XOTclObjInfoHasTypeMethodIdx].paramDefs, + method_definitions[XOTclObjInfoHasTypeMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclClass *class = (XOTclClass *)pc.clientData[0]; + + parseContextRelease(&pc); + return XOTclObjInfoHasTypeMethod(interp, obj, class); + + } +} + +static int XOTclObjInfoHasnamespaceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; @@ -2061,6 +2105,12 @@ {"-definition", 0, 0, convertToString}, {"name", 0, 0, convertToString}} }, +{"::nsf::cmd::ObjectInfo2::hasmixin", XOTclObjInfoHasMixinMethodStub, 1, { + {"class", 0, 0, convertToClass}} +}, +{"::nsf::cmd::ObjectInfo2::hastype", XOTclObjInfoHasTypeMethodStub, 1, { + {"class", 0, 0, convertToClass}} +}, {"::nsf::cmd::ObjectInfo2::hasnamespace", XOTclObjInfoHasnamespaceMethodStub, 0, { } }, Index: generic/xotcl.c =================================================================== diff -u -r67ad561b71e208451454fc1d71e591e75e4f3a71 -r915842c26db98121eb7ed1c6adfbe499ce586cac --- generic/xotcl.c (.../xotcl.c) (revision 67ad561b71e208451454fc1d71e591e75e4f3a71) +++ generic/xotcl.c (.../xotcl.c) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -201,7 +201,7 @@ static void GuardDel(XOTclCmdList *filterCL); static int IsMetaClass(Tcl_Interp *interp, XOTclClass *cl, int withMixins); -static int hasMixin(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl); +static int HasMixin(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl); static int isSubType(XOTclClass *subcl, XOTclClass *cl); static XOTclClass *DefaultSuperClass(Tcl_Interp *interp, XOTclClass *cl, XOTclClass *mcl, int isMeta); @@ -8627,7 +8627,7 @@ } static int -hasMixin(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl) { +HasMixin(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl) { if (!(object->flags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, object); @@ -8644,7 +8644,6 @@ return 0; } - extern int XOTclCreateObject(Tcl_Interp *interp, Tcl_Obj *nameObj, XOTcl_Class *class) { XOTclClass *cl = (XOTclClass*) class; @@ -11569,7 +11568,7 @@ } if (success && withHasmixin) { success = (GetClassFromObj(interp, withHasmixin, &mixinClass, NULL) == TCL_OK) - && hasMixin(interp, object, mixinClass); + && HasMixin(interp, object, mixinClass); } Tcl_SetIntObj(Tcl_GetObjResult(interp), success); @@ -12142,7 +12141,7 @@ if (valueObj == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " hasmixin "); success = (GetObjectFromObj(interp, obj, &object) == TCL_OK) && (GetClassFromObj(interp, valueObj, &cl, NULL) == TCL_OK) - && hasMixin(interp, object, cl); + && HasMixin(interp, object, cl); break; } @@ -14111,16 +14110,37 @@ } /* -infoObjectMethod hasnamespace XOTclObjInfoHasnamespaceMethod { - {-argName "object" -required 1 -type object} +objectInfoMethod hasmixin XOTclObjInfoHasMixinMethod { + {-argName "class" -type class} } */ +static int +XOTclObjInfoHasMixinMethod(Tcl_Interp *interp, XOTclObject *object, XOTclClass *mixinClass) { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), HasMixin(interp, object, mixinClass)); + return TCL_OK; +} + +/* +objectInfoMethod hasnamespace XOTclObjInfoHasnamespaceMethod { +} +*/ static int XOTclObjInfoHasnamespaceMethod(Tcl_Interp *interp, XOTclObject *object) { Tcl_SetBooleanObj(Tcl_GetObjResult(interp), object->nsPtr != NULL); return TCL_OK; } /* +objectInfoMethod hastype XOTclObjInfoHasTypeMethod { + {-argName "class" -type class} +} +*/ +static int +XOTclObjInfoHasTypeMethod(Tcl_Interp *interp, XOTclObject *object, XOTclClass *typeClass) { + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), isSubType(object->cl, typeClass)); + return TCL_OK; +} + +/* infoObjectMethod method XOTclObjInfoMethodMethod { {-argName "object" -type object} {-argName "infomethodsubcmd" -type "args|definition|handle|parameter|parametersyntax|type|precondition|postcondition"} Index: library/nx/nx.tcl =================================================================== diff -u -r5784bce8b6b2f00b00b1f82ac3b50ee9c257a3ed -r915842c26db98121eb7ed1c6adfbe499ce586cac --- library/nx/nx.tcl (.../nx.tcl) (revision 5784bce8b6b2f00b00b1f82ac3b50ee9c257a3ed) +++ library/nx/nx.tcl (.../nx.tcl) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -843,7 +843,9 @@ :alias "info filter guard" ::nsf::cmd::ObjectInfo2::filterguard :alias "info filter methods" ::nsf::cmd::ObjectInfo2::filtermethods :alias "info forward" ::nsf::cmd::ObjectInfo2::forward - :alias "info hasnamespace" ::nsf::cmd::ObjectInfo2::hasnamespace + :alias "info has mixin" ::nsf::cmd::ObjectInfo2::hasmixin + :alias "info has namespace" ::nsf::cmd::ObjectInfo2::hasnamespace + :alias "info has type" ::nsf::cmd::ObjectInfo2::hastype :method "info is" {kind {value ""}} {::nsf::objectproperty [::nsf::current object] $kind {*}$value} :alias "info methods" ::nsf::cmd::ObjectInfo2::methods :alias "info mixin guard" ::nsf::cmd::ObjectInfo2::mixinguard @@ -863,8 +865,8 @@ } # Create the ensemble object here to prepare for copy of the above - # definitions from Object.info to Class.info. Potentially, some - # names are overwritten later by Class.info . Note, that the + # definitions from Object.info to Class.info. Potentially, some + # names are overwritten later by Class.info. Note, that the # automatically created name of the sensemble object has to be the # same as defined above. @@ -884,6 +886,9 @@ #:alias "info classparent" ::nsf::cmd::ObjectInfo2::parent #:alias "info classchildren" ::nsf::cmd::ObjectInfo2::children :alias "info filter guard" ::nsf::cmd::ClassInfo2::filterguard + :alias "info has mixin" ::nsf::cmd::ObjectInfo2::hasmixin + :alias "info has namespace" ::nsf::cmd::ObjectInfo2::hasnamespace + :alias "info has type" ::nsf::cmd::ObjectInfo2::hastype :alias "info filter methods" ::nsf::cmd::ClassInfo2::filtermethods :alias "info forward" ::nsf::cmd::ClassInfo2::forward :alias "info heritage" ::nsf::cmd::ClassInfo2::heritage @@ -1857,7 +1862,7 @@ #puts stderr "COPY makeTargetList $t target= ${:targetList}" # if it is an object without namespace, it is a leaf if {[::nsf::objectproperty $t object]} { - if {[$t info hasnamespace]} { + if {[::nsf::dispatch $t ::nsf::cmd::ObjectInfo2::hasnamespace]} { # make target list from all children set children [$t info children] } else { @@ -1915,9 +1920,9 @@ ::nsf::assertion $obj object-invar [::nsf::assertion $origin object-invar] ::nsf::relation $obj object-filter [::nsf::relation $origin object-filter] ::nsf::relation $obj object-mixin [::nsf::relation $origin object-mixin] - if {[$origin info hasnamespace]} { # reused in XOTcl, no "require" there, so use nsf primitiva - $obj ::nsf::cmd::Object::requireNamespace + if {[::nsf::dispatch $origin ::nsf::cmd::ObjectInfo2::hasnamespace]} { + ::nsf::dispatch $obj ::nsf::cmd::Object::requireNamespace } } else { namespace eval $dest {} Index: tests/parameters.tcl =================================================================== diff -u -r649c33f8bca87b389877c3e3c1b7eb8e1182c843 -r915842c26db98121eb7ed1c6adfbe499ce586cac --- tests/parameters.tcl (.../parameters.tcl) (revision 649c33f8bca87b389877c3e3c1b7eb8e1182c843) +++ tests/parameters.tcl (.../parameters.tcl) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -25,16 +25,25 @@ c1 mixin M ? {::nsf::parametercheck object o1} 1 + ? {::nsf::parametercheck -nocomplain object o1} 1 + ? {::nsf::parametercheck -nocomplain object o1000} 0 ? {::nsf::parametercheck integer 1} 1 + ? {::nsf::parametercheck object,type=::C c1} 1 + ? {::nsf::parametercheck hasmixin,arg=::M c1} 1 + + #D method foo-hasmixin {x:hasmixin,arg=::M} {return $x} + #D method foo-type {x:object,type=::C} {return $x} ? {::nsf::objectproperty o1 object} 1 + ? {::nsf::objectproperty o1000 object} 0 ? {::nsf::objectproperty c1 type C} 1 ? {::nsf::is c1 object -type C} 1 ? {::nsf::is c1 object -hasmixin M -type C} 1 ? {::nsf::is c1 object -hasmixin M1 -type C} 0 ? {::nsf::is c1 object -hasmixin M -type C0} 0 ? {::nsf::is o1 object} 1 + ? {::nsf::is o100 object} 0 ? {::nsf::is 1 integer} 1 ? {::nsf::is c1 type C} 1 ? {::nsf::is o type C} 0 Index: tests/varresolutiontest.tcl =================================================================== diff -u -r15d57478e3976d747741fd3df9bcb6ecccc7076d -r915842c26db98121eb7ed1c6adfbe499ce586cac --- tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision 15d57478e3976d747741fd3df9bcb6ecccc7076d) +++ tests/varresolutiontest.tcl (.../varresolutiontest.tcl) (revision 915842c26db98121eb7ed1c6adfbe499ce586cac) @@ -392,7 +392,7 @@ # refined tests for the var resolver under # Tcl namespaces parallelling XOTcl objects # (! not declared through require namespace !) -# e.g., "info hasnamespace" reports 0 rather +# e.g., "info has namespace" reports 0 rather # than 1 as under "require namespace" ############################################### @@ -407,7 +407,7 @@ namespace eval ::c {} ? {namespace exists ::c} 1 ? {::nsf::objectproperty ::c object} 1 -? {::c info hasnamespace} 0 +? {::c info has namespace} 0 ? {::c Set w 2; expr {[::c Set w] == $::w}} 0 ? {::c Unset w; info exists ::w} 1