diff options
Diffstat (limited to 'generic/tclOO.c')
| -rw-r--r-- | generic/tclOO.c | 16 |
1 files changed, 16 insertions, 0 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index 047b4c5..6ae82d1 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1401,6 +1401,7 @@ Tcl_NewObjectInstance( TCL_NAMESPACE_ONLY)) { Tcl_AppendResult(interp, "can't create object \"", nameStr, "\": command already exists with that name", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return NULL; } @@ -1459,6 +1460,7 @@ Tcl_NewObjectInstance( if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } TclOODeleteContext(contextPtr); @@ -1514,6 +1516,7 @@ TclNRNewObjectInstance( TCL_NAMESPACE_ONLY)) { Tcl_AppendResult(interp, "can't create object \"", nameStr, "\": command already exists with that name", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return TCL_ERROR; } @@ -1592,6 +1595,7 @@ FinalizeAlloc( if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } TclOODeleteContext(contextPtr); @@ -1646,10 +1650,12 @@ Tcl_CopyObjectInstance( if (targetName == NULL && oPtr->classPtr != NULL) { Tcl_AppendResult(interp, "must supply a name when copying a class", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "NO_COPY_TARGET", NULL); return NULL; } if (oPtr->flags & ROOT_CLASS) { Tcl_AppendResult(interp, "may not clone the class of classes", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL); return NULL; } @@ -2265,6 +2271,8 @@ TclOOObjectCmdCore( Tcl_AppendResult(interp, "impossible to invoke method \"", TclGetString(methodNamePtr), "\": no defined method or unknown method", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED", + TclGetString(methodNamePtr), NULL); return TCL_ERROR; } } else { @@ -2279,6 +2287,8 @@ TclOOObjectCmdCore( Tcl_AppendResult(interp, "impossible to invoke method \"", TclGetString(methodNamePtr), "\": no defined method or unknown method", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", + TclGetString(methodNamePtr), NULL); return TCL_ERROR; } } @@ -2304,6 +2314,8 @@ TclOOObjectCmdCore( if (contextPtr->index >= contextPtr->callPtr->numChain) { Tcl_SetResult(interp, "no valid method implementation", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", + TclGetString(methodNamePtr), NULL); TclOODeleteContext(contextPtr); return TCL_ERROR; } @@ -2384,6 +2396,7 @@ Tcl_ObjectContextInvokeNext( Tcl_AppendResult(interp, "no next ", methodType, " implementation", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } @@ -2452,6 +2465,7 @@ TclNRObjectContextInvokeNext( Tcl_AppendResult(interp, "no next ", methodType, " implementation", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } @@ -2529,6 +2543,8 @@ Tcl_GetObjectFromObj( notAnObject: Tcl_AppendResult(interp, TclGetString(objPtr), " does not refer to an object", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr), + NULL); return NULL; } |