diff options
author | dkf <dkf@noemail.net> | 2011-04-04 22:53:26 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2011-04-04 22:53:26 (GMT) |
commit | 3a411df191c09f5ec451fdecaa4b6dce075c48db (patch) | |
tree | b63e806ef1238d4d4a16441419f7a6625fd66c33 /generic/tclOODefineCmds.c | |
parent | 83e19c30446d2c15a632f16df1a29b59a2b0f110 (diff) | |
download | tcl-3a411df191c09f5ec451fdecaa4b6dce075c48db.zip tcl-3a411df191c09f5ec451fdecaa4b6dce075c48db.tar.gz tcl-3a411df191c09f5ec451fdecaa4b6dce075c48db.tar.bz2 |
More generation of error codes (TclOO miscellany).
FossilOrigin-Name: 08998a4f586f1580b406fb7ede45dccddbeebeb5
Diffstat (limited to 'generic/tclOODefineCmds.c')
-rw-r--r-- | generic/tclOODefineCmds.c | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 8d8eb85..72732da 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -342,6 +342,8 @@ RenameDeleteMethod( noSuchMethod: Tcl_AppendResult(interp, "method ", TclGetString(fromPtr), " does not exist", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", + TclGetString(fromPtr), NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr); @@ -355,11 +357,13 @@ RenameDeleteMethod( renameToSelf: Tcl_AppendResult(interp, "cannot rename method to itself", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: Tcl_AppendResult(interp, "method called ", TclGetString(toPtr), " already exists", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL); return TCL_ERROR; } } @@ -427,6 +431,7 @@ TclOOUnknownDefinition( if (objc < 2) { Tcl_AppendResult(interp, "bad call of unknown handler", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { @@ -471,6 +476,7 @@ TclOOUnknownDefinition( noMatch: Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL); return TCL_ERROR; } @@ -560,6 +566,7 @@ InitDefineContext( Tcl_AppendResult(interp, "cannot process definitions; support namespace deleted", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -598,6 +605,7 @@ TclOOGetDefineCmdContext( Tcl_AppendResult(interp, "this command may only be called from within" " the context of an ::oo::define or ::oo::objdefine command", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } return (Tcl_Object) iPtr->varFramePtr->clientData; @@ -638,6 +646,8 @@ GetClassInOuterContext( } if (oPtr->classPtr == NULL) { Tcl_AppendResult(interp, errMsg, NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", + TclGetString(className), NULL); return NULL; } return oPtr->classPtr; @@ -679,6 +689,8 @@ TclOODefineObjCmd( if (oPtr->classPtr == NULL) { Tcl_AppendResult(interp, TclGetString(objv[1]), " does not refer to a class", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", + TclGetString(objv[1]), NULL); return TCL_ERROR; } @@ -1038,11 +1050,13 @@ TclOODefineClassObjCmd( if (oPtr->flags & ROOT_OBJECT) { Tcl_AppendResult(interp, "may not modify the class of the root object class", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { Tcl_AppendResult(interp, "may not modify the class of the class of classes", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1070,6 +1084,7 @@ TclOODefineClassObjCmd( Tcl_AppendResult(interp, "may not change a ", (oPtr->classPtr==NULL ? "non-" : ""), "class object into a ", (oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL); return TCL_ERROR; } @@ -1190,6 +1205,7 @@ TclOODefineDeleteMethodObjCmd( } if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1312,6 +1328,7 @@ TclOODefineExportObjCmd( clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1393,6 +1410,7 @@ TclOODefineFilterObjCmd( } if (!isInstanceFilter && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1438,6 +1456,7 @@ TclOODefineForwardObjCmd( } if (!isInstanceForward && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*") @@ -1494,6 +1513,7 @@ TclOODefineMethodObjCmd( } if (!isInstanceMethod && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*") @@ -1544,6 +1564,7 @@ TclOODefineMixinObjCmd( } if (!isInstanceMixin && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1)); @@ -1557,6 +1578,7 @@ TclOODefineMixinObjCmd( } if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) { Tcl_AppendResult(interp, "may not mix a class into itself", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } mixins[i-1] = clsPtr; @@ -1607,6 +1629,7 @@ TclOODefineRenameMethodObjCmd( } if (!isInstanceRenameMethod && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1667,11 +1690,13 @@ TclOODefineSuperclassObjCmd( if (oPtr->classPtr == NULL) { Tcl_AppendResult(interp, "only classes may have superclasses defined", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "OBJECT_NOT_CLASS", NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_OBJECT) { Tcl_AppendResult(interp, "may not modify the superclass of the root object", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1696,12 +1721,14 @@ TclOODefineSuperclassObjCmd( if (superclasses[j] == clsPtr) { Tcl_AppendResult(interp, "class should only be a direct superclass once",NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL); goto failedAfterAlloc; } } if (TclOOIsReachable(oPtr->classPtr, clsPtr)) { Tcl_AppendResult(interp, "attempt to form circular dependency graph", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: ckfree(superclasses); return TCL_ERROR; @@ -1768,6 +1795,7 @@ TclOODefineUnexportObjCmd( clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1851,6 +1879,7 @@ TclOODefineVariablesObjCmd( } if (!isInstanceVars && !oPtr->classPtr) { Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1861,11 +1890,13 @@ TclOODefineVariablesObjCmd( Tcl_AppendResult(interp, "invalid declared variable name \"", varName, "\": must not contain namespace separators", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { Tcl_AppendResult(interp, "invalid declared variable name \"", varName, "\": must not refer to an array element", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } } |