summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-08-02 14:58:58 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-08-02 14:58:58 (GMT)
commit6af366a7dcf18d187e53d5e58264b34675b31d22 (patch)
tree04b0c42f187d3fffea23c74b7b1fbc69617420d1
parent2145004977c06c1989ad5ad0ee2d800da3353001 (diff)
downloadtcl-6af366a7dcf18d187e53d5e58264b34675b31d22.zip
tcl-6af366a7dcf18d187e53d5e58264b34675b31d22.tar.gz
tcl-6af366a7dcf18d187e53d5e58264b34675b31d22.tar.bz2
[9d61624b3d]: Stop crashes when emptying the superclass slot.
-rw-r--r--generic/tclOODefineCmds.c48
-rw-r--r--tests/oo.test17
2 files changed, 46 insertions, 19 deletions
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index bacab38..1a5058c 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2206,29 +2206,39 @@ 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;
- }
- 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);
+ if (superc == 0) {
+ superclasses = ckrealloc(superclasses, sizeof(Class *));
+ superclasses[0] = oPtr->fPtr->objectCls;
+ superc = 1;
+ } 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;
+ }
}
}
diff --git a/tests/oo.test b/tests/oo.test
index 49fe150..6f16a8d 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3374,6 +3374,23 @@ test oo-34.8 {TIP 380: slots - presence} {
test oo-34.9 {TIP 380: slots - presence} {
getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}
+
+test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+ oo::class create fruit {
+ method eat {} {}
+ }
+ set result {}
+} -body {
+ lappend result [fruit create ::apple] [info class superclasses fruit]
+ oo::define fruit superclass
+ lappend result [info class superclasses fruit] \
+ [info object class apple oo::object] \
+ [info class call fruit destroy] \
+ [catch { apple }]
+} -cleanup {
+ unset -nocomplain result
+ fruit destroy
+} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
cleanupTests
return