From a23a10f4460267a77fa20b723239edaf3a5ce877 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 8 Jan 2009 16:41:34 +0000
Subject: Generate errorcodes for more cases.

---
 ChangeLog             |  8 +++++
 generic/tclDictObj.c  | 14 ++++++--
 generic/tclIndexObj.c |  3 +-
 generic/tclListObj.c  |  7 +++-
 generic/tclObj.c      |  6 +++-
 generic/tclStrToD.c   |  8 +++--
 generic/tclUtil.c     |  8 ++++-
 generic/tclVar.c      | 23 ++++++++++--
 tests/cmdAH.test      | 98 +++++++++++++++++----------------------------------
 tests/ioCmd.test      | 43 +++++++++++-----------
 tests/join.test       | 17 +++++----
 tests/mathop.test     | 12 +++----
 tests/rename.test     | 79 +++++++++++++++++++++--------------------
 tests/split.test      | 24 +++++++------
 14 files changed, 191 insertions(+), 159 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 7053a12..032f976 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2009-01-08  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c,
+	* generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c,
+	* generic/tclVar.c: Generate errorcodes for the error cases which
+	approximate to "I can't interpret that string as one of those" and
+	"You gave me the wrong number of arguments".
+
 2009-01-07  Donal K. Fellows  <dkf@users.sf.net>
 
 	* doc/dict.n: Added more examples. [Tk Bug 2491235]
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;
 	    }
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index da554ce..c179eb6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1,16 +1,16 @@
 # The file tests the tclCmdAH.c file.
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.65 2008/12/01 15:22:55 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.66 2009/01/08 16:41:34 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -30,6 +30,27 @@ global env
 set cmdAHwd [pwd]
 catch {set platform [testgetplatform]}
 
+proc waitForEvenSecondForFAT {} {
+    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
+    # data in its timestamps for even per-second-accurate timings. :^(
+    # This procedure based on work by Helmut Giese
+    if {
+	[testConstraint win] &&
+	[lindex [file system [temporaryDirectory]] 1] ne "NTFS"
+    } then {
+	# Assume non-NTFS means FAT{12,16,32} and hence in need of special
+	# help...
+	set start [clock seconds]
+	while {1} {
+	    set now [clock seconds]
+	    if {$now!=$start && !($now & 1)} {
+		break
+	    }
+	    after 50
+	}
+    }
+}
+
 test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
     break foo
 } -returnCodes error -result {wrong # args: should be "break"}
@@ -113,7 +134,6 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
-
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
@@ -382,7 +402,6 @@ test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
 } {ok}
 
 # tail
-
 test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body {
     file tail a b
 } -result {wrong # args: should be "file tail name"}
@@ -531,7 +550,6 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
 } bar
 
 # rootname
