More generation of error codes (namespace creation, path normalization,

pipeline creation, package handling, procedures, [scan] formats)

10 files changed, 141 insertions, 41 deletions

diff --git a/ChangeLog b/ChangeLog
index 23b3f1e..b734896 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-03  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
+	* generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
+	* generic/tclScan.c: More generation of error codes (namespace
+	creation, path normalization, pipeline creation, package handling,
+	procedures, [scan] formats)
+
 2011-04-02  Kevin B. Kenny  <kennykb@acm.org>
 
 	* generic/tclStrToD.c (QuickConversion): Replaced another couple
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 3a08221..45b9f6d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -690,6 +690,8 @@ Tcl_CreateNamespace(
 	Tcl_ResetResult(interp);
 	Tcl_AppendResult(interp, "can't create namespace \"\": "
 		"only global namespace can have empty name", NULL);
+        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+                "CREATEGLOBAL", NULL);
 	return NULL;
     } else {
 	/*
@@ -725,6 +727,8 @@ Tcl_CreateNamespace(
 	) {
 	    Tcl_AppendResult(interp, "can't create namespace \"", name,
 		    "\": already exists", NULL);
+            Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
+                    "CREATEEXISTING", NULL);
 	    return NULL;
 	}
     }
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 321ed67..630226f 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2265,6 +2265,8 @@ Tcl_GetDoubleFromObj(
 		if (interp != NULL) {
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			    "floating point value is Not a Number", -1));
+                    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
+                            NULL);
 		}
 		return TCL_ERROR;
 	    }
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 81007a2..01a297b 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1523,6 +1523,8 @@ TclFSMakePathFromNormalized(
 		    Tcl_ResetResult(interp);
 		    Tcl_AppendResult(interp, "can't find object"
 			    "string representation", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
+			    NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -2423,6 +2425,8 @@ SetFsPathFromAny(
 		    Tcl_ResetResult(interp);
 		    Tcl_AppendResult(interp, "couldn't find HOME environment "
 			    "variable to expand path", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+			    "HOMELESS", NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -2440,6 +2444,8 @@ SetFsPathFromAny(
 		    Tcl_ResetResult(interp);
 		    Tcl_AppendResult(interp, "user \"", name+1,
 			    "\" doesn't exist", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+			    NULL);
 		}
 		Tcl_DStringFree(&temp);
 		if (split != len) {
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index c24d136..5f59c38 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -109,6 +109,8 @@ FileForRedirect(
 		Tcl_AppendResult(interp, "channel \"",
 			Tcl_GetChannelName(chan), "\" wasn't opened for ",
 			((writing) ? "writing" : "reading"), NULL);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			"BADCHAN", NULL);
 	    }
 	    return NULL;
 	}
@@ -151,6 +153,7 @@ FileForRedirect(
   badLastArg:
     Tcl_AppendResult(interp, "can't specify \"", arg,
 	    "\" as last word in command", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
     return NULL;
 }
 
@@ -342,6 +345,8 @@ TclCleanupChildren(
 		} else {
 		    Tcl_AppendResult(interp,
 			    "child wait status didn't make sense\n", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "ODDWAITRESULT", msg1, NULL);
 		}
 	    }
 	}
@@ -539,6 +544,8 @@ TclCreatePipeline(
 		if ((i == (lastBar + 1)) || (i == (argc - 1))) {
 		    Tcl_SetResult(interp, "illegal use of | or |& in command",
 			    TCL_STATIC);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "PIPESYNTAX", NULL);
 		    goto error;
 		}
 	    }
@@ -565,6 +572,8 @@ TclCreatePipeline(
 		    if (inputLiteral == NULL) {
 			Tcl_AppendResult(interp, "can't specify \"", argv[i],
 				"\" as last word in command", NULL);
+			Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+				"PIPESYNTAX", NULL);
 			goto error;
 		    }
 		    skip = 2;
@@ -673,6 +682,8 @@ TclCreatePipeline(
 		if (i != argc-1) {
 		    Tcl_AppendResult(interp, "must specify \"", argv[i],
 			    "\" as last word in command", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+			    "PIPESYNTAX", NULL);
 		    goto error;
 		}
 		errorFile = outputFile;
@@ -713,6 +724,8 @@ TclCreatePipeline(
 
 	Tcl_SetResult(interp, "illegal use of | or |& in command",
 		TCL_STATIC);
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
+		NULL);
 	goto error;
     }
 
@@ -1063,11 +1076,15 @@ Tcl_OpenCommandChannel(
 	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
 	    Tcl_AppendResult(interp, "can't read output from command:"
 		    " standard output was redirected", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+		    "BADREDIRECT", NULL);
 	    goto error;
 	}
 	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
 	    Tcl_AppendResult(interp, "can't write input to command:"
 		    " standard input was redirected", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
+		    "BADREDIRECT", NULL);
 	    goto error;
 	}
     }
@@ -1078,6 +1095,7 @@ Tcl_OpenCommandChannel(
     if (channel == NULL) {
 	Tcl_AppendResult(interp, "pipe for command could not be created",
 		NULL);
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
 	goto error;
     }
     return channel;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 53be4af..67503cb 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -156,6 +156,7 @@ Tcl_PkgProvideEx(
     }
     Tcl_AppendResult(interp, "conflicting versions provided for package \"",
 	    name, "\": ", pkgPtr->version, ", then ", version, NULL);
+    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
     return TCL_ERROR;
 }
 
@@ -286,6 +287,7 @@ Tcl_PkgRequireEx(
 	Tcl_AppendResult(interp, "Cannot load package \"", name,
 		"\" in standalone executable: This package is not "
 		"compiled with stub support", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
 	return NULL;
     }
 
@@ -376,6 +378,7 @@ PkgRequireCore(
 		    "attempt to provide ", name, " ",
 		    (char *) pkgPtr->clientData, " requires ", name, NULL);
 	    AddRequirementsToResult(interp, reqc, reqv);
+	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
 	    return NULL;
 	}
 
@@ -422,7 +425,9 @@ PkgRequireCore(
 		}
 	    }
 
-	    /* We have found a version which is better than our max. */
+	    /*
+	     * We have found a version which is better than our max.
+	     */
 
 	    if (reqc > 0) {
 		/* Check satisfaction of requirements. */
@@ -493,6 +498,8 @@ PkgRequireCore(
 			    name, " ", versionToProvide,
 			    " failed: no version of package ", name,
 			    " provided", NULL);
+		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
+			    NULL);
 		} else {
 		    char *pvi, *vi;
 
@@ -515,6 +522,8 @@ PkgRequireCore(
 				    versionToProvide, " failed: package ",
 				    name, " ", pkgPtr->version,
 				    " provided instead", NULL);
+			    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
+				    "WRONGPROVIDE", NULL);
 			}
 		    }
 		}
