diff options
author | dkf <dkf@noemail.net> | 2008-06-19 21:29:02 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2008-06-19 21:29:02 (GMT) |
commit | 8df420bbec0f183d56a734ef3536aceaf025f427 (patch) | |
tree | 9865c18bcd5f93f18cbc931b62b13c329a89b915 /generic/tclOO.c | |
parent | 79c39521fd052784464f15d63c4bb87843108c0e (diff) | |
download | tcl-8df420bbec0f183d56a734ef3536aceaf025f427.zip tcl-8df420bbec0f183d56a734ef3536aceaf025f427.tar.gz tcl-8df420bbec0f183d56a734ef3536aceaf025f427.tar.bz2 |
Make [next] work as described in TIP. [Bug 1998244]
FossilOrigin-Name: 3f569d031dc3ed31a4742aea81fce39cbbe64968
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r-- | generic/tclOO.c | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index 667210b..2b892af 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.8 2008/06/12 06:29:17 das Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.9 2008/06/19 21:29:03 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1952,13 +1952,22 @@ Tcl_ObjectContextInvokeNext( if (contextPtr->index+1 >= contextPtr->callPtr->numChain) { /* - * We're at the end of the chain; return the empty string (the most - * useful thing we can do, since it turns out that it's not always - * trivial to detect in source code whether there is a parent - * implementation, what with multiple-inheritance...) + * We're at the end of the chain; generate an error message. */ - return TCL_OK; + const char *methodType; + + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + methodType = "constructor"; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + methodType = "destructor"; + } else { + methodType = "method"; + } + + Tcl_AppendResult(interp, "no next ", methodType, " implementation", + NULL); + return TCL_ERROR; } /* |