Generate errorcodes for more cases.

7 files changed, 57 insertions, 12 deletions

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 666cf46..1212dac 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDictObj.c,v 1.73 2009/01/06 16:03:47 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.74 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -592,6 +592,7 @@ SetDictFromAny(
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "missing value to go with key",
 			TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -644,6 +645,9 @@ SetDictFromAny(
 	result = TclFindElement(interp, p, lenRemain,
 		&elemStart, &nextElem, &elemSize, &hasBrace);
 	if (result != TCL_OK) {
+	    if (interp != NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+	    }
 	    goto errorExit;
 	}
 	if (elemStart >= limit) {
@@ -676,6 +680,9 @@ SetDictFromAny(
 	result = TclFindElement(interp, p, lenRemain,
 		&elemStart, &nextElem, &elemSize, &hasBrace);
 	if (result != TCL_OK) {
+	    if (interp != NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+	    }
 	    TclDecrRefCount(keyPtr);
 	    goto errorExit;
 	}
@@ -690,7 +697,7 @@ SetDictFromAny(
 
 	s = ckalloc((unsigned) elemSize + 1);
 	if (hasBrace) {
-	    memcpy((void *) s, (void *) elemStart, (size_t) elemSize);
+	    memcpy(s, elemStart, (size_t) elemSize);
 	    s[elemSize] = 0;
 	} else {
 	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
@@ -712,7 +719,7 @@ SetDictFromAny(
 	    TclDecrRefCount(discardedValue);
 	}
 	Tcl_SetHashValue(hPtr, valuePtr);
-	Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
+	Tcl_IncrRefCount(valuePtr);	/* Since hash now holds ref to it. */
     }
 
   installHash:
@@ -733,6 +740,7 @@ SetDictFromAny(
   missingKey:
     if (interp != NULL) {
 	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
     }
     TclDecrRefCount(keyPtr);
     result = TCL_ERROR;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 0915092..db2c0d1 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIndexObj.c,v 1.48 2008/12/15 17:28:54 das Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.49 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1034,6 +1034,7 @@ Tcl_WrongNumArgs(
 	Tcl_AppendStringsToObj(objPtr, message, NULL);
     }
     Tcl_AppendStringsToObj(objPtr, "\"", NULL);
+    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
     Tcl_SetObjResult(interp, objPtr);
 #undef MAY_QUOTE_WORD
 #undef AFTER_FIRST_WORD
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index b8f9da7..be18699 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclListObj.c,v 1.55 2008/10/15 06:17:04 nijtmans Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.56 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1705,6 +1705,7 @@ SetListFromAny(
 	    Tcl_SetResult(interp,
 		    "insufficient memory to allocate list working space",
 		    TCL_STATIC);
+	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	    return TCL_ERROR;
 	}
 	listRepPtr->elemCount = 2 * size;
@@ -1764,6 +1765,7 @@ SetListFromAny(
     if (!listRepPtr) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"Not enough memory to allocate the list internal rep", -1));
+	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
 	return TCL_ERROR;
     }
     elemPtrs = &listRepPtr->elements;
@@ -1779,6 +1781,9 @@ SetListFromAny(
 		Tcl_DecrRefCount(elemPtr);
 	    }
 	    ckfree((char *) listRepPtr);
+	    if (interp != NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
+	    }
 	    return result;
 	}
 	if (elemStart >= limit) {
diff --git a/generic/tclObj.c b/generic/tclObj.c
index ae3f909..e73fa17 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.145 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.146 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1411,6 +1411,7 @@ SetBooleanFromAny(
 	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
 	Tcl_AppendToObj(msg, "\"", -1);
 	Tcl_SetObjResult(interp, msg);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
     }
     return TCL_ERROR;
 }
@@ -2192,6 +2193,7 @@ Tcl_GetLongFromObj(
 		Tcl_AppendObjToObj(msg, objPtr);
 		Tcl_AppendToObj(msg, "\"", -1);
 		Tcl_SetObjResult(interp, msg);
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -2494,6 +2496,7 @@ Tcl_GetWideIntFromObj(
 		Tcl_AppendObjToObj(msg, objPtr);
 		Tcl_AppendToObj(msg, "\"", -1);
 		Tcl_SetObjResult(interp, msg);
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -2825,6 +2828,7 @@ GetBignumFromObj(
 		Tcl_AppendObjToObj(msg, objPtr);
 		Tcl_AppendToObj(msg, "\"", -1);
 		Tcl_SetObjResult(interp, msg);
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 8eec7b4..7664ebd 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStrToD.c,v 1.35 2008/12/10 18:21:47 ferrieux Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.36 2009/01/08 16:41:34 dkf Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -90,7 +90,8 @@ static int maxpow10_wide;	/* The powers of ten that can be represented
 				 * exactly as wide integers. */
 static Tcl_WideUInt *pow10_wide;
 #define MAXPOW	22
-static double pow10vals[MAXPOW+1];	/* The powers of ten that can be represented
+static double pow10vals[MAXPOW+1];
+				/* The powers of ten that can be represented
 				 * exactly as IEEE754 doubles. */
 static int mmaxpow;		/* Largest power of ten that can be
 				 * represented exactly in a 'double'. */
@@ -1161,6 +1162,7 @@ TclParseNumber(
 		Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
 	    }
 	    Tcl_SetObjResult(interp, msg);
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
 	}
     }
 
@@ -1339,7 +1341,7 @@ MakeLowPrecisionDouble(
 		 * without special handling.
 		 */
 
-		retval = (double)(Tcl_WideInt)significand * pow10vals[ exponent ];
+		retval = (double)(Tcl_WideInt)significand * pow10vals[exponent];
 		goto returnValue;
 	    } else {
 		int diff = DBL_DIG - numSigDigs;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 3b8ddf5..bc189c0 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUtil.c,v 1.107 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.108 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -454,6 +454,9 @@ Tcl_SplitList(
 		&elSize, &brace);
 	length -= (list - prevList);
 	if (result != TCL_OK) {
+	    if (interp != NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
+	    }
 	    ckfree((char *) argv);
 	    return result;
 	}
@@ -2634,6 +2637,7 @@ TclGetIntForIndex(
 	    bytes += 4;
 	}
 	TclCheckBadOctal(interp, bytes);
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
     }
 
     return TCL_ERROR;
@@ -2723,6 +2727,7 @@ SetEndOffsetFromAny(
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "bad index \"", bytes,
 		    "\": must be end?[+-]integer?", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
 	}
 	return TCL_ERROR;
     }
@@ -2757,6 +2762,7 @@ SetEndOffsetFromAny(
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "bad index \"", bytes,
 		    "\": must be end?[+-]integer?", NULL);
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
 	}
 	return TCL_ERROR;
     }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 57607d3..dad0d1a 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.173 2008/12/17 16:47:38 nijtmans Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.174 2009/01/08 16:41:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -612,6 +612,7 @@ TclObjLookupVarEx(
 		if (flags & TCL_LEAVE_ERR_MSG) {
 		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 			    noSuchVar, -1);
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
 		}
 		return NULL;
 	    }
