diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdAH.c | 10 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 37 |
2 files changed, 41 insertions, 6 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8b5f13d..765c9dc 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -641,6 +641,8 @@ EncodingDirsObjCmd( if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) { Tcl_AppendResult(interp, "expected directory list but got \"", TclGetString(objv[1]), "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH", + NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[1]); @@ -1782,6 +1784,8 @@ PathFilesystemCmd( fsInfo = Tcl_FSFileSystemInfo(objv[1]); if (fsInfo == NULL) { Tcl_SetResult(interp, "unrecognised path", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", + Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, fsInfo); @@ -1933,6 +1937,8 @@ PathSplitCmd( if (res == NULL) { Tcl_AppendResult(interp, "could not read \"", TclGetString(objv[1]), "\": no such file or directory", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", + NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, res); @@ -2032,6 +2038,8 @@ FilesystemSeparatorCmd( if (separatorObj == NULL) { Tcl_SetResult(interp, "unrecognised path", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", + Tcl_GetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, separatorObj); @@ -2586,6 +2594,8 @@ TclNRForeachCmd( &statePtr->varcList[i], &statePtr->varvList[i]); if (statePtr->varcList[i] < 1) { Tcl_AppendResult(interp, "foreach varlist is empty", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH", + "NEEDVARS", NULL); result = TCL_ERROR; goto done; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c42a54b..a6af227 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1515,6 +1515,7 @@ InfoHostnameCmd( return TCL_OK; } Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } @@ -1632,6 +1633,7 @@ InfoLibraryCmd( return TCL_OK; } Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } @@ -2261,11 +2263,11 @@ Tcl_LindexObjCmd( if (elemPtr == NULL) { return TCL_ERROR; - } else { - Tcl_SetObjResult(interp, elemPtr); - Tcl_DecrRefCount(elemPtr); - return TCL_OK; } + + Tcl_SetObjResult(interp, elemPtr); + Tcl_DecrRefCount(elemPtr); + return TCL_OK; } /* @@ -2379,7 +2381,7 @@ Tcl_ListObjCmd( */ if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1])); } return TCL_OK; } @@ -2502,7 +2504,7 @@ Tcl_LrangeObjCmd( if (Tcl_IsShared(objv[1]) || (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1)) { Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1, - &(elemPtrs[first]))); + &elemPtrs[first])); } else { /* * In-place is possible. @@ -2568,6 +2570,7 @@ Tcl_LrepeatObjCmd( if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_Format(NULL, "bad count \"%d\": must be integer >= 0", 1, objv+1)); + Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPEAT","NEGARG", NULL); return TCL_ERROR; } @@ -2588,10 +2591,12 @@ Tcl_LrepeatObjCmd( if (totalElems != 0 && (totalElems/objc != elementCount || totalElems/elementCount != objc)) { Tcl_AppendResult(interp, "too many elements in result list", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (totalElems >= 0x20000000) { Tcl_AppendResult(interp, "too many elements in result list", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } @@ -2707,6 +2712,7 @@ Tcl_LreplaceObjCmd( if ((first >= listLen) && (listLen > 0)) { Tcl_AppendResult(interp, "list doesn't contain element ", TclGetString(objv[2]), NULL); + Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPLACE","BADIDX", NULL); return TCL_ERROR; } if (last >= listLen) { @@ -2987,6 +2993,7 @@ Tcl_LsearchObjCmd( } if (i > objc-4) { Tcl_AppendResult(interp, "missing starting index", NULL); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } @@ -3019,6 +3026,7 @@ Tcl_LsearchObjCmd( Tcl_AppendResult(interp, "\"-index\" option must be followed by list index", NULL); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -3078,12 +3086,16 @@ Tcl_LsearchObjCmd( } Tcl_AppendResult(interp, "-subindices cannot be used without -index option", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); return TCL_ERROR; } if (bisect && (allMatches || negatedMatch)) { Tcl_AppendResult(interp, "-bisect is not compatible with -all or -not", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); return TCL_ERROR; } @@ -3651,6 +3663,7 @@ Tcl_LsortObjCmd( Tcl_AppendResult(interp, "\"-command\" option must be followed " "by comparison command", NULL); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done2; } @@ -3674,6 +3687,7 @@ Tcl_LsortObjCmd( if (i == objc-2) { Tcl_AppendResult(interp, "\"-index\" option must be " "followed by list index", NULL); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done2; } @@ -3723,6 +3737,7 @@ Tcl_LsortObjCmd( if (i == objc-2) { Tcl_AppendResult(interp, "\"-stride\" option must be ", "followed by stride length", NULL); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done2; } @@ -3733,6 +3748,8 @@ Tcl_LsortObjCmd( if (groupSize < 2) { Tcl_AppendResult(interp, "stride length must be at least 2", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADSTRIDE", NULL); sortInfo.resultCode = TCL_ERROR; goto done2; } @@ -3829,6 +3846,8 @@ Tcl_LsortObjCmd( Tcl_AppendResult(interp, "list size must be a multiple of the stride length", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", + NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -3847,6 +3866,8 @@ Tcl_LsortObjCmd( Tcl_AppendResult(interp, "when used with \"-stride\", the " "leading \"-index\" value must be within the group", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADINDEX", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4233,6 +4254,8 @@ SortCompare( Tcl_ResetResult(infoPtr->interp); Tcl_AppendResult(infoPtr->interp, "-compare command returned non-integer result", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return 0; } @@ -4449,6 +4472,8 @@ SelectObjFromSublist( Tcl_AppendResult(infoPtr->interp, "element ", buffer, " missing from sublist \"", TclGetString(objPtr), "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return NULL; } |