diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-01-25 09:02:30 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-01-25 09:02:30 (GMT) |
| commit | f4549b8fc40b29db66113e7a63678f2f0c45db78 (patch) | |
| tree | 6850ff329261da488e14891e203120b8b8bc9a15 /generic/tclOOBasic.c | |
| parent | 12945e9a1687504978a49e6a8739ea3f1b20b02e (diff) | |
| parent | c9ae8d64d39dac7abeb842bc20b20d955e7d7b63 (diff) | |
| download | tcl-f4549b8fc40b29db66113e7a63678f2f0c45db78.zip tcl-f4549b8fc40b29db66113e7a63678f2f0c45db78.tar.gz tcl-f4549b8fc40b29db66113e7a63678f2f0c45db78.tar.bz2 | |
merge principal development branch
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; } |