diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
| -rw-r--r-- | generic/tclCmdMZ.c | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e39ae06..61de8de 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1794,6 +1794,8 @@ StringMapCmd( } else { Tcl_AppendResult(interp, "bad option \"", string, "\": must be -nocase", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } } @@ -1856,6 +1858,8 @@ StringMapCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("char map list unbalanced", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP", + "UNBALANCED", NULL); return TCL_ERROR; } } @@ -2057,6 +2061,8 @@ StringMatchCmd( } else { Tcl_AppendResult(interp, "bad option \"", string, "\": must be -nocase", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } } @@ -2189,6 +2195,7 @@ StringReptCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "result exceeds max size for a Tcl value (%d bytes)", INT_MAX)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } length2 = length1 * count; @@ -2209,6 +2216,7 @@ StringReptCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow, out of memory allocating %u bytes", length2 + 1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } for (index = 0; index < count; index++) { @@ -2514,6 +2522,8 @@ StringEqualCmd( } else { Tcl_AppendResult(interp, "bad option \"", string2, "\": must be -nocase or -length", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string2, NULL); return TCL_ERROR; } } @@ -2661,6 +2671,8 @@ StringCmpCmd( } else { Tcl_AppendResult(interp, "bad option \"", string2, "\": must be -nocase or -length", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string2, NULL); return TCL_ERROR; } } @@ -3558,6 +3570,8 @@ TclNRSwitchObjCmd( Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]), "\": ", options[mode], " option already found", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "DOUBLEOPT", NULL); return TCL_ERROR; } foundmode = 1; @@ -3574,6 +3588,8 @@ TclNRSwitchObjCmd( if (i >= objc-2) { Tcl_AppendResult(interp, "missing variable name argument to ", "-indexvar", " option", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "NOVAR", NULL); return TCL_ERROR; } indexVarObj = objv[i]; @@ -3584,6 +3600,8 @@ TclNRSwitchObjCmd( if (i >= objc-2) { Tcl_AppendResult(interp, "missing variable name argument to ", "-matchvar", " option", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "NOVAR", NULL); return TCL_ERROR; } matchVarObj = objv[i]; @@ -3601,11 +3619,15 @@ TclNRSwitchObjCmd( if (indexVarObj != NULL && mode != OPT_REGEXP) { Tcl_AppendResult(interp, "-indexvar option requires -regexp option", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "MODERESTRICTION", NULL); return TCL_ERROR; } if (matchVarObj != NULL && mode != OPT_REGEXP) { Tcl_AppendResult(interp, "-matchvar option requires -regexp option", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "MODERESTRICTION", NULL); return TCL_ERROR; } @@ -3653,6 +3675,8 @@ TclNRSwitchObjCmd( if (objc % 2) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "extra switch pattern with no body", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", + NULL); /* * Check if this can be due to a badly placed comment in the switch @@ -3669,6 +3693,8 @@ TclNRSwitchObjCmd( "comment incorrectly placed outside of a " "switch body - see the \"switch\" " "documentation", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", + "BADARM", "COMMENT?", NULL); break; } } @@ -3686,6 +3712,8 @@ TclNRSwitchObjCmd( Tcl_ResetResult(interp); Tcl_AppendResult(interp, "no body specified for pattern \"", TclGetString(objv[objc-2]), "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", + "FALLTHROUGH", NULL); return TCL_ERROR; } @@ -4006,6 +4034,8 @@ Tcl_ThrowObjCmd( return TCL_ERROR; } else if (len < 1) { Tcl_AppendResult(interp, "type must be non-empty list", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", + NULL); return TCL_ERROR; } @@ -4189,12 +4219,16 @@ TclNRTryObjCmd( if (i < objc-2) { Tcl_AppendResult(interp, "finally clause must be last", NULL); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", + "NONTERMINAL", NULL); return TCL_ERROR; } else if (i == objc-1) { Tcl_AppendResult(interp, "wrong # args to finally clause: ", "must be \"", TclGetString(objv[0]), " ... finally script\"", NULL); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", + "ARGUMENT", NULL); return TCL_ERROR; } finallyObj = objv[++i]; @@ -4206,6 +4240,8 @@ TclNRTryObjCmd( "must be \"", TclGetString(objv[0]), " ... on code variableList script\"", NULL); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", + "ARGUMENT", NULL); return TCL_ERROR; } if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) { @@ -4221,6 +4257,8 @@ TclNRTryObjCmd( "must be \"... trap pattern variableList script\"", NULL); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", + "ARGUMENT", NULL); return TCL_ERROR; } code = 1; @@ -4229,6 +4267,8 @@ TclNRTryObjCmd( "bad prefix '%s': must be a list", Tcl_GetString(objv[i+1]))); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", + "EXNFORMAT", NULL); return TCL_ERROR; } info[2] = objv[i+1]; @@ -4260,6 +4300,8 @@ TclNRTryObjCmd( "last non-finally clause must not have a body of \"-\"", NULL); Tcl_DecrRefCount(handlersObj); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", + NULL); return TCL_ERROR; } if (!haveHandlers) { |