-
 test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
     file rootname a b
 } -result {wrong # args: should be "file rootname name"}
@@ -632,7 +650,6 @@ foreach outer { {} a .a a. a.a } {
 }
 
 # extension
-
 test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body {
     file extension a b
 } -result {wrong # args: should be "file extension name"}
@@ -737,7 +754,6 @@ foreach {test onPlatform value result} {
 }
 
 # pathtype
-
 test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body {
     file pathtype a b
 } -result {wrong # args: should be "file pathtype name"}
@@ -755,7 +771,6 @@ test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform {
 } volumerelative
 
 # split
-
 test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body {
     file split a b
 } -result {wrong # args: should be "file split name"}
@@ -769,7 +784,6 @@ test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform {
 } {a b}
 
 # join
-
 test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform {
     testsetplatform unix
     file join a
@@ -784,7 +798,6 @@ test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform {
 } a/b/c/d
 
 # error handling of Tcl_TranslateFileName
-
 test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body {
     testsetplatform unix
     file atime ~_bad_user
@@ -793,10 +806,8 @@ test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body {
 catch {testsetplatform $platform}
 
 # readable
-
 set gorpfile [makeFile abcde gorp.file]
 set dirfile [makeDirectory dir.file]
-
 test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
     -returnCodes error
     -body   {file readable a b}
@@ -816,7 +827,6 @@ test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
 }
 
 # writable
-
 test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
     -returnCodes error
     -body   {file writable a b}
@@ -836,12 +846,10 @@ test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
 }
 
 # executable
-
 removeFile $gorpfile
 removeDirectory $dirfile
 set dirfile [makeDirectory dir.file]
 set gorpfile [makeFile abcde gorp.file]
-
 test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
     file executable a b
 } -result {wrong # args: should be "file executable name"}
@@ -881,7 +889,6 @@ set linkfile [file join [temporaryDirectory] link.file]
 file delete $linkfile
 
 # exists
-
 test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body {
     file exists a b
 } -result {wrong # args: should be "file exists name"}
@@ -900,7 +907,6 @@ test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
 test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
     file exists $subgorp
 } 1
-
 # nativename
 test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body {
     testsetplatform unix
@@ -914,7 +920,6 @@ test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body {
 } -constraints testsetplatform -cleanup {
     testsetplatform $platform
 } -result {a\b}
-
 test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
     file exists ~nOsUcHuSeR
 } 0
@@ -922,11 +927,9 @@ test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
     # should probably be 0 in fact...
     catch {file nativename ~nOsUcHuSeR}
 } 1
-
 # The test below has to be done in /tmp rather than the current directory in
 # order to guarantee (?) a local file system: some NFS file systems won't do
 # the stuff below correctly.
-
 test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
     file delete -force /tmp/tcl.foo.dir/file
     file delete -force /tmp/tcl.foo.dir
@@ -948,8 +951,6 @@ removeFile $gorpfile
 set gorpfile [makeFile "Test string" gorp.file]
 catch {file attributes $gorpfile -permissions 0765}
 
-# atime
-
 # avoid problems with non-local filesystems
 if {[testConstraint unix] && [file exists /tmp]} {
     set file [makeFile "data" touch.me /tmp]
@@ -957,6 +958,7 @@ if {[testConstraint unix] && [file exists /tmp]} {
     set file [makeFile "data" touch.me]
 }
 
+# atime
 test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body {
     file atime a b c
 } -result {wrong # args: should be "file atime name ?time?"}
@@ -1006,7 +1008,6 @@ if {[testConstraint unix] && [file exists /tmp]} {
 }
 
 # isdirectory
-
 test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body {
     file isdirectory a b
 } -result {wrong # args: should be "file isdirectory name"}
@@ -1014,7 +1015,6 @@ test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0
 test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1
 
 # isfile
-
 test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body {
     file isfile a b
 } -result {wrong # args: should be "file isfile name"}
@@ -1023,7 +1023,6 @@ test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0
 
 # lstat and readlink: don't run these tests everywhere, since not all sites
 # will have symbolic links
-
 catch {file link -symbolic $linkfile $gorpfile}
 test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
     file lstat a
@@ -1052,11 +1051,9 @@ test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
 } -body {
     set x 44
     list [catch {file lstat $gorpfile x} msg] $msg $errorCode
-} -result {1 {can't set "x(dev)": variable isn't array} NONE}
+} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME}}
 catch {unset stat}
-
 # mkdir
-
 set dirA [file join [temporaryDirectory] a]
 set dirB [file join [temporaryDirectory] a]
 test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup {
@@ -1098,30 +1095,8 @@ test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} {
     file mkdir
 } {}
 
-# mtime
-
-proc waitForEvenSecondForFAT {} {
-    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
-    # data in its timestamps for even per-second-accurate timings. :^(
-    # This procedure based on work by Helmut Giese
-    if {
-	[testConstraint win]
-	&& [lindex [file system [temporaryDirectory]] 1] ne "NTFS"
-    } then {
-	# Assume non-NTFS means FAT{12,16,32} and hence in need of special
-	# help...
-	set start [clock seconds]
-	while {1} {
-	    set now [clock seconds]
-	    if {$now!=$start && !($now & 1)} {
-		break
-	    }
-	    after 50
-	}
-    }
-}
 set file [makeFile "data" touch.me]
-
+# mtime
 test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
     file mtime a b c
 } -result {wrong # args: should be "file mtime name ?time?"}
@@ -1160,8 +1135,7 @@ test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup {
 	    [expr {[file atime $gorpfile] == $stat(atime)}]
 } -result {1 1}
 test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
-    list [catch {file mtime _bogus_} msg] [string tolower $msg] \
-	    $errorCode
+    list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode
 } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup {
     # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other
@@ -1259,7 +1233,6 @@ test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
 } -result {0 1}
 
 # owned
-
 test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
     file owned a b
 } -result {wrong # args: should be "file owned name"}
@@ -1279,7 +1252,6 @@ test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
 } 0
 
 # readlink
-
 test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
     file readlink a b
 } -result {wrong # args: should be "file readlink name"}
@@ -1294,7 +1266,6 @@ test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} {
 } {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}}
 
 # size