@@ -644,6 +645,8 @@ TclObjLookupVarEx(
 		    if (flags & TCL_LEAVE_ERR_MSG) {
 			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 				needArray, -1);
+			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
+				NULL);
 		    }
 		    return NULL;
 		}
@@ -707,6 +710,7 @@ TclObjLookupVarEx(
     if (varPtr == NULL) {
 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	}
 	if (newPart2) {
 	    Tcl_DecrRefCount(part2Ptr);
@@ -764,6 +768,7 @@ TclObjLookupVarEx(
 	    part1 = TclGetString(part1Ptr);
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
 		    "Cached variable reference is NULL.", -1);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	}
 	return NULL;
     }
@@ -968,9 +973,13 @@ TclLookupSimpleVar(
 			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
 		if (varNsPtr == NULL) {
 		    *errMsgPtr = badNamespace;
+		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+			    NULL);
 		    return NULL;
 		} else if (tail == NULL) {
 		    *errMsgPtr = missingName;
+		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+			    NULL);
 		    return NULL;
 		}
 		if (tail != varName) {
@@ -993,6 +1002,7 @@ TclLookupSimpleVar(
 		}
 	    } else {		/* Var wasn't found and not to create it. */
 		*errMsgPtr = noSuchVar;
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 		return NULL;
 	    }
 	}
@@ -1029,6 +1039,7 @@ TclLookupSimpleVar(
 	    }
 	    if (varPtr == NULL) {
 		*errMsgPtr = noSuchVar;
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	    }
 	}
     }
@@ -1120,6 +1131,7 @@ TclLookupArrayElement(
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
 			danglingVar, index);
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	    }
 	    return NULL;
 	}
@@ -1138,6 +1150,7 @@ TclLookupArrayElement(
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
 		    index);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
 	}
 	return NULL;
     }
@@ -1433,6 +1446,7 @@ TclPtrGetVar(
      */
 
   errorReturn:
+    Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
     if (TclIsVarUndefined(varPtr)) {
 	TclCleanupVar(varPtr, arrayPtr);
     }
@@ -1921,6 +1935,9 @@ TclPtrSetVar(
      */
 
   cleanup:
+    if (resultPtr == NULL) {
+	Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
+    }
     if (TclIsVarUndefined(varPtr)) {
 	TclCleanupVar(varPtr, arrayPtr);
     }
@@ -2221,6 +2238,7 @@ TclObjUnsetVar2(
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
 		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
+	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
 	}
     }
 
@@ -2360,7 +2378,7 @@ UnsetVarStruct(
 		VarTrace *prevPtr = tracePtr;
 
 		tracePtr = tracePtr->nextPtr;
-		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
+		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
 	    }
 	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
 		    activePtr = activePtr->nextPtr) {
@@ -3628,6 +3646,7 @@ TclPtrObjMakeUpvar(
 
 	if (TclIsVarLink(varPtr)) {
 	    Var *linkPtr = varPtr->value.linkPtr;
+
 	    if (linkPtr == otherPtr) {
 		return TCL_OK;
 	    }