summaryrefslogtreecommitdiffstats
path: root/generic/tclOODefineCmds.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-12-30 08:50:28 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-12-30 08:50:28 (GMT)
commit6418dc63fd2459110ec65445bbc611c4aa2e32fe (patch)
tree2af8a18fefd4c3bf00798b38a98ad9839ff87342 /generic/tclOODefineCmds.c
parentdfe92fee6cdcf5ae490fb332111618fbb08a6bdd (diff)
parent1749e8cdf33e8232f22acc08f9ce4301b00ba7eb (diff)
downloadtcl-6418dc63fd2459110ec65445bbc611c4aa2e32fe.zip
tcl-6418dc63fd2459110ec65445bbc611c4aa2e32fe.tar.gz
tcl-6418dc63fd2459110ec65445bbc611c4aa2e32fe.tar.bz2
merge main working branch
Diffstat (limited to 'generic/tclOODefineCmds.c')
-rw-r--r--generic/tclOODefineCmds.c51
1 files changed, 32 insertions, 19 deletions
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index bacab38..5a6c0ad 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,7 +4,7 @@
* This file contains the implementation of the ::oo::define command,
* part of the object-system core (NB: not Tcl_Obj, but ::oo).
*
- * Copyright (c) 2006-2012 by Donal K. Fellows
+ * Copyright (c) 2006-2013 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -2206,29 +2206,42 @@ ClassSuperSet(
/*
* Parse the arguments to get the class to use as superclasses.
+ *
+ * Note that zero classes is special, as it is equivalent to just the
+ * class of objects. [Bug 9d61624b3d]
*/
- for (i=0 ; i<superc ; i++) {
- superclasses[i] = GetClassInOuterContext(interp, superv[i],
- "only a class can be a superclass");
- if (superclasses[i] == NULL) {
- goto failedAfterAlloc;
+ if (superc == 0) {
+ superclasses = ckrealloc(superclasses, sizeof(Class *));
+ superclasses[0] = oPtr->fPtr->objectCls;
+ superc = 1;
+ if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
+ superclasses[0] = oPtr->fPtr->classCls;
}
- for (j=0 ; j<i ; j++) {
- if (superclasses[j] == superclasses[i]) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "class should only be a direct superclass once", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
+ } else {
+ for (i=0 ; i<superc ; i++) {
+ superclasses[i] = GetClassInOuterContext(interp, superv[i],
+ "only a class can be a superclass");
+ if (superclasses[i] == NULL) {
goto failedAfterAlloc;
}
- }
- if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "attempt to form circular dependency graph", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
- failedAfterAlloc:
- ckfree((char *) superclasses);
- return TCL_ERROR;
+ for (j=0 ; j<i ; j++) {
+ if (superclasses[j] == superclasses[i]) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "class should only be a direct superclass once",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+ goto failedAfterAlloc;
+ }
+ }
+ if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to form circular dependency graph", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
+ failedAfterAlloc:
+ ckfree((char *) superclasses);
+ return TCL_ERROR;
+ }
}
}