Index: TODO
===================================================================
diff -u -re4cc1570b184d6ae7f6d9f8daaa783e1df470e88 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- TODO (.../TODO) (revision e4cc1570b184d6ae7f6d9f8daaa783e1df470e88)
+++ TODO (.../TODO) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -2697,6 +2697,16 @@
POMs and PCMs
* extended regression test
+- nsf.c:
+ * renamed old flag "-order" of "info mixin classes" to "-heritage"
+ since it computes same heritage as in "info heritage" (but
+ potentially for a list of classes)
+ * added compatibility layer for xotcl2
+ * added lost option "-heritage" to "/cls/ info mixin classes"
+ (was only there for "/obj/ info mixin classes")
+ * extended regression test
+
+
TODO:
- MixinComputeOrderFullList() could receive a flag to store source classes in checkList
Index: doc/next-migration.html
===================================================================
diff -u -r5ee346e9c5df606ec027a37e8891e82205f427b2 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- doc/next-migration.html (.../next-migration.html) (revision 5ee346e9c5df606ec027a37e8891e82205f427b2)
+++ doc/next-migration.html (.../next-migration.html) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -4650,7 +4650,7 @@
.nx-variable {color: #AF663F; font-weight: normal; font-style: normal;}
/obj/ info mixin classes \
- ?-guards? ?-order? ?pattern?
+ ?-guards? ?-heritage? ?pattern?
@@ -4703,7 +4703,7 @@
.nx-variable {color: #AF663F; font-weight: normal; font-style: normal;}
/cls/ class info mixin classes \
- ?-guards? ?-order? ?pattern? |
+ ?-guards? ?-heritage? ?pattern?
@@ -4757,7 +4757,7 @@
.nx-variable {color: #AF663F; font-weight: normal; font-style: normal;}
/cls/ info mixin classes \
- ?-guards? ?-order? ?pattern? |
+ ?-closure? ?-guards? ?-heritage? ?pattern?
|
Index: doc/next-migration.txt
===================================================================
diff -u -r5ee346e9c5df606ec027a37e8891e82205f427b2 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- doc/next-migration.txt (.../next-migration.txt) (revision 5ee346e9c5df606ec027a37e8891e82205f427b2)
+++ doc/next-migration.txt (.../next-migration.txt) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -2033,7 +2033,7 @@
|[source,tcl]
----------------
/obj/ info mixin classes \
- ?-guards? ?-order? ?pattern?
+ ?-guards? ?-heritage? ?pattern?
----------------
|[source,tcl]
----------------
@@ -2050,7 +2050,7 @@
|[source,tcl]
----------------
/cls/ class info mixin classes \
- ?-guards? ?-order? ?pattern?
+ ?-guards? ?-heritage? ?pattern?
----------------
|[source,tcl]
----------------
@@ -2068,7 +2068,7 @@
|[source,tcl]
----------------
/cls/ info mixin classes \
- ?-guards? ?-order? ?pattern?
+ ?-closure? ?-guards? ?-heritage? ?pattern?
----------------
|[source,tcl]
----------------
Index: generic/gentclAPI.decls
===================================================================
diff -u -ra5e4ab3a3f85b51e855adb3fe981833c2534ee8b -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- generic/gentclAPI.decls (.../gentclAPI.decls) (revision a5e4ab3a3f85b51e855adb3fe981833c2534ee8b)
+++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -335,7 +335,7 @@
objectInfoMethod mixinclasses NsfObjInfoMixinclassesMethod {
{-argName "-guards"}
- {-argName "-order"}
+ {-argName "-heritage"}
{-argName "pattern" -type objpattern}
}
objectInfoMethod mixinguard NsfObjInfoMixinguardMethod {
@@ -388,6 +388,7 @@
classInfoMethod mixinclasses NsfClassInfoMixinclassesMethod {
{-argName "-closure"}
{-argName "-guards"}
+ {-argName "-heritage"}
{-argName "pattern" -type objpattern}
}
classInfoMethod mixinguard NsfClassInfoMixinguardMethod {
Index: generic/nsf.c
===================================================================
diff -u -rfff7f83dfdbfca71b59089d3c020275f968cf662 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- generic/nsf.c (.../nsf.c) (revision fff7f83dfdbfca71b59089d3c020275f968cf662)
+++ generic/nsf.c (.../nsf.c) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -18799,22 +18799,25 @@
/*
objectInfoMethod mixinclasses NsfObjInfoMixinclassesMethod {
{-argName "-guards"}
- {-argName "-order"}
+ {-argName "-heritage"}
{-argName "pattern" -type objpattern}
}
+}
*/
static int
NsfObjInfoMixinclassesMethod(Tcl_Interp *interp, NsfObject *object,
- int withGuards, int withOrder,
- CONST char *patternString, NsfObject *patternObj) {
+ int withGuards, int withHeritage,
+ CONST char *patternString, NsfObject *patternObj) {
- if (withOrder) {
+ if (withHeritage) {
if (!(object->flags & NSF_MIXIN_ORDER_VALID)) {
MixinComputeDefined(interp, object);
}
return MixinInfo(interp, object->mixinOrder, patternString, withGuards, patternObj);
}
- return object->opt ? MixinInfo(interp, object->opt->mixins, patternString, withGuards, patternObj) : TCL_OK;
+ return object->opt ?
+ MixinInfo(interp, object->opt->mixins, patternString, withGuards, patternObj) :
+ TCL_OK;
}
/*
@@ -19075,17 +19078,31 @@
classInfoMethod mixinclasses NsfClassInfoMixinclassesMethod {
{-argName "-closure"}
{-argName "-guards"}
+ {-argName "-heritage"}
{-argName "pattern" -type objpattern}
}
*/
static int
NsfClassInfoMixinclassesMethod(Tcl_Interp *interp, NsfClass *class,
- int withClosure, int withGuards,
+ int withClosure, int withGuards, int withHeritage,
CONST char *patternString, NsfObject *patternObj) {
NsfClassOpt *opt = class->opt;
int rc;
- if (withClosure) {
+ if (withHeritage) {
+ NsfClasses *checkList = NULL, *mixinClasses = NULL, *clPtr;
+
+ if (withGuards) {
+ return NsfPrintError(interp, "-guards cannot be used together with -heritage\n");
+ }
+
+ NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);
+ for (clPtr = mixinClasses; clPtr; clPtr = clPtr->nextPtr) {
+ if (NsfClassListFind(clPtr->nextPtr, clPtr->cl)) continue;
+ AppendMatchingElement(interp, clPtr->cl->object.cmdName, patternString);
+ }
+
+ } else if (withClosure) {
Tcl_HashTable objTable, *commandTable = &objTable;
MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable);
Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS);
Index: generic/tclAPI.h
===================================================================
diff -u -ra5e4ab3a3f85b51e855adb3fe981833c2534ee8b -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- generic/tclAPI.h (.../tclAPI.h) (revision a5e4ab3a3f85b51e855adb3fe981833c2534ee8b)
+++ generic/tclAPI.h (.../tclAPI.h) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -287,7 +287,7 @@
static int NsfClassInfoMethodMethod(Tcl_Interp *interp, NsfClass *cl, int infomethodsubcmd, Tcl_Obj *name);
static int NsfClassInfoMethodsMethod(Tcl_Interp *interp, NsfClass *cl, int withCallprotection, int withIncontext, int withMethodtype, int withNomixins, int withPath, CONST char *pattern);
static int NsfClassInfoMixinOfMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withScope, CONST char *patternString, NsfObject *patternObj);
-static int NsfClassInfoMixinclassesMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withGuards, CONST char *patternString, NsfObject *patternObj);
+static int NsfClassInfoMixinclassesMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withGuards, int withHeritage, CONST char *patternString, NsfObject *patternObj);
static int NsfClassInfoMixinguardMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *mixin);
static int NsfClassInfoSubclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, CONST char *patternString, NsfObject *patternObj);
static int NsfClassInfoSuperclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, Tcl_Obj *pattern);
@@ -354,7 +354,7 @@
static int NsfObjInfoLookupSlotsMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType);
static int NsfObjInfoMethodMethod(Tcl_Interp *interp, NsfObject *obj, int infomethodsubcmd, Tcl_Obj *name);
static int NsfObjInfoMethodsMethod(Tcl_Interp *interp, NsfObject *obj, int withCallprotection, int withIncontext, int withMethodtype, int withNomixins, int withPath, CONST char *pattern);
-static int NsfObjInfoMixinclassesMethod(Tcl_Interp *interp, NsfObject *obj, int withGuards, int withOrder, CONST char *patternString, NsfObject *patternObj);
+static int NsfObjInfoMixinclassesMethod(Tcl_Interp *interp, NsfObject *obj, int withGuards, int withHeritage, CONST char *patternString, NsfObject *patternObj);
static int NsfObjInfoMixinguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *mixin);
static int NsfObjInfoParentMethod(Tcl_Interp *interp, NsfObject *obj);
static int NsfObjInfoPrecedenceMethod(Tcl_Interp *interp, NsfObject *obj, int withIntrinsic, CONST char *pattern);
@@ -801,20 +801,21 @@
} else {
int withClosure = (int )PTR2INT(pc.clientData[0]);
int withGuards = (int )PTR2INT(pc.clientData[1]);
+ int withHeritage = (int )PTR2INT(pc.clientData[2]);
CONST char *patternString = NULL;
NsfObject *patternObj = NULL;
- Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2];
+ Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[3];
int returnCode;
- if (GetMatchObject(interp, pattern, objc>2 ? objv[2] : NULL, &patternObj, &patternString) == -1) {
+ if (GetMatchObject(interp, pattern, objc>3 ? objv[3] : NULL, &patternObj, &patternString) == -1) {
if (pattern) {
DECR_REF_COUNT(pattern);
}
return TCL_OK;
}
assert(pc.status == 0);
- returnCode = NsfClassInfoMixinclassesMethod(interp, cl, withClosure, withGuards, patternString, patternObj);
+ returnCode = NsfClassInfoMixinclassesMethod(interp, cl, withClosure, withGuards, withHeritage, patternString, patternObj);
if (pattern) {
DECR_REF_COUNT(pattern);
@@ -2066,7 +2067,7 @@
return TCL_ERROR;
} else {
int withGuards = (int )PTR2INT(pc.clientData[0]);
- int withOrder = (int )PTR2INT(pc.clientData[1]);
+ int withHeritage = (int )PTR2INT(pc.clientData[1]);
CONST char *patternString = NULL;
NsfObject *patternObj = NULL;
Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2];
@@ -2080,7 +2081,7 @@
}
assert(pc.status == 0);
- returnCode = NsfObjInfoMixinclassesMethod(interp, obj, withGuards, withOrder, patternString, patternObj);
+ returnCode = NsfObjInfoMixinclassesMethod(interp, obj, withGuards, withHeritage, patternString, patternObj);
if (pattern) {
DECR_REF_COUNT(pattern);
@@ -2228,9 +2229,10 @@
{"-scope", 0|NSF_ARG_IS_ENUMERATION, 1, ConvertToScope, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
{"pattern", 0, 0, ConvertToObjpattern, NULL,NULL,NULL,NULL,NULL,NULL,NULL}}
},
-{"::nsf::methods::class::info::mixinclasses", NsfClassInfoMixinclassesMethodStub, 3, {
+{"::nsf::methods::class::info::mixinclasses", NsfClassInfoMixinclassesMethodStub, 4, {
{"-closure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
{"-guards", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
+ {"-heritage", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
{"pattern", 0, 0, ConvertToObjpattern, NULL,NULL,NULL,NULL,NULL,NULL,NULL}}
},
{"::nsf::methods::class::info::mixinguard", NsfClassInfoMixinguardMethodStub, 1, {
@@ -2509,7 +2511,7 @@
},
{"::nsf::methods::object::info::mixinclasses", NsfObjInfoMixinclassesMethodStub, 3, {
{"-guards", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
- {"-order", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
+ {"-heritage", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL},
{"pattern", 0, 0, ConvertToObjpattern, NULL,NULL,NULL,NULL,NULL,NULL,NULL}}
},
{"::nsf::methods::object::info::mixinguard", NsfObjInfoMixinguardMethodStub, 1, {
Index: library/xotcl/library/xotcl2.tcl
===================================================================
diff -u -rda6586782390b02ed7660b56417c3db00d63d1c3 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision da6586782390b02ed7660b56417c3db00d63d1c3)
+++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -606,7 +606,13 @@
my {*}$cmd
}
- :alias mixin ::nsf::methods::object::info::mixinclasses
+ :proc mixin {-order:switch -guards:switch pattern:optional} {
+ set cmd ::nsf::methods::object::info::mixinclasses
+ if {$order} {lappend cmd "-heritage"}
+ if {$guards} {lappend cmd "-guards"}
+ if {[info exists pattern]} {lappend cmd $pattern}
+ my {*}$cmd
+ }
:alias mixinguard ::nsf::methods::object::info::mixinguard
:proc nonposargs {method} {::xotcl::info_nonposargs object [self] $method}
:proc parametercmd {name} {::nsf::classes::nx::Object::setter [self] $name}
@@ -659,7 +665,13 @@
}
}
:proc instinvar {} {::nsf::method::assertion [self] class-invar}
- :alias instmixin ::nsf::methods::class::info::mixinclasses
+ :proc instmixin {-order:switch -guards:switch pattern:optional} {
+ set cmd ::nsf::methods::class::info::mixinclasses
+ if {$order} {lappend cmd "-heritage"}
+ if {$guards} {lappend cmd "-guards"}
+ if {[info exists pattern]} {lappend cmd $pattern}
+ my {*}$cmd
+ }
:alias instmixinguard ::nsf::methods::class::info::mixinguard
:proc instmixinof {-closure {pattern ""}} {
my ::nsf::methods::class::info::mixinof -scope class \
Index: tests/info-method.test
===================================================================
diff -u -rf64a1ac7fbc925042840dcac5eb6c2d42509b2f6 -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71
--- tests/info-method.test (.../info-method.test) (revision f64a1ac7fbc925042840dcac5eb6c2d42509b2f6)
+++ tests/info-method.test (.../info-method.test) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71)
@@ -436,25 +436,27 @@
? {A info heritage} "::nx::Object"
? {B info heritage} "::M1 ::A ::nx::Object"
+ ? {B info mixin classes -closure} "::M1"
B mixin M2
? {A info heritage} "::nx::Object"
? {B info heritage} "::M2 ::A ::nx::Object"
+ ? {B info mixin classes -closure} "::M2"
B mixin A
? {A info heritage} "::nx::Object"
? {B info heritage} "::A ::nx::Object"
B mixin C
-
? {A info heritage} "::nx::Object"
? {B info heritage} "::C ::A ::nx::Object"
B mixin ""
-
? {BB info heritage} "::B ::A ::nx::Object"
+
BB mixin CC
? {BB info heritage} "::CC ::C ::B ::A ::nx::Object"
+
BB mixin ""
? {BB info heritage} "::B ::A ::nx::Object"
}
@@ -607,22 +609,7 @@
B mixin {M3 M1 M1 M4}
? {B info heritage} "::M3 ::M1 ::M4 ::M2 ::A ::nx::Object"
-
- # The following looks strange, since the POMS are not at the front
- # of the list. However, we have to deal here with conflicting
- # goals. One one hand side multiple occurances of the same class in
- # the precedence list are handled by keeping just the last
- # occurance. This way, ::nx::Object (with e.g. method delete) is
- # always at the end, although it is part of every class
- # hierarchy. This rule in not compatible with the rule POM before
- # PCM, therefore the classes mixed in by POMS are not at the front
- # of the list.
- #
- puts stderr =====1
- #? {b1 info precedence} "::M3 ::M1 ::M4 ::M2 ::B ::A ::nx::Object"
-
? {b1 info precedence} "::M1 ::M4 ::M3 ::M2 ::B ::A ::nx::Object"
- puts stderr =====2
}
#
@@ -640,12 +627,103 @@
# ::A is an implied class
c1 mixin B
? {c1 info precedence} "::B ::A ::C ::nx::Object"
+ ? {c1 info mixin classes -heritage} "::B ::A"
# ::A is as well implied by ::PCM
C mixin PCM
? {C info heritage} "::PCM ::A ::nx::Object"
+ ? {C info mixin classes} "::PCM"
+ ? {C info mixin classes -order} "" ;# ????
+ ? {C info mixin classes -heritage} "::PCM ::A"
+ ? {C info mixin classes -closure} "::PCM"
# ::A is not ordered after ::B but after ::PCM
? {c1 info precedence} "::B ::PCM ::A ::C ::nx::Object"
+ ? {c1 info mixin classes -heritage} "::B ::PCM ::A"
+}
+#
+# transitive per-class mixins with implied classes
+#
+nx::Test case info-heritage-transitive-pcm {
+ Class create A
+ Class create B -superclass A
+ Class create C -superclass B
+ Class create PCMA -superclass A
+ Class create PCMB -superclass PCMA
+ Class create PCMC -superclass PCMB
+ Class create TPCMA
+ Class create TPCMB -superclass TPCMA
+ C create c1
+
+ ? {C info heritage} "::B ::A ::nx::Object"
+ ? {c1 info precedence} "::C ::B ::A ::nx::Object"
+
+ B mixin PCMB
+
+ # heritage includes implied classes
+ ? {C info heritage} "::PCMB ::PCMA ::B ::A ::nx::Object"
+
+ # precedence includes implied classes from mixins or intrinsic
+ # classes
+ ? {c1 info precedence} "::PCMB ::PCMA ::C ::B ::A ::nx::Object"
+
+ # just the classes mixed explicitly into this class
+ ? {B info mixin classes} "::PCMB"
+ ? {C info mixin classes} ""
+
+ # the classes mixed transitive into this class
+ ? {B info mixin classes -closure} "::PCMB"
+ # since C is a specialization of B, it includes transitively B's closure
+ ? {C info mixin classes -closure} "::PCMB"
+
+ # the explicit and implicit mixin classes
+ ? {B info mixin classes -heritage} "::PCMB ::PCMA ::A"
+ # since C is a specialization of B, it inherits the classes from B
+ ? {C info mixin classes -heritage} "::PCMB ::PCMA ::A"
+
+ PCMB mixin TPCMB
+
+ # heritage includes implied classes
+ ? {C info heritage} "::TPCMB ::TPCMA ::PCMB ::PCMA ::B ::A ::nx::Object"
+
+ # precedence includes implied classes from mixins or intrinsic
+ # classes
+ ? {c1 info precedence} "::TPCMB ::TPCMA ::PCMB ::PCMA ::C ::B ::A ::nx::Object"
+
+ # just the classes mixed explicitly into this class
+ ? {B info mixin classes} "::PCMB"
+ ? {C info mixin classes} ""
+
+ # the classes mixed transitive into this class
+ ? {B info mixin classes -closure} "::PCMB ::TPCMB"
+ # since C is a specialization of B, it includes transitively B's closure
+ ? {C info mixin classes -closure} "::PCMB ::TPCMB"
+
+ # the explicit and implicit mixin classes
+ ? {B info mixin classes -heritage} "::TPCMB ::TPCMA ::PCMB ::PCMA ::A"
+ # since C is a specialization of B, it inherits the classes from B
+ ? {C info mixin classes -heritage} "::TPCMB ::TPCMA ::PCMB ::PCMA ::A"
+
+ C mixin PCMC
+
+ # heritage includes implied classes
+ ? {C info heritage} "::PCMC ::TPCMB ::TPCMA ::PCMB ::PCMA ::B ::A ::nx::Object"
+
+ # precedence includes implied classes from mixins or intrinsic
+ # classes
+ ? {c1 info precedence} "::PCMC ::TPCMB ::TPCMA ::PCMB ::PCMA ::C ::B ::A ::nx::Object"
+
+ # just the classes mixed explicitly into this class
+ ? {B info mixin classes} "::PCMB"
+ ? {C info mixin classes} "::PCMC"
+
+ # the classes mixed transitive into this class
+ ? {B info mixin classes -closure} "::PCMB ::TPCMB"
+ ? {C info mixin classes -closure} "::PCMC ::TPCMB ::PCMB"
+
+ # the explicit and implicit mixin classes
+ ? {B info mixin classes -heritage} "::TPCMB ::TPCMA ::PCMB ::PCMA ::A"
+ ? {C info mixin classes -heritage} "::PCMC ::TPCMB ::TPCMA ::PCMB ::PCMA ::A"
+
}
\ No newline at end of file