diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-01-19 18:39:24 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-01-19 18:39:24 (GMT) |
commit | ab8fd1e3f28322c8d57229cd2e171fea351097af (patch) | |
tree | abee7f49bda59eace40abb8b402bd718359b2299 /generic/tclOOBasic.c | |
parent | 8bb7405765b9aed27270dfd145037e3c5884a34a (diff) | |
download | tcl-ab8fd1e3f28322c8d57229cd2e171fea351097af.zip tcl-ab8fd1e3f28322c8d57229cd2e171fea351097af.tar.gz tcl-ab8fd1e3f28322c8d57229cd2e171fea351097af.tar.bz2 |
added compilation for [nextto]
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r-- | generic/tclOOBasic.c | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 6084cf2..0b0516b 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -821,6 +821,7 @@ TclOONextToObjCmd( CallContext *contextPtr; int i; Tcl_Object object; + const char *methodType; /* * Start with sanity checks on the calling context to make sure that we @@ -886,19 +887,30 @@ TclOONextToObjCmd( * is on the chain but unreachable, or not on the chain at all. */ + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + methodType = "constructor"; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + methodType = "destructor"; + } else { + methodType = "method"; + } + for (i=contextPtr->index ; i>=0 ; i--) { struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "method implementation by \"%s\" not reachable from here", - TclGetString(objv[1]))); + "%s implementation by \"%s\" not reachable from here", + methodType, TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", + NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "method has no non-filter implementation by \"%s\"", - TclGetString(objv[1]))); + "%s has no non-filter implementation by \"%s\"", + methodType, TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL); return TCL_ERROR; } |