Index: ChangeLog =================================================================== diff -u -rb50baa47b65361cce5e09caa477fa065ce3e0826 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- ChangeLog (.../ChangeLog) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) +++ ChangeLog (.../ChangeLog) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -1,66 +1,85 @@ +2008-02-06: + * Continued with info orthogonality change + + info mixin ?pattern? + info instmixin ?pattern? + + ?pattern? behaves exactly like in the change of two days + ago. Preceding colons in the name of the queried class are not + required. + + Still to do "-closure" in + + info instmixin -closure ?pattern? + + * In all mentioned calls, where pattern refers to an object/class + and it contains wild-cards, a preceding :: is added automatically + to the search pattern, if it is missing. Since all object names + start with ::, an omitted leading :: in a search pattern is an + obvious mistake + + * Made the behavior "pattern" in the following calls identical + concerning wild cards and object lookups + + mixin delete pattern + instmixin delete pattern + superclass delete pattern + + * extended regresson test + 2008-02-05: - - fix getAllClassMixinsOf to handle combinations of - transitive per class mixins and inheriting per-class - mixin via the class hierarchy, removed getAllSubClasses - - extend test cases + * fix getAllClassMixinsOf to handle combinations of transitive per + class mixins and inheriting per-class mixin via the class + hierarchy, removed getAllSubClasses + + * extend test cases + 2008-02-04: - * Potential incompatibility: - provide a uniform interface to the following info subcommands + * Potential incompatibility: + provide a uniform interface to the following info subcommands info superclass ?-closure? ?pattern? info subclass ?-closure? ?pattern? info instances ?-closure? ?pattern? info instmixinof ?-closure? ?pattern? info mixinof ?pattern? - In cases, where the option "-closure" is defined, - the values are computed transitively. + In cases, where the option "-closure" is defined, the values are + computed transitively. - In cases, where a pattern is specified, and - the pattern contains meta-characters, a list - of results is returned matching the pattern - (like "string match"). When no matching value - is found, an empty list is returned. + In cases, where a pattern is specified, and the pattern contains + meta-characters, a list of results is returned matching the + pattern (like "string match"). When no matching value is found, an + empty list is returned. - In cases, where a pattern is specified, and - the pattern contains no meta-characters, - a single value is returned korrespinding to - the specified value. The pattern is used - to lookup an object or class, such it is - not necessary to provide fully qualified names). - if there is no match, empty is returned. - Previously, "info superclass" and "info subclass" - returned a boolean value and performed - always a transitive search. Returning "" - is more consistent and more in line with Tcl. + In cases, where a pattern is specified, and the pattern contains + no meta-characters, a single value is returned corresponding to + the specified value. The pattern is used to lookup an object or + class, such it is not necessary to provide fully qualified names). + if there is no match, empty is returned. Previously, "info + superclass" and "info subclass" returned a boolean value and + performed always a transitive search. Returning "" is more + consistent and more in line with Tcl. - By using the option "-closure" one can - perform the lookup in the transitive - or in the intransitive sets. + By using the option "-closure" one can perform the lookup in the + transitive or in the intransitive sets. - Still to do: (transitive) - children - parent - classchildren - classparent - Still to do: (matchObject) - mixin - instmixin - 2008-02-03: - fix getAllSubClasses - fix "info mixinof -closure", when pattern was provided - streamline code (AppendMatchingElement) - - new info option "-closure" for "info instances" (equiv. to "allinstances", but 5 times faster) - - new info option "-closure" for "info superclass" (equiv. to "info heritage") + - new info option "-closure" for "info instances" (equiv. to + "allinstances", but 5 times faster) + - new info option "-closure" for "info superclass" (equiv. to + "info heritage") 2008-02-02: - - Improving regression test: + - Improving regression test: + added ::xotcl::test::case - + shortended output - - Makefile.in: added missing src_man_dir - - fixed softcrecreate cases: + + shortened output + - Makefile.in: added missing src_man_dir + - fixed softcrecreate cases: * update caches for subclasses of recreated classes * fixed recreate when it defines different superclasses * extended test cases for mixinoftest @@ -70,8 +89,12 @@ - process subclasses for getAllClassMixinsOf 2008-01-23: + - saving object->id in cl->opt->id (probably a temporary solution) - - improving reset of affected objects, when (transitive) per class mixins change + + - improving reset of affected objects, when (transitive) per class + mixins change + - extended regression test 2008-01-07: @@ -105,7 +128,7 @@ - better cleanup when classes are deleted 2007-12-13: - * fix alias command for aliasing to tcl procs + * fix alias command for aliasing to Tcl procs 2007-11-09: * added missing file (install.sh from tclconfig) Index: generic/predefined.h =================================================================== diff -u -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- generic/predefined.h (.../predefined.h) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716) +++ generic/predefined.h (.../predefined.h) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -88,7 +88,9 @@ "set domain [self callingobject]}\n" "$domain $forwarder $name -default [$manager defaultmethods] $manager %1 %self %proc}\n" "::xotcl::MetaSlot create ::xotcl::InfoSlot -array set __defaults {\n" -"multivalued true}\n" +"multivalued true\n" +"elementtype ::xotcl::Class}\n" +"::xotcl::InfoSlot instparametercmd elementtype\n" "::xotcl::setrelation ::xotcl::InfoSlot superclass ::xotcl::Slot\n" "::xotcl::InfoSlot instproc get {obj prop} {$obj info $prop}\n" "::xotcl::InfoSlot instproc add {obj prop value {pos 0}} {\n" @@ -97,8 +99,19 @@ "$obj $prop [linsert [$obj info $prop] $pos $value]}\n" "::xotcl::InfoSlot instproc delete {-nocomplain:switch obj prop value} {\n" "set old [$obj info $prop]\n" -"set p [lsearch -glob $old $value]\n" -"if {$p>-1} {$obj $prop [lreplace $old $p $p]} else {\n" +"if {[string first * $value] > -1 || [string first \\[ $value] > -1} {\n" +"if {[my elementtype] ne \"\" && ![string match ::* $value]} {\n" +"set value ::$value}\n" +"return [$obj $prop [lsearch -all -not -glob -inline $old $value]]} elseif {[my elementtype] ne \"\"} {\n" +"if {[string first :: $value] == -1} {\n" +"if {![my isobject $value]} {\n" +"error \"$value does not appear to be an object\"}\n" +"set value [$value self]}\n" +"if {![$value isclass [my elementtype]]} {\n" +"error \"$value does not appear to be of type [my elementtype]\"}}\n" +"set p [lsearch -exact $old $value]\n" +"if {$p > -1} {\n" +"$obj $prop [lreplace $old $p $p]} else {\n" "error \"$value is not a $prop of $obj (valid are: $old)\"}}\n" "::xotcl::MetaSlot create ::xotcl::InterceptorSlot\n" "::xotcl::setrelation ::xotcl::InterceptorSlot superclass ::xotcl::InfoSlot\n" @@ -115,9 +128,9 @@ "::xotcl::InfoSlot create ::xotcl::Object::slot::class\n" "::xotcl::alias ::xotcl::Object::slot::class assign ::xotcl::setrelation\n" "::xotcl::InterceptorSlot create ::xotcl::Object::slot::mixin\n" -"::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter\n" +"::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter -elementtype \"\"\n" "::xotcl::InterceptorSlot create ::xotcl::Class::slot::instmixin\n" -"::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter\n" +"::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter -elementtype \"\"\n" "::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::Slot\n" "foreach p {default value_check initcmd valuecmd valuechangedcmd} {\n" "::xotcl::Attribute instparametercmd $p}\n" Index: generic/predefined.xotcl =================================================================== diff -u -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- generic/predefined.xotcl (.../predefined.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -142,7 +142,9 @@ # ::xotcl::MetaSlot create ::xotcl::InfoSlot -array set __defaults { multivalued true + elementtype ::xotcl::Class } +::xotcl::InfoSlot instparametercmd elementtype ::xotcl::setrelation ::xotcl::InfoSlot superclass ::xotcl::Slot ::xotcl::InfoSlot instproc get {obj prop} {$obj info $prop} ::xotcl::InfoSlot instproc add {obj prop value {pos 0}} { @@ -153,8 +155,28 @@ } ::xotcl::InfoSlot instproc delete {-nocomplain:switch obj prop value} { set old [$obj info $prop] - set p [lsearch -glob $old $value] - if {$p>-1} {$obj $prop [lreplace $old $p $p]} else { + if {[string first * $value] > -1 || [string first \[ $value] > -1} { + # string contains meta characters + if {[my elementtype] ne "" && ![string match ::* $value]} { + # prefix string with ::, since all object names have leading :: + set value ::$value + } + return [$obj $prop [lsearch -all -not -glob -inline $old $value]] + } elseif {[my elementtype] ne ""} { + if {[string first :: $value] == -1} { + if {![my isobject $value]} { + error "$value does not appear to be an object" + } + set value [$value self] + } + if {![$value isclass [my elementtype]]} { + error "$value does not appear to be of type [my elementtype]" + } + } + set p [lsearch -exact $old $value] + if {$p > -1} { + $obj $prop [lreplace $old $p $p] + } else { error "$value is not a $prop of $obj (valid are: $old)" } } @@ -186,9 +208,9 @@ ::xotcl::alias ::xotcl::Object::slot::class assign ::xotcl::setrelation ::xotcl::InterceptorSlot create ::xotcl::Object::slot::mixin -::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter +::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter -elementtype "" ::xotcl::InterceptorSlot create ::xotcl::Class::slot::instmixin -::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter +::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter -elementtype "" # # Attribute Index: generic/xotcl.c =================================================================== diff -u -rb50baa47b65361cce5e09caa477fa065ce3e0826 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- generic/xotcl.c (.../xotcl.c) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) +++ generic/xotcl.c (.../xotcl.c) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -3586,7 +3586,8 @@ #endif } -static int MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, int withGuards); +static int MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, + int withGuards, XOTclObject *matchObject); /* * the mixin order is either * DEFINED (there are mixins on the instance), @@ -3633,7 +3634,7 @@ /*** { Tcl_Obj *sr; - MixinInfo(interp, obj->mixinOrder, NULL, 0); + MixinInfo(interp, obj->mixinOrder, NULL, 0, NULL); sr = Tcl_GetObjResult(interp); fprintf(stderr,"INFO->%s order %p next %p\n", ObjStr(sr), obj->mixinOrder, obj->mixinOrder->next); } @@ -3731,24 +3732,30 @@ * info option for mixins and instmixins */ static int -MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, int withGuards) { +MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, + int withGuards, XOTclObject *matchObject) { Tcl_Obj *list = Tcl_NewListObj(0, NULL); XOTclClass *mixinClass; + while (m) { - /* fprintf(stderr," mixin info m=%p, next=%p\n", m, m->next); */ + /* fprintf(stderr," mixin info m=%p, next=%p, pattern %s, matchObject %p\n", + m, m->next, pattern, matchObject);*/ mixinClass = XOTclGetClassFromCmdPtr(m->cmdPtr); if (mixinClass && - (!pattern || - Tcl_StringMatch(ObjStr(mixinClass->object.cmdName), pattern))) { + (!pattern + || (matchObject && &(mixinClass->object) == matchObject) + || (!matchObject && Tcl_StringMatch(ObjStr(mixinClass->object.cmdName), pattern)))) { if (withGuards && m->clientData) { Tcl_Obj *l = Tcl_NewListObj(0, NULL); Tcl_Obj *g = (Tcl_Obj*) m->clientData; Tcl_ListObjAppendElement(interp, l, mixinClass->object.cmdName); Tcl_ListObjAppendElement(interp, l, XOTclGlobalObjects[XOTE_GUARD_OPTION]); Tcl_ListObjAppendElement(interp, l, g); Tcl_ListObjAppendElement(interp, list, l); - } else + } else { Tcl_ListObjAppendElement(interp, list, mixinClass->object.cmdName); + } + if (matchObject) break; } m = m->next; } @@ -5902,19 +5909,34 @@ } static int -getMatchObject(Tcl_Interp *interp, char **pattern, XOTclObject **matchObject) { +getMatchObject(Tcl_Interp *interp, char **pattern, XOTclObject **matchObject, Tcl_DString *dsPtr) { if (*pattern && noMetaChars(*pattern)) { *matchObject = XOTclpGetObject(interp, *pattern); if (*matchObject) { *pattern = ObjStr((*matchObject)->cmdName); return 1; } else { - /* not found */ + /* object does not exist */ Tcl_SetObjResult(interp, XOTclGlobalObjects[XOTE_EMPTY]); return -1; } } else { *matchObject = NULL; + if (*pattern) { + /* + * we have a pattern and meta characters, we might have + * to prefix it to ovoid abvious errors: since all object + * names are prefixed with ::, we add this prefix automatically + * to the match pattern, if it does not exist + */ + if (**pattern && **pattern != ':' && **pattern+1 && **pattern+1 != ':') { + /*fprintf(stderr, "pattern is not prefixed '%s'\n",*pattern);*/ + Tcl_DStringAppend(dsPtr, "::", -1); + Tcl_DStringAppend(dsPtr, *pattern, -1); + *pattern = Tcl_DStringValue(dsPtr); + /*fprintf(stderr, "prefixed pattern = '%s'\n",*pattern);*/ + } + } } return 0; } @@ -8349,7 +8371,10 @@ case 'm': if (!strcmp(cmd, "mixin")) { - int withOrder = 0, withGuards = 0; + int withOrder = 0, withGuards = 0, rc;; + XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; + if (objc-modifiers > 3) return XOTclObjErrArgCnt(interp, obj->cmdName, "info mixin ?-guards? ?-order? ?class?"); @@ -8361,15 +8386,21 @@ return XOTclVarErrMsg(interp, "info mixin: unknown modifier . ", ObjStr(objv[2]), (char *) NULL); } - + + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { + return TCL_OK; + } if (withOrder) { if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, obj); - return MixinInfo(interp, obj->mixinOrder, pattern, withGuards); + rc = MixinInfo(interp, obj->mixinOrder, pattern, withGuards, matchObject); + } else { + rc = opt ? MixinInfo(interp, opt->mixins, pattern, withGuards, matchObject) : TCL_OK; } + DSTRING_FREE(dsPtr); + return rc; - return opt ? MixinInfo(interp, opt->mixins, pattern, withGuards) : TCL_OK; - } else if (!strcmp(cmd, "mixinguard")) { if (objc != 3 || modifiers > 0) return XOTclObjErrArgCnt(interp, obj->cmdName, "info mixinguard mixin"); @@ -10578,6 +10609,7 @@ if (!strcmp(cmdTail, "ances")) { int withClosure = 0, rc; XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; if (objc-modifiers > 3 || modifiers > 1) return XOTclObjErrArgCnt(interp, cl->object.cmdName, @@ -10589,15 +10621,18 @@ ObjStr(objv[2]), (char *) NULL); } - if (getMatchObject(interp, &pattern, &matchObject) == -1) { + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } rc = listInstances(interp, cl, pattern, withClosure, matchObject); if (matchObject) { Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } + DSTRING_FREE(dsPtr); return TCL_OK; + } else if (!strcmp(cmdTail, "args")) { if (objc != 3 || modifiers > 0) return XOTclObjErrArgCnt(interp, cl->object.cmdName, @@ -10698,23 +10733,33 @@ case 'm': if (!strcmp(cmdTail, "mixin")) { - int withGuards = 0; - + int withGuards = 0, rc; + XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; + if (objc-modifiers > 3 || modifiers > 1) return XOTclObjErrArgCnt(interp, cl->object.cmdName, - "info instmixin ?-guards? ?class?"); + "info instmixin ?-guards? ?pattern?"); if (modifiers > 0) { withGuards = checkForModifier(objv, modifiers, "-guards"); if (withGuards == 0) return XOTclVarErrMsg(interp, "info instfilter: unknown modifier ", ObjStr(objv[2]), (char *) NULL); } - return opt ? MixinInfo(interp, opt->instmixins, pattern, withGuards) : TCL_OK; + + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { + return TCL_OK; + } + rc = opt ? MixinInfo(interp, opt->instmixins, pattern, withGuards, matchObject) : TCL_OK; + DSTRING_FREE(dsPtr); + return rc; } else if (!strcmp(cmdTail, "mixinof")) { int withClosure = 0, rc; XOTclObject *matchObject; - + Tcl_DString ds, *dsPtr = &ds; + if (objc-modifiers > 3 || modifiers > 1) return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instmixinof ?-closure? ?class?"); @@ -10726,7 +10771,8 @@ } if (opt) { - if (getMatchObject(interp, &pattern, &matchObject) == -1) { + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } if (withClosure) { @@ -10742,6 +10788,7 @@ if (matchObject) { Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } + DSTRING_FREE(dsPtr); } return TCL_OK; @@ -10805,18 +10852,22 @@ case 'm': if (!strcmp(cmd, "mixinof")) { XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; int rc; + if (objc-modifiers > 3 || modifiers > 0) return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info mixinof ?pattern?"); if (opt) { - if (getMatchObject(interp, &pattern, &matchObject) == -1) { + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, pattern, matchObject); if (matchObject) { Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } + DSTRING_FREE(dsPtr); } return TCL_OK; } @@ -10870,6 +10921,8 @@ if (!strcmp(cmd, "superclass")) { int withClosure = 0, rc; XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; + if (objc-modifiers > 3 || modifiers > 1) return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info superclass ?-closure? ?pattern?"); @@ -10880,7 +10933,8 @@ ObjStr(objv[2]), (char *) NULL); } - if (getMatchObject(interp, &pattern, &matchObject) == -1) { + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } @@ -10896,11 +10950,13 @@ if (matchObject) { Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } + DSTRING_FREE(dsPtr); return TCL_OK; } else if (!strcmp(cmd, "subclass")) { int withClosure = 0, rc; XOTclObject *matchObject; + Tcl_DString ds, *dsPtr = &ds; if (objc-modifiers > 3 || modifiers > 1) return XOTclObjErrArgCnt(interp, cl->object.cmdName, @@ -10912,7 +10968,8 @@ ObjStr(objv[2]), (char *) NULL); } - if (getMatchObject(interp, &pattern, &matchObject) == -1) { + DSTRING_INIT(dsPtr); + if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } @@ -10930,6 +10987,7 @@ if (matchObject) { Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } + DSTRING_FREE(dsPtr); return TCL_OK; } else if (!strcmp(cmd, "slots")) { Index: tests/speedtest.xotcl =================================================================== diff -u -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- tests/speedtest.xotcl (.../speedtest.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716) +++ tests/speedtest.xotcl (.../speedtest.xotcl) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -170,9 +170,10 @@ D d +Test new -cmd {llength [c info children]} -expected 999 +Test new -cmd {llength [Object info instances]} -expected 1006 - Test new -cmd {d istype D} -expected 1 Test new -cmd {c setViaInstvar 100} -expected 100 @@ -223,13 +224,18 @@ Test new -cmd {c childNodeNamespaceCreate} -expected ::c::13 Test new -cmd {c createVolatileRc} -expected 2 +Test new -count 1 -cmd {llength [Object info instances]} -expected 1006 + Test new -cmd {Object new -volatile} -expected ::xotcl::__\#F9 -count 2000 \ -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} Test new -cmd {Object new} -expected ::xotcl::__\#lQ -count 2000 \ -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} Test new -cmd {Object new -childof o} -expected ::o::__\#0Hh \ -pre {Object o} -post {o destroy} +# should be still the same number as above +Test new -count 1 -cmd {llength [Object info instances]} -expected 1006 + Test new -count 1000 -pre {::set ::count 0} \ -cmd {Object create [incr ::count]} \ -expected ::1 \ @@ -247,11 +253,7 @@ Test new -cmd {llength [c info children]} -expected 999 Test new -cmd {c info children ::c::500} -expected ::c::500 -if {[info exists xotcl_version]} { - Test new -cmd {llength [Object info instances]} -expected 1001 -} else { - Test new -cmd {llength [Object info instances]} -expected 1007 -} +Test new -cmd {llength [Object info instances]} -expected 1007 Test new -cmd {Object info instances ::c::500*} -expected ::c::500 Test new -cmd {Object info instances ::c::500} -expected ::c::500 @@ -275,6 +277,12 @@ Test new \ -count 100 \ + -cmd {c mixin add M1} \ + -expected "" \ + -post {c mixin ""} + +Test new \ + -count 100 \ -cmd {c mixinappend M1; c mixinappend M2} \ -expected {::M1 ::M2} \ -post {c mixin ""} @@ -286,6 +294,90 @@ -post {c mixin ""} Test new \ + -count 100 \ + -pre {Class D; Class E; Object o -mixin {D E}} \ + -cmd {o info mixin D} \ + -expected {::D} \ + -post {foreach o {D E o} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Object o -mixin {D E}} \ + -cmd {o info mixin E} \ + -expected {::E} \ + -post {foreach o {D E o} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Object o -mixin {D E}} \ + -cmd {o info mixin ::E*} \ + -expected {::E} \ + -post {foreach o {D E o} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class E1; Object o -mixin {D E E1}} \ + -cmd {o info mixin ::E*} \ + -expected {::E ::E1} \ + -post {foreach o {D E E1 o} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class X -instmixin {D E}} \ + -cmd {X info instmixin D} \ + -expected {::D} \ + -post {foreach o {D E X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class X -instmixin {D E}} \ + -cmd {X info instmixin E} \ + -expected {::E} \ + -post {foreach o {D E X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class E1; Class X -instmixin {D E E1}} \ + -cmd {X info instmixin ::E*} \ + -expected {::E ::E1} \ + -post {foreach o {D E E1 X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class X -instmixin {D E}} \ + -cmd {X info instmixin ::E*} \ + -expected {::E} \ + -post {foreach o {D E X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class X} \ + -cmd {X instmixin {D E}; X instmixin delete ::E; X info instmixin} \ + -expected {::D} \ + -post {foreach o {D E X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class X} \ + -cmd {X instmixin {D E}; X instmixin delete E; X info instmixin} \ + -expected {::D} \ + -post {foreach o {D E X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class E1; Class X} \ + -cmd {X instmixin {D E E1}; catch {X instmixin delete ::E*}; X info instmixin} \ + -expected {::D} \ + -post {foreach o {D E E1 X} {$o destroy}} + +Test new \ + -count 100 \ + -pre {Class D; Class E; Class E1; Class X} \ + -cmd {X instmixin {D E E1}; catch {X instmixin delete E*}; X info instmixin} \ + -expected {::D} \ + -post {foreach o {D E E1 X} {$o destroy}} + +Test new \ -cmd {C instfilter f; C info instfilter} \ -expected f \ -post {C instfilter ""} Index: tests/testx.xotcl =================================================================== diff -u -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716 -r90f13fe04f5c707be3b56808a8a7992adab1855f --- tests/testx.xotcl (.../testx.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716) +++ tests/testx.xotcl (.../testx.xotcl) (revision 90f13fe04f5c707be3b56808a8a7992adab1855f) @@ -3127,7 +3127,7 @@ ::errorCheck [lsort [UnknownClass info info]] {args body children class classchildren classparent commands default filter filterguard forward heritage info instances instbody instcommands instdefault instfilter instfilterguard instforward instinvar instmixin instmixinof instpost instpre instprocs invar methods mixin mixinof parameter parent post pre precedence procs subclass superclass vars} "info info" ::errorCheck [Class info instances *Unk*] ::UnknownClass "match in info instances" - ::errorCheck [Class info instances Unk*] "" "no match in info instances" + ::errorCheck [Class info instances Unk*] "::UnknownClass" "no match in info instances" ::errorCheck [Class info instances Unk] "" "no match in info instances (no metachars)" ::errorCheck [Class info class] ::xotcl::Class "info class of Class" ::errorCheck [Class info class Object] ::xotcl::Object "info class of Class Object"