Index: ChangeLog
===================================================================
diff -u -rbb3a2bff37e7e5ca2ea59f19ae3ed5e6966b37b4 -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- ChangeLog (.../ChangeLog) (revision bb3a2bff37e7e5ca2ea59f19ae3ed5e6966b37b4)
+++ ChangeLog (.../ChangeLog) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -1,3 +1,70 @@
+2008-02-04: <Gustaf.Neumann@wu-wien.ac.at>
+ * Potential incompatibility:
+ provide a uniform interface to the following info subcommands
+
+ <class> info superclass ?-closure? ?pattern?
+ <class> info subclass ?-closure? ?pattern?
+ <class> info instances ?-closure? ?pattern?
+ <class> info instmixinof ?-closure? ?pattern?
+ <class> info mixinof ?pattern?
+
+ 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 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.
+
+ By using the option "-closure" one can
+ perform the lookup in the transitive
+ or in the intransitive sets.
+
+ Still to do:
+ children
+ parent
+ classchildren
+ classparent
+
+2008-02-03: <Gustaf.Neumann@wu-wien.ac.at>
+ - 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")
+
+2008-02-02: <Gustaf.Neumann@wu-wien.ac.at>
+ - Improving regression test:
+ + added ::xotcl::test::case
+ + shortended 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
+
+2008-02-01: <Martin.Matuska@wu-wien.ac.at>
+ - Add closure option to mixinofinfo
+ - Enhance getAllClassMixinofs
+
+2008-01-23: <Gustaf.Neumann@wu-wien.ac.at>
+ - saving object->id in cl->opt->id (probably a temporary solution)
+ - improving reset of affected objects, when (transitive) per class mixins change
+ - extended regression test
+
2008-01-07: <Gustaf.Neumann@wu-wien.ac.at>
- don't call unset traces during an object move (related to fix below)
Index: generic/predefined.h
===================================================================
diff -u -rb872864b1f6375c55cf561c9e25335951f1386cf -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- generic/predefined.h (.../predefined.h) (revision b872864b1f6375c55cf561c9e25335951f1386cf)
+++ generic/predefined.h (.../predefined.h) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -262,10 +262,7 @@
"if {[::xotcl::my ismixin $cl]} {return 1}\n"
"::xotcl::my istype $cl}\n"
"::xotcl::Class instproc allinstances {} {\n"
-"set set [::xotcl::my info instances]\n"
-"foreach sc [::xotcl::my info subclass] {\n"
-"eval lappend set [$sc allinstances]}\n"
-"return $set}\n"
+"return [::xotcl::my info instances -closure]}\n"
"::xotcl::Object proc unsetExitHandler {} {\n"
"::xotcl::Object proc __exitHandler {} {\n"
";}}\n"
Index: generic/predefined.xotcl
===================================================================
diff -u -rb872864b1f6375c55cf561c9e25335951f1386cf -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- generic/predefined.xotcl (.../predefined.xotcl) (revision b872864b1f6375c55cf561c9e25335951f1386cf)
+++ generic/predefined.xotcl (.../predefined.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -430,11 +430,8 @@
::xotcl::my istype $cl
}
::xotcl::Class instproc allinstances {} {
- set set [::xotcl::my info instances]
- foreach sc [::xotcl::my info subclass] {
- eval lappend set [$sc allinstances]
- }
- return $set
+ # TODO: mark it deprecated
+ return [::xotcl::my info instances -closure]
}
Index: generic/xotcl.c
===================================================================
diff -u -r1dd45310fe7b6df0c1ac61596f28a84d4ddadfbd -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- generic/xotcl.c (.../xotcl.c) (revision 1dd45310fe7b6df0c1ac61596f28a84d4ddadfbd)
+++ generic/xotcl.c (.../xotcl.c) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -1280,6 +1280,20 @@
}
}
+/* reverse class list, caller is responsible for freeing data */
+static XOTclClasses*
+XOTclReverseClasses(XOTclClasses *sl) {
+ XOTclClasses *first = NULL;
+ for (; sl; sl = sl->next) {
+ XOTclClasses *element = NEW(XOTclClasses);
+ element->cl = sl->cl;
+ element->clientData = sl->clientData;
+ element->next = first;
+ first = element;
+ }
+ return first;
+}
+
extern XOTclClasses**
XOTclAddClass(XOTclClasses **cList, XOTclClass *cl, ClientData cd) {
XOTclClasses *l = *cList, *element = NEW(XOTclClasses);
@@ -3221,37 +3235,76 @@
/*
* apply AppendMatchingElement to CmdList
*/
-static void
-AppendMatchingElementFromCmdList(Tcl_Interp *interp, XOTclCmdList *cmdl, char *pattern) {
+static int
+AppendMatchingElementsFromCmdList(Tcl_Interp *interp, XOTclCmdList *cmdl,
+ char *pattern, XOTclObject *matchObject) {
+ int rc = 0;
for ( ; cmdl; cmdl = cmdl->next) {
XOTclObject *obj = XOTclGetObjectFromCmdPtr(cmdl->cmdPtr);
if (obj) {
- AppendMatchingElement(interp, obj->cmdName, pattern);
+ if (matchObject == obj) {
+ return 1;
+ } else {
+ AppendMatchingElement(interp, obj->cmdName, pattern);
+ }
}
}
+ return rc;
}
/*
+ * apply AppendMatchingElement to
+ */
+static int
+AppendMatchingElementsFromClasses(Tcl_Interp *interp, XOTclClasses *cls,
+ char *pattern, XOTclObject *matchObject) {
+ int rc = 0;
+
+ for ( ; cls; cls = cls->next) {
+ XOTclObject *obj = (XOTclObject *)cls->cl;
+ if (obj) {
+ if (matchObject && obj == matchObject) {
+ /* we have a matchObject and it is identical to obj,
+ just return true and don't continue search
+ */
+ return 1;
+ break;
+ } else {
+ AppendMatchingElement(interp, obj->cmdName, pattern);
+ }
+ }
+ }
+ return rc;
+}
+
+/*
* get all instances of a class recursively into an initialized
* String key hashtable
*/
-static void
-listInstances(Tcl_Interp *interp, XOTclClass *startCl, char *pattern, int closure) {
+static int
+listInstances(Tcl_Interp *interp, XOTclClass *startCl,
+ char *pattern, int closure, XOTclObject *matchObject) {
Tcl_HashTable *table = &startCl->instances;
XOTclClasses *sc;
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
+ int rc = 0;
for (hPtr = Tcl_FirstHashEntry(table, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
XOTclObject *inst = (XOTclObject*) Tcl_GetHashKey(table, hPtr);
+ if (matchObject && inst == matchObject) {
+ return 1;
+ }
AppendMatchingElement(interp, inst->cmdName, pattern);
}
if (closure) {
for (sc = startCl->sub; sc; sc = sc->next) {
- listInstances(interp, sc->cl, pattern, closure);
+ rc = listInstances(interp, sc->cl, pattern, closure, matchObject);
+ if (rc) break;
}
}
+ return rc;
}
@@ -3286,33 +3339,42 @@
* object ptr hashtable (TCL_ONE_WORD_KEYS)
*/
-static void
-getAllSubClasses(Tcl_Interp *interp, Tcl_HashTable *destTable,
- XOTclClass *startCl, int appendResult, char *pattern) {
+static int
+getAllSubClasses(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl,
+ int appendResult, char *pattern, XOTclObject *matchObject) {
XOTclClasses *sc;
+ int rc = 0;
for (sc = startCl->sub; sc; sc = sc->next) {
if (sc->cl) {
int new;
+ if (matchObject && (XOTclObject *)sc->cl == matchObject) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ return 1;
+ }
Tcl_CreateHashEntry(destTable, (char *)sc->cl, &new);
if (new) {
if (appendResult) {
AppendMatchingElement(interp, sc->cl->object.cmdName, pattern);
}
- getAllSubClasses(interp, destTable, sc->cl, appendResult, pattern);
+ rc = getAllSubClasses(interp, destTable, sc->cl, appendResult, pattern, matchObject);
+ if (rc == 1) break;
}
}
}
+ return rc;
}
/*
* recursively get all isClassMixinOf of a class into an initialized
* object ptr hashtable (TCL_ONE_WORD_KEYS)
*/
-static void
-getAllClassMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable,
- XOTclClass *startCl, int appendResult, char *pattern) {
+static int
+getAllClassMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl,
+ int appendResult, char *pattern, XOTclObject *matchObject) {
+ int rc = 0;
+
if (startCl->opt) {
XOTclCmdList *m;
@@ -3325,20 +3387,26 @@
cl = XOTclGetClassFromCmdPtr(m->cmdPtr);
if (cl) {
int new;
+ if (matchObject && matchObject == (XOTclObject *)cl) {
+ return 1;
+ }
Tcl_CreateHashEntry(destTable, (char *)cl, &new);
if (new) {
/* if (new) fprintf (stderr, " -- %s (%s)\n", Tcl_GetCommandName(interp, m->cmdPtr), ObjStr(startCl->object.cmdName));*/
if (appendResult) {
AppendMatchingElement(interp, cl->object.cmdName, pattern);
}
if (cl->sub) {
- getAllSubClasses(interp, destTable, cl, appendResult, pattern);
+ rc = getAllSubClasses(interp, destTable, cl, appendResult, pattern, matchObject);
+ if (rc) {return rc;}
}
- getAllClassMixinsOf(interp, destTable, cl, appendResult, pattern);
+ rc = getAllClassMixinsOf(interp, destTable, cl, appendResult, pattern, matchObject);
+ if (rc) {return rc;}
}
}
}
}
+ return rc;
}
static void
@@ -3500,7 +3568,7 @@
*/
Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS);
MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable);
- getAllClassMixinsOf(interp, commandTable, cl, 0, NULL);
+ getAllClassMixinsOf(interp, commandTable, cl, 0, NULL, NULL);
for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr;
hPtr = Tcl_NextHashEntry(&hSrch)) {
@@ -5830,6 +5898,24 @@
}
static int
+getMatchObject(Tcl_Interp *interp, char **pattern, XOTclObject **matchObject) {
+ if (*pattern && noMetaChars(*pattern)) {
+ *matchObject = XOTclpGetObject(interp, *pattern);
+ if (*matchObject) {
+ *pattern = ObjStr((*matchObject)->cmdName);
+ return 1;
+ } else {
+ /* not found */
+ Tcl_SetObjResult(interp, XOTclGlobalObjects[XOTE_EMPTY]);
+ return -1;
+ }
+ } else {
+ *matchObject = NULL;
+ }
+ return 0;
+}
+
+static int
ListKeys(Tcl_Interp *interp, Tcl_HashTable *table, char *pattern) {
Tcl_HashEntry *hPtr;
char *key;
@@ -6103,89 +6189,6 @@
}
static int
-ListSuperclasses(Tcl_Interp *interp, XOTclClass *cl, char *pattern) {
- if (pattern == NULL) {
- XOTclClasses *sl = cl->super;
- XOTclClasses *sc = 0;
-
- /*
- * reverse the list to obtain presentation order
- */
-
- Tcl_ResetResult(interp);
- while (sc != sl) {
- XOTclClasses *nl = sl;
- while (nl->next != sc) nl = nl->next;
- Tcl_AppendElement(interp, className(nl->cl));
- sc = nl;
- }
- } else {
- XOTclClass *isc = XOTclpGetClass(interp, pattern);
- XOTclClasses *pl;
- if (isc == 0) {
- /* return XOTclErrBadVal(interp, "info superclass", "a class", pattern);*/
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
- } else {
-
- /*
- * search precedence to see if we're related or not
- */
- for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->next) {
- if (pl->cl == isc) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
- break;
- }
- }
- if (pl == 0)
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
- }
- }
- return TCL_OK;
-}
-
-static int
-ListSubclasses(Tcl_Interp *interp, XOTclClass *cl, char *pattern) {
- if (pattern == NULL) {
- XOTclClasses *sl = cl->sub;
- XOTclClasses *sc = 0;
-
- /*
- * order unimportant
- */
- Tcl_ResetResult(interp);
- for (sc = sl; sc != 0; sc = sc->next)
- Tcl_AppendElement(interp, className(sc->cl));
- } else {
- XOTclClass *isc = XOTclpGetClass(interp, pattern);
- XOTclClasses *pl;
- XOTclClasses *saved;
-
- if (isc == 0)
- return XOTclErrBadVal(interp, "info subclass", "a class", pattern);
- saved = cl->order;
- cl->order = 0;
-
- /*
- * search precedence to see if we're related or not
- */
- for (pl = ComputeOrder(cl, cl->order, Sub); pl; pl = pl->next) {
- if (pl->cl == isc) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
- break;
- }
- }
- if (pl == 0)
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
-
- XOTclFreeClasses(cl->order);
- cl->order = saved;
- }
- return TCL_OK;
-}
-
-
-
-static int
ListHeritage(Tcl_Interp *interp, XOTclClass *cl, char *pattern) {
XOTclClasses *pl = ComputeOrder(cl, cl->order, Super);
Tcl_ResetResult(interp);
@@ -10569,7 +10572,8 @@
switch (*cmdTail) {
case 'a':
if (!strcmp(cmdTail, "ances")) {
- int withClosure = 0;
+ int withClosure = 0, rc;
+ XOTclObject *matchObject;
if (objc-modifiers > 3 || modifiers > 1)
return XOTclObjErrArgCnt(interp, cl->object.cmdName,
@@ -10580,7 +10584,15 @@
return XOTclVarErrMsg(interp, "info instances: unknown modifier ",
ObjStr(objv[2]), (char *) NULL);
}
- listInstances(interp, cl, pattern, withClosure);
+
+ if (getMatchObject(interp, &pattern, &matchObject) == -1) {
+ return TCL_OK;
+ }
+
+ rc = listInstances(interp, cl, pattern, withClosure, matchObject);
+ if (matchObject) {
+ Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
+ }
return TCL_OK;
} else if (!strcmp(cmdTail, "args")) {
if (objc != 3 || modifiers > 0)
@@ -10696,7 +10708,8 @@
return opt ? MixinInfo(interp, opt->instmixins, pattern, withGuards) : TCL_OK;
} else if (!strcmp(cmdTail, "mixinof")) {
- int withClosure = 0;
+ int withClosure = 0, rc;
+ XOTclObject *matchObject;
if (objc-modifiers > 3 || modifiers > 1)
return XOTclObjErrArgCnt(interp, cl->object.cmdName,
@@ -10709,16 +10722,23 @@
}
if (opt) {
+ if (getMatchObject(interp, &pattern, &matchObject) == -1) {
+ return TCL_OK;
+ }
if (withClosure) {
Tcl_HashTable objTable, *commandTable = &objTable;
MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable);
Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS);
- getAllClassMixinsOf(interp, commandTable, cl, 1, pattern);
+ rc = getAllClassMixinsOf(interp, commandTable, cl, 1, pattern, matchObject);
MEM_COUNT_FREE("Tcl_InitHashTable", commandTable);
} else {
- AppendMatchingElementFromCmdList(interp, opt->isClassMixinOf, pattern);
+ rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf,
+ pattern, matchObject);
}
}
+ if (matchObject) {
+ Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
+ }
return TCL_OK;
} else if (!strcmp(cmdTail, "mixinguard")) {
@@ -10780,11 +10800,20 @@
case 'm':
if (!strcmp(cmd, "mixinof")) {
+ XOTclObject *matchObject;
+ int rc;
if (objc-modifiers > 3 || modifiers > 0)
return XOTclObjErrArgCnt(interp, cl->object.cmdName,
- "info mixinof ?object?");
- if (opt)
- AppendMatchingElementFromCmdList(interp, opt->isObjectMixinOf, pattern);
+ "info mixinof ?pattern?");
+ if (opt) {
+ if (getMatchObject(interp, &pattern, &matchObject) == -1) {
+ return TCL_OK;
+ }
+ rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, pattern, matchObject);
+ if (matchObject) {
+ Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
+ }
+ }
return TCL_OK;
}
break;
@@ -10835,24 +10864,70 @@
case 's':
if (!strcmp(cmd, "superclass")) {
- int withClosure = 0;
- if (objc > 3 || modifiers > 1)
+ int withClosure = 0, rc;
+ XOTclObject *matchObject;
+ if (objc-modifiers > 3 || modifiers > 1)
return XOTclObjErrArgCnt(interp, cl->object.cmdName,
- "info superclass ?-closure? ?class?");
+ "info superclass ?-closure? ?pattern?");
if (modifiers > 0) {
withClosure = checkForModifier(objv, modifiers, "-closure");
if (withClosure == 0)
return XOTclVarErrMsg(interp, "info superclass: unknown modifier ",
ObjStr(objv[2]), (char *) NULL);
- return ListHeritage(interp, cl, pattern);
+ }
+
+ if (getMatchObject(interp, &pattern, &matchObject) == -1) {
+ return TCL_OK;
+ }
+
+ if (withClosure) {
+ XOTclClasses *pl = ComputeOrder(cl, cl->order, Super);
+ if (pl) pl=pl->next;
+ rc = AppendMatchingElementsFromClasses(interp, pl, pattern, matchObject);
} else {
- return ListSuperclasses(interp, cl, pattern);
+ XOTclClasses *clSuper = XOTclReverseClasses(cl->super);
+ rc = AppendMatchingElementsFromClasses(interp, clSuper, pattern, matchObject);
+ XOTclFreeClasses(clSuper);
}
+ if (matchObject) {
+ Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
+ }
+ return TCL_OK;
+
} else if (!strcmp(cmd, "subclass")) {
- if (objc > 3 || modifiers > 0)
+ int withClosure = 0, rc;
+ XOTclObject *matchObject;
+
+ if (objc-modifiers > 3 || modifiers > 1)
return XOTclObjErrArgCnt(interp, cl->object.cmdName,
- "info subclass ?class?");
- return ListSubclasses(interp, cl, pattern);
+ "info subclass ?-closure? ?pattern?");
+ if (modifiers > 0) {
+ withClosure = checkForModifier(objv, modifiers, "-closure");
+ if (withClosure == 0)
+ return XOTclVarErrMsg(interp, "info subclass: unknown modifier ",
+ ObjStr(objv[2]), (char *) NULL);
+ }
+
+ if (getMatchObject(interp, &pattern, &matchObject) == -1) {
+ return TCL_OK;
+ }
+
+ if (withClosure) {
+ XOTclClasses *saved = cl->order, *subclasses;
+ cl->order = 0;
+ subclasses = ComputeOrder(cl, cl->order, Sub);
+ cl->order = saved;
+ if (subclasses) subclasses=subclasses->next;
+ rc = AppendMatchingElementsFromClasses(interp, subclasses, pattern, matchObject);
+ XOTclFreeClasses(subclasses);
+ } else {
+ rc = AppendMatchingElementsFromClasses(interp, cl->sub, pattern, matchObject);
+ }
+ if (matchObject) {
+ Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
+ }
+ return TCL_OK;
+
} else if (!strcmp(cmd, "slots")) {
Tcl_DString ds, *dsPtr = &ds;
XOTclObject *o;
Index: tests/speedtest.xotcl
===================================================================
diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- tests/speedtest.xotcl (.../speedtest.xotcl) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9)
+++ tests/speedtest.xotcl (.../speedtest.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -253,7 +253,9 @@
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
+Test new -cmd {Object info instances ::c::5000} -expected ""
Test new -count 100 -pre {set ::c::l ""} \
-cmd {lappend ::c::l 1} \
Index: tests/testo.xotcl
===================================================================
diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- tests/testo.xotcl (.../testo.xotcl) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9)
+++ tests/testo.xotcl (.../testo.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -182,7 +182,6 @@
# factors become subclasses, direct or indirect
#
-
if {[TestClass info instances $i] eq ""} then {
my factorgraph $i
$i superclass $n
Index: tests/testx.xotcl
===================================================================
diff -u -r18e8dcd86f6ff86326697306e4e60db5e59011c7 -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716
--- tests/testx.xotcl (.../testx.xotcl) (revision 18e8dcd86f6ff86326697306e4e60db5e59011c7)
+++ tests/testx.xotcl (.../testx.xotcl) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716)
@@ -3130,16 +3130,18 @@
::errorCheck [Class info instances Unk*] "" "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] 1 "info class of Class Object"
+ ::errorCheck [Class info class Object] ::xotcl::Object "info class of Class Object"
Class C
Class D -superclass C
Class E -superclass D -parameter {{x 1}}
E instproc t {a b {c 1}} {return ok}
E proc p {a b {c 1}} {return ok}
E instproc q {} {return [self proc]}
- ::errorCheck [C info subclass E] 1 "transitive subclass 1"
- ::errorCheck [Object info subclass E] 1 "transitive subclass 2"
- ::errorCheck [D info subclass C] 0 "transitive subclass 3"
+ ::errorCheck [C info subclass D] ::D "transitive subclass 0"
+ ::errorCheck [C info subclass E] "" "transitive subclass 0a"
+ ::errorCheck [C info subclass -closure E] ::E "transitive subclass 1"
+ ::errorCheck [Object info subclass -closure E] ::E "transitive subclass 2"
+ ::errorCheck [D info subclass -closure C] "" "transitive subclass 3"
::errorCheck [E info heritage] "::D ::C ::xotcl::Object" "heritage"
::errorCheck [E info instargs t] "a b c" "instargs"
::errorCheck [E info instdefault t c x] 1 "instdefault"