-
 test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body {
     file size a b
 } -result {wrong # args: should be "file size name"}
@@ -1310,13 +1281,12 @@ test cmdAH-27.3 {Tcl_FileObjCmd: size} {
     list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
 } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
-# stat
-
 catch {testsetplatform $platform}
 removeFile $gorpfile
 set gorpfile [makeFile "Test string" gorp.file]
 catch {file attributes $gorpfile -permissions 0765}
 
+# stat
 test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
     file stat _bogus_
 } -result {wrong # args: should be "file stat name varName"}
@@ -1402,7 +1372,6 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
 catch {unset stat}
 
 # type
-
 test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
     file size a b
 } -result {wrong # args: should be "file size name"}
@@ -1442,7 +1411,6 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} {
 } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
 # Error conditions
-
 test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file gorp x
 } -result {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
@@ -1577,7 +1545,7 @@ test cmdAH-32.6 {file tempfile - templates} -body {
 } -constraints {unix nonPortable} -cleanup {
     catch {file delete $name}
 } -result ok
-
+
 # This shouldn't work, but just in case a test above failed...
 catch {close $newFileId}
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 0018f83..1754dcd 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -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: ioCmd.test,v 1.48 2008/12/18 01:14:17 ferrieux Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.49 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -135,7 +135,7 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
     set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
     close $f
     set x
-} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}}
 test iocmd-4.9 {read command} {
     list [catch {read stdin foo} msg] $msg $::errorCode
 } {1 {bad argument "foo": should be "nonewline"} NONE}