@@ -525,6 +534,7 @@ PkgRequireCore(
 		Tcl_AppendResult(interp, "attempt to provide package ", name,
 			" ", versionToProvide, " failed: bad return code: ",
 			TclGetString(codePtr), NULL);
+		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
 		TclDecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
@@ -582,9 +592,11 @@ PkgRequireCore(
 
 	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
 		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
+
 		Tcl_ResetResult(interp);
 		Tcl_AppendResult(interp, "bad return code: ",
 			TclGetString(codePtr), NULL);
+		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
 		Tcl_DecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
@@ -599,6 +611,7 @@ PkgRequireCore(
 
     if (pkgPtr->version == NULL) {
 	Tcl_AppendResult(interp, "can't find package ", name, NULL);
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
 	AddRequirementsToResult(interp, reqc, reqv);
 	return NULL;
     }
@@ -608,27 +621,28 @@ PkgRequireCore(
      * provided version meets the current requirements.
      */
 
-    if (reqc == 0) {
-	satisfies = 1;
-    } else {
+    if (reqc != 0) {
 	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
 	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
 
 	ckfree(pkgVersionI);
-    }
 
-    if (satisfies) {
-	if (clientDataPtr) {
-		const void **ptr = (const void **) clientDataPtr;
-	    *ptr = pkgPtr->clientData;
+	if (!satisfies) {
+	    Tcl_AppendResult(interp, "version conflict for package \"", name,
+		    "\": have ", pkgPtr->version, ", need", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
+		    NULL);
+	    AddRequirementsToResult(interp, reqc, reqv);
+	    return NULL;
 	}
-	return pkgPtr->version;
     }
 
-    Tcl_AppendResult(interp, "version conflict for package \"", name,
-	    "\": have ", pkgPtr->version, ", need", NULL);
-    AddRequirementsToResult(interp, reqc, reqv);
-    return NULL;
+    if (clientDataPtr) {
+	const void **ptr = (const void **) clientDataPtr;
+
+	*ptr = pkgPtr->clientData;
+    }
+    return pkgPtr->version;
 }
 
 /*
@@ -1328,6 +1342,7 @@ CheckVersionAndConvert(
     ckfree(ibuf);
     Tcl_AppendResult(interp, "expected version number but got \"", string,
 	    "\"", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
     return TCL_ERROR;
 }
 
@@ -1590,6 +1605,7 @@ CheckRequirement(
 
 	Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
 		string, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 6cd5bb2..9f4ba29 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -154,11 +154,13 @@ Tcl_ProcObjCmd(
     if (nsPtr == NULL) {
 	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
 		"\": unknown namespace", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
     if (procName == NULL) {
 	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
 		"\": bad procedure name", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
     if ((nsPtr != iPtr->globalNsPtr)
@@ -166,6 +168,7 @@ Tcl_ProcObjCmd(
 	Tcl_AppendResult(interp, "can't create procedure \"", procName,
 		"\" in non-global namespace with name starting with \":\"",
 		NULL);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
 
@@ -490,6 +493,8 @@ TclCreateProc(
 		    "procedure \"%s\": arg list contains %d entries, "
 		    "precompiled header expects %d", procName, numArgs,
 		    procPtr->numArgs));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		    "BYTECODELIES", NULL);
 	    goto procError;
 	}
 	localPtr = procPtr->firstLocalPtr;
@@ -516,11 +521,15 @@ TclCreateProc(
 	    Tcl_AppendResult(interp,
 		    "too many fields in argument specifier \"",
 		    argArray[i], "\"", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		    "FORMALARGUMENTFORMAT", NULL);
 	    goto procError;
 	}
 	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
 	    ckfree(fieldValues);
 	    Tcl_AppendResult(interp, "argument with no name", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+		    "FORMALARGUMENTFORMAT", NULL);
 	    goto procError;
 	}
 
@@ -547,12 +556,16 @@ TclCreateProc(
 		    Tcl_AppendResult(interp, "formal parameter \"",
 			    fieldValues[0], "\" is an array element", NULL);
 		    ckfree(fieldValues);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			    "FORMALARGUMENTFORMAT", NULL);
 		    goto procError;
 		}
 	    } else if ((*p == ':') && (*(p+1) == ':')) {
 		Tcl_AppendResult(interp, "formal parameter \"",
 			fieldValues[0], "\" is not a simple name", NULL);
 		ckfree(fieldValues);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"FORMALARGUMENTFORMAT", NULL);
 		goto procError;
 	    }
 	    p++;
@@ -580,6 +593,8 @@ TclCreateProc(
 			"procedure \"%s\": formal parameter %d is "
 			"inconsistent with precompiled body", procName, i));
 		ckfree(fieldValues);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"BYTECODELIES", NULL);
 		goto procError;
 	    }
 
@@ -599,6 +614,8 @@ TclCreateProc(
 			    "default value inconsistent with precompiled body",
 			    procName, fieldValues[0]));
 		    ckfree(fieldValues);
+		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			    "BYTECODELIES", NULL);
 		    goto procError;
 		}
 	    }
@@ -752,6 +769,7 @@ TclGetFrame(
   levelError:
     Tcl_ResetResult(interp);
     Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
     return -1;
 }
 
@@ -884,7 +902,7 @@ TclObjGetFrame(
   levelError:
     Tcl_ResetResult(interp);
     Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
     return -1;
 }
 
@@ -1863,6 +1881,7 @@ InterpProcNR2(
 	Tcl_AppendResult(interp, "invoked \"",
 		((result == TCL_BREAK) ? "break" : "continue"),
 		"\" outside of a loop", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
 	result = TCL_ERROR;
 
 	/*
@@ -1980,6 +1999,8 @@ TclProcCompileProc(
 	    if ((Interp *) *codePtr->interpHandle != iPtr) {
 		Tcl_AppendResult(interp,
 			"a precompiled script jumped interps", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+			"CROSSINTERPBYTECODE", NULL);
 		return TCL_ERROR;
 	    }
 	    codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2468,6 +2489,7 @@ SetLambdaFromAny(
 	Tcl_AppendObjToObj(errPtr, objPtr);
 	Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
 	Tcl_SetObjResult(interp, errPtr);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
 	return TCL_ERROR;
     }
 
@@ -2893,26 +2915,28 @@ Tcl_DisassembleObjCmd(
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
 	    return TCL_ERROR;
-	} else {
-	    procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
-	    if (procPtr == NULL) {
-		Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
-			"\" isn't a procedure", NULL);
-		return TCL_ERROR;
-	    }
+	}
 
-	    /*
-	     * Compile (if uncompiled) and disassemble a procedure.
-	     */
+	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+	if (procPtr == NULL) {
+	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
+		    "\" isn't a procedure", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
 
-	    result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    TclPopStackFrame(interp);
-	    codeObjPtr = procPtr->bodyPtr;
-	    break;
+	/*
+	 * Compile (if uncompiled) and disassemble a procedure.
+	 */
+
+	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+	if (result != TCL_OK) {
+	    return result;
 	}
+	TclPopStackFrame(interp);
+	codeObjPtr = procPtr->bodyPtr;
+	break;
     case DISAS_SCRIPT:
 	/*
 	 * Compile and disassemble a script.
@@ -2947,6 +2971,8 @@ Tcl_DisassembleObjCmd(
 	if (oPtr->classPtr == NULL) {
 	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
 		    "\" is not a class", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+		    TclGetString(objv[2]), NULL);
 	    return TCL_ERROR;
 	}
 	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
@@ -2980,12 +3006,16 @@ Tcl_DisassembleObjCmd(
 	unknownMethod:
 	    Tcl_AppendResult(interp, "unknown method \"",
 		    TclGetString(objv[3]), "\"", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		    TclGetString(objv[3]), NULL);
 	    return TCL_ERROR;
 	}
 	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
 	if (procPtr == NULL) {
 	    Tcl_AppendResult(interp,
 		    "body not available for this kind of method", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "METHODTYPE", NULL);
 	    return TCL_ERROR;
 	}
 	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
@@ -3019,6 +3049,8 @@ Tcl_DisassembleObjCmd(
     if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
 	    & TCL_BYTECODE_PRECOMPILED) {
 	Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		"BYTECODE", NULL);
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
diff --git a/generic/tclResult.c b/generic/tclResult.c
index fad3b82..6a71ee2 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1487,9 +1487,10 @@ TclMergeReturnOptions(
 	     */
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "bad -errorstack value: "
-			     "expected a list but got \"",
-			     TclGetString(valuePtr), "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", NULL);
+		    "expected a list but got \"", TclGetString(valuePtr),
+                    "\"", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
+                    NULL);
 	    goto error;
 	}
         if (length % 2) {
@@ -1497,9 +1498,11 @@ TclMergeReturnOptions(
              * Errorstack must always be an even-sized list
              */
             Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "forbidden odd-sized list for -errorstack: \"",
-			     TclGetString(valuePtr), "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", NULL);
+	    Tcl_AppendResult(interp,
+                    "forbidden odd-sized list for -errorstack: \"",
+		    TclGetString(valuePtr), "\"", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
+                    "ODDSIZEDLIST_ERRORSTACK", NULL);
 	    goto error;
         }
     }
diff --git a/generic/tclScan.c b/generic/tclScan.c
index c862be4..68b8d21 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -331,6 +331,7 @@ ValidateFormat(
 	    Tcl_SetResult(interp,
 		    "cannot mix \"%\" and \"%n$\" conversion specifiers",
 		    TCL_STATIC);
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
 	    goto error;
 	}
 
@@ -377,6 +378,7 @@ ValidateFormat(
 		Tcl_SetResult(interp,
 			"field width may not be specified in %c conversion",
 			TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
 		goto error;
 	    }
 	    /*
@@ -390,6 +392,7 @@ ValidateFormat(
 		Tcl_AppendResult(interp,
 			"field size modifier may not be specified in %", buf,
 			" conversion", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
 		goto error;
 	    }
 	    /*
@@ -408,6 +411,7 @@ ValidateFormat(
 	    if (flags & SCAN_BIG) {
 		Tcl_SetResult(interp,
 			"unsigned bignum scans are invalid", TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
 		goto error;
 	    }
 	    break;
@@ -444,11 +448,13 @@ ValidateFormat(
 	badSet:
 	    Tcl_SetResult(interp, "unmatched [ in format string",
 		    TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
 	    goto error;
 	default:
 	    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
 	    Tcl_AppendResult(interp, "bad scan conversion character \"", buf,
 		    "\"", NULL);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
 	    goto error;
 	}
 	if (!(flags & SCAN_SUPPRESS)) {
@@ -495,6 +501,7 @@ ValidateFormat(
 	    Tcl_SetResult(interp,
 		    "variable is assigned by multiple \"%n$\" conversion specifiers",
 		    TCL_STATIC);
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
 	    goto error;
 	} else if (!xpgSize && (nassign[i] == 0)) {
 	    /*
@@ -505,6 +512,7 @@ ValidateFormat(
 	    Tcl_SetResult(interp,
 		    "variable is not assigned by any conversion specifiers",
 		    TCL_STATIC);
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
 	    goto error;
 	}
     }
@@ -516,10 +524,12 @@ ValidateFormat(
     if (gotXpg) {
 	Tcl_SetResult(interp, "\"%n$\" argument index out of range",
 		TCL_STATIC);
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
     } else {
 	Tcl_SetResult(interp,
 		"different numbers of variable names and field specifiers",
 		TCL_STATIC);
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
     }
 
   error:
@@ -991,6 +1001,7 @@ Tcl_ScanObjCmd(
 		continue;
 	    }
 	    result++;
+#warning Why make your own error message? Why?
 	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
 		Tcl_AppendResult(interp, "couldn't set variable \"",
 			TclGetString(objv[i+3]), "\"", NULL);
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index c83d174..82f83db 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -386,13 +386,13 @@ test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
     set f [open $path(test4) w]
     close $f
     list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
-} {1 {can't write input to command: standard input was redirected} NONE}
+} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
 test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
     list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
 test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
     list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
 test iocmd-11.4 {I/O to command pipelines} unixOrPc {
     list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
 } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}