diff options
| -rw-r--r-- | generic/tclOODefineCmds.c | 48 | ||||
| -rw-r--r-- | tests/oo.test | 17 |
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 |