@@ -150,25 +150,26 @@ test iocmd-4.11 {read command} {
     string compare [string tolower $x] \
 	[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
 } 0
-test iocmd-4.12 {read command} {
+test iocmd-4.12 {read command} -setup {
     set f [open $path(test1)]
-    set x [list [catch {read $f 12z} msg] $msg $::errorCode]
+} -body {
+    list [catch {read $f 12z} msg] $msg $::errorCode
+} -cleanup {
     close $f
-    set x
-} {1 {expected integer but got "12z"} NONE}
-
-test iocmd-5.1 {seek command} {
-    list [catch {seek} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.2 {seek command} {
-    list [catch {seek a b c d e f g} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.3 {seek command} {
-    list [catch {seek stdin gugu} msg] $msg
-} {1 {expected integer but got "gugu"}}
-test iocmd-5.4 {seek command} {
-    list [catch {seek stdin 100 gugu} msg] $msg
-} {1 {bad origin "gugu": must be start, current, or end}}
+} -result {1 {expected integer but got "12z"} {TCL VALUE NUMBER}}
+
+test iocmd-5.1 {seek command} -returnCodes error -body {
+    seek
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.2 {seek command} -returnCodes error -body {
+    seek a b c d e f g
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.3 {seek command} -returnCodes error -body {
+    seek stdin gugu
+} -result {expected integer but got "gugu"}
+test iocmd-5.4 {seek command} -returnCodes error -body {
+    seek stdin 100 gugu
+} -result {bad origin "gugu": must be start, current, or end}
 
 test iocmd-6.1 {tell command} {
     list [catch {tell} msg] $msg
@@ -352,10 +353,10 @@ test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable
 
 test iocmd-9.1 {eof command} {
     list [catch {eof} msg] $msg $::errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
 test iocmd-9.2 {eof command} {
     list [catch {eof a b} msg] $msg $::errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
 test iocmd-9.3 {eof command} {
     catch {close file100}
     list [catch {eof file100} msg] $msg $::errorCode
diff --git a/tests/join.test b/tests/join.test
index 562c3e0..0a6da27 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -11,13 +11,13 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: join.test,v 1.6 2004/05/19 10:51:06 dkf Exp $
+# RCS: @(#) $Id: join.test,v 1.7 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test join-1.1 {basic join commands} {
     join {a b c} xyz
 } axyzbxyzc
@@ -33,22 +33,25 @@ test join-1.4 {basic join commands} {
 
 test join-2.1 {join errors} {
     list [catch join msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
 test join-2.2 {join errors} {
     list [catch {join a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
 test join-2.3 {join errors} {
     list [catch {join "a \{ c" 111} msg] $msg $errorCode
-} {1 {unmatched open brace in list} NONE}
+} {1 {unmatched open brace in list} {TCL VALUE LIST}}
 
 test join-3.1 {joinString is binary ok} {
   string length [join {a b c} a\0b]
 } 9
-
 test join-3.2 {join is binary ok} {
   string length [join "a\0b a\0b a\0b"]
 } 11
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/mathop.test b/tests/mathop.test
index 8374a98..3ec37fc 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -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: mathop.test,v 1.12 2008/03/30 03:23:39 kennykb Exp $
+# RCS: @(#) $Id: mathop.test,v 1.13 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -731,7 +731,7 @@ test mathop-20.2 { zero args, not allowed } {
     set exp {}
     foreach op {~ ! << >> % != ne in ni - /} {
         set res [TestOp $op]
-        if {[string match "wrong # args* NONE" $res]} {
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
             lappend exp 0
         } else {
             lappend exp $res
@@ -762,7 +762,7 @@ test mathop-20.5 { one arg, not allowed } {
     set exp {}
     foreach op {% != ne in ni << >>} {
         set res [TestOp $op 1]
-        if {[string match "wrong # args* NONE" $res]} {
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
             lappend exp 0
         } else {
             lappend exp $res
@@ -861,7 +861,7 @@ test mathop-21.6 { unary ops, too many } {
     set exp {}
     foreach op {~ !} {
         set res [TestOp $op 7 8]
-        if {[string match "wrong # args* NONE" $res]} {
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
             lappend exp 0
         } else {
             lappend exp $res
@@ -1088,7 +1088,7 @@ test mathop-24.3 { binary ops, bad values } {
     }
     foreach op {in ni} {
         lappend res [TestOp $op 5 "a b \{ c"]
-        lappend exp "unmatched open brace in list NONE"
+        lappend exp "unmatched open brace in list TCL VALUE LIST"
     }
     lappend res [TestOp % 5 0]
     lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
@@ -1185,7 +1185,7 @@ test mathop-24.8 { binary ops, too many } {
     set exp {}
     foreach op {<< >> % != ne in ni ~ !} {
         set res [TestOp $op 7 8 9]
-        if {[string match "wrong # args* NONE" $res]} {
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
             lappend exp 0
         } else {
             lappend exp $res
diff --git a/tests/rename.test b/tests/rename.test
index 45d6847..3a3a47f 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -1,34 +1,34 @@
 # Commands covered:  rename
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: rename.test,v 1.12 2004/05/19 20:15:32 dkf Exp $
+# RCS: @(#) $Id: rename.test,v 1.13 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
 testConstraint testdel [llength [info commands testdel]]
 
-# Must eliminate the "unknown" command while the test is running,
-# especially if the test is being run in a program with its
-# own special-purpose unknown command.
-
+# Must eliminate the "unknown" command while the test is running, especially
+# if the test is being run in a program with its own special-purpose unknown
+# command.
 catch {rename unknown unknown.old}
-
+
 catch {rename r2 {}}
 proc r1 {} {return "procedure r1"}
 rename r1 r2
+
 test rename-1.1 {simple renaming} {
     r2
 } {procedure r1}
@@ -40,10 +40,9 @@ test rename-1.3 {simple renaming} {
     list [catch r2 msg] $msg
 } {1 {invalid command name "r2"}}
 
-# The test below is tricky because it renames a built-in command.
-# It's possible that the test procedure uses this command, so must
-# restore the command before calling test again.
-
+# The test below is tricky because it renames a built-in command. It's
+# possible that the test procedure uses this command, so must restore the
+# command before calling test again.
 rename list l.new
 set a [catch list msg1]
 set b [l.new a b c]
@@ -56,24 +55,27 @@ test rename-2.1 {renaming built-in command} {
 
 test rename-3.1 {error conditions} {
     list [catch {rename r1} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
 test rename-3.2 {error conditions} {
     list [catch {rename r1 r2 r3} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test rename-3.3 {error conditions} {
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
+test rename-3.3 {error conditions} -setup {
     proc r1 {} {}
     proc r2 {} {}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename to "r2": command already exists}}
-test rename-3.4 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename to "r2": command already exists}
+test rename-3.4 {error conditions} -setup {
     catch {rename r1 {}}
     catch {rename r2 {}}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename "r1": command doesn't exist}}
-test rename-3.5 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename "r1": command doesn't exist}
+test rename-3.5 {error conditions} -setup {
     catch {rename _non_existent_command {}}
-    list [catch {rename _non_existent_command {}} msg] $msg
-} {1 {can't delete "_non_existent_command": command doesn't exist}}
+} -returnCodes error -body {
+    rename _non_existent_command {}
+} -result {can't delete "_non_existent_command": command doesn't exist}
 
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
@@ -142,11 +144,9 @@ if {[info exists env(value)]} {
 
 catch {rename unknown unknown.old}
 
+set SAVED_UNKNOWN "proc unknown "
+append SAVED_UNKNOWN [list [info args unknown.old] [info body unknown.old]]
 test rename-5.1 {repeated rename deletion and redefinition of same command} {
-    set SAVED_UNKNOWN "proc unknown "
-    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
-    append SAVED_UNKNOWN "\{[info body unknown.old]\}"
-
     for {set i 0} {$i < 10} {incr i} {
         eval $SAVED_UNKNOWN
         tcl_wordBreakBefore "" 0
@@ -158,24 +158,27 @@ test rename-5.1 {repeated rename deletion and redefinition of same command} {
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
 
-
-test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
-     proc x {} {
+test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed} -body {
+    proc x {} {
         set a 123
         set b [incr a]
     }
     x
     rename incr incr.old
     proc incr {} {puts "new incr called!"}
-    catch {x} msg
+    x
+} -cleanup {
     rename incr {}
     rename incr.old incr
-    set msg
-} {wrong # args: should be "incr"}
-
+} -returnCodes error -result {wrong # args: should be "incr"}
+
 if {[info commands incr.old] != {}} {
     catch {rename incr {}}
     catch {rename incr.old incr}
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/split.test b/tests/split.test
index 93b0cc4..1cc13b7 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -1,23 +1,23 @@
 # Commands covered:  split
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: split.test,v 1.9 2004/05/19 10:50:30 dkf Exp $
+# RCS: @(#) $Id: split.test,v 1.10 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test split-1.1 {basic split commands} {
     split "a\n b\t\r c\n "
 } {a {} b {} {} c {} {}}
@@ -75,12 +75,16 @@ test split-1.14 {basic split commands} {
 
 test split-2.1 {split errors} {
     list [catch split msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
 test split-2.2 {split errors} {
     list [catch {split a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
-
+} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
+
 # cleanup
 catch {rename foo {}}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
-- 
cgit v0.12