summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdMZ.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r--generic/tclCmdMZ.c42
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) {