More generation of error codes (miscellaneous commands mostly already handled).

3 files changed, 46 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index bbff697..5f66c86 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-04-04  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error
+	codes (miscellaneous commands mostly already handled).
+
 2011-04-04  Don Porter  <dgp@users.sourceforge.net>
 
 	* README:	Updated README files, repairing broken URLs and
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;
 	}