merge trunk

Add -Wwrite-strings to compiler options, so we can guarantee correct "const" usage.

17 files changed, 50 insertions, 52 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7833105..c4eeded 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -798,12 +798,10 @@ TclNRAssembleObjCmd(
 
     if (codePtr == NULL) {
 	Tcl_AddErrorInfo(interp, "\n    (\"");
-	Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+	Tcl_AppendObjToErrorInfo(interp, objv[0]);
 	Tcl_AddErrorInfo(interp, "\" body, line ");
 	backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
-	Tcl_IncrRefCount(backtrace);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
-	Tcl_DecrRefCount(backtrace);
+	Tcl_AppendObjToErrorInfo(interp, backtrace);
 	Tcl_AddErrorInfo(interp, ")");
 	return TCL_ERROR;
     }
@@ -4270,11 +4268,11 @@ AddBasicBlockRangeToErrorInfo(
     Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
     lineNo = Tcl_NewIntObj(bbPtr->startLine);
     Tcl_IncrRefCount(lineNo);
-    Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+    Tcl_AppendObjToErrorInfo(interp, lineNo);
     Tcl_AddErrorInfo(interp, " and ");
     if (bbPtr->successor1 != NULL) {
 	Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+	Tcl_AppendObjToErrorInfo(interp, lineNo);
     } else {
 	Tcl_AddErrorInfo(interp, "end of assembly code");
     }
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 821be3f..23df63e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2196,7 +2196,7 @@ EnsembleUnknownCallback(
 	    }
 	    Tcl_AddErrorInfo(interp, "\n    result of "
 		    "ensemble unknown subcommand handler: ");
-	    Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+	    Tcl_AppendObjToErrorInfo(interp, unknownCmd);
 	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
 		    NULL);
 	} else {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 00bd0ab..2f2a3f4 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3332,8 +3332,8 @@ TEBCresume(
 	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
 	if (!varPtr) {
-	    Tcl_AddObjErrorInfo(interp,
-		    "\n    (reading value of variable to increment)", -1);
+	    Tcl_AddErrorInfo(interp,
+		    "\n    (reading value of variable to increment)");
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    Tcl_DecrRefCount(incrPtr);
 	    goto gotError;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index f5e1f20..2593234 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -843,7 +843,7 @@ ObjectRenamedTrace(
 	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
 		    contextPtr, 0, NULL);
 	    if (result != TCL_OK) {
-		Tcl_BackgroundError(interp);
+		Tcl_BackgroundException(interp, result);
 	    }
 	    Tcl_RestoreInterpState(interp, state);
 	    TclOODeleteContext(contextPtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 1a73288..19bea0f 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1278,7 +1278,7 @@ Tcl_GetReturnOptions(
     }
 
     if (result == TCL_ERROR) {
-	Tcl_AddObjErrorInfo(interp, "", -1);
+	Tcl_AddErrorInfo(interp, "");
         Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
     }
     if (iPtr->errorCode) {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 54862f1..8b4a730 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -771,7 +771,7 @@ TestasyncCmd(
 
     if (argc < 2) {
 	wrongNumArgs:
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "wrong # args", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
@@ -861,7 +861,7 @@ TestasyncCmd(
 		if (Tcl_CreateThread(&threadID, AsyncThreadProc,
 			INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
 			TCL_THREAD_NOFLAGS) != TCL_OK) {
-		    Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
+		    Tcl_AppendResult(interp, "can't create thread", NULL);
 		    Tcl_MutexUnlock(&asyncTestMutex);
 		    return TCL_ERROR;
 		}
@@ -1008,7 +1008,7 @@ TestcmdinfoCmd(
 	Tcl_DStringResult(interp, &delString);
     } else if (strcmp(argv[1], "get") == 0) {
 	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
-	    Tcl_SetResult(interp, "??", TCL_STATIC);
+	    Tcl_AppendResult(interp, "??", NULL);
 	    return TCL_OK;
 	}
 	if (info.proc == CmdProc1) {
@@ -1135,7 +1135,7 @@ TestcmdtokenCmd(
 	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
 		(ClientData) "original", NULL);
 	sprintf(buf, "%p", (void *)token);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "name") == 0) {
 	Tcl_Obj *objPtr;
 
@@ -1241,7 +1241,7 @@ TestcmdtraceCmd(
 	result = Tcl_EvalEx(interp, argv[2], -1, 0);
 	Tcl_DeleteTrace(interp, cmdTrace);
 	if (!deleteCalled) {
-	    Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
+	    Tcl_AppendResult(interp, "Delete wasn't called", NULL);
 	    return TCL_ERROR;
 	} else {
 	    return result;
@@ -1541,7 +1541,7 @@ TestdelCmd(
     Tcl_Interp *slave;
 
     if (argc != 4) {
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "wrong # args", NULL);
 	return TCL_ERROR;
     }
 
@@ -1746,7 +1746,7 @@ TestdstringCmd(
 
     if (argc < 2) {
 	wrongNumArgs:
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "wrong # args", NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "append") == 0) {
@@ -1782,9 +1782,9 @@ TestdstringCmd(
 	    goto wrongNumArgs;
 	}
 	if (strcmp(argv[2], "staticsmall") == 0) {
-	    Tcl_SetResult(interp, "short", TCL_STATIC);
+	    Tcl_AppendResult(interp, "short", NULL);
 	} else if (strcmp(argv[2], "staticlarge") == 0) {
-	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
+	    Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
 	} else if (strcmp(argv[2], "free") == 0) {
 	    char *s = ckalloc(100);
 	    strcpy(s, "This is a malloc-ed string");
@@ -2384,7 +2384,7 @@ TestexprlongCmd(
 		" expression\"", NULL);
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    Tcl_AppendResult(interp, "This is a result", NULL);
     result = Tcl_ExprLong(interp, argv[1], &exprResult);
     if (result != TCL_OK) {
 	return result;
@@ -2426,7 +2426,7 @@ TestexprlongobjCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "expression");
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    Tcl_AppendResult(interp, "This is a result", NULL);
     result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
     if (result != TCL_OK) {
 	return result;
@@ -2469,7 +2469,7 @@ TestexprdoubleCmd(
 		" expression\"", NULL);
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    Tcl_AppendResult(interp, "This is a result", NULL);
     result = Tcl_ExprDouble(interp, argv[1], &exprResult);
     if (result != TCL_OK) {
 	return result;
@@ -2512,7 +2512,7 @@ TestexprdoubleobjCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "expression");
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+    Tcl_AppendResult(interp, "This is a result", NULL);
     result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
     if (result != TCL_OK) {
 	return result;
@@ -4229,7 +4229,7 @@ TestseterrorcodeCmd(
     const char **argv)		/* Argument strings. */
 {
     if (argc > 6) {
-	Tcl_SetResult(interp, "too many args", TCL_STATIC);
+	Tcl_AppendResult(interp, "too many args", NULL);
 	return TCL_ERROR;
     }
     Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
@@ -4783,7 +4783,7 @@ TestsetCmd(
     const char *value;
 
     if (argc == 2) {
-	Tcl_SetResult(interp, "before get", TCL_STATIC);
+	Tcl_AppendResult(interp, "before get", NULL);
 	value = Tcl_GetVar2(interp, argv[1], NULL, flags);
 	if (value == NULL) {
 	    return TCL_ERROR;
@@ -4791,7 +4791,7 @@ TestsetCmd(
 	Tcl_AppendElement(interp, value);
 	return TCL_OK;
     } else if (argc == 3) {
-	Tcl_SetResult(interp, "before set", TCL_STATIC);
+	Tcl_AppendResult(interp, "before set", NULL);
 	value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
 	if (value == NULL) {
 	    return TCL_ERROR;
@@ -4815,7 +4815,7 @@ Testset2Cmd(
     const char *value;
 
     if (argc == 3) {
-	Tcl_SetResult(interp, "before get", TCL_STATIC);
+	Tcl_AppendResult(interp, "before get", NULL);
 	value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
 	if (value == NULL) {
 	    return TCL_ERROR;
@@ -4823,7 +4823,7 @@ Testset2Cmd(
 	Tcl_AppendElement(interp, value);
 	return TCL_OK;
     } else if (argc == 4) {
-	Tcl_SetResult(interp, "before set", TCL_STATIC);
+	Tcl_AppendResult(interp, "before set", NULL);
 	value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
 	if (value == NULL) {
 	    return TCL_ERROR;
@@ -4891,7 +4891,7 @@ TestsaveresultCmd(
     objPtr = NULL;		/* Lint. */
     switch ((enum options) index) {
     case RESULT_SMALL:
-	Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+	Tcl_AppendResult(interp, "small result", NULL);
 	break;
     case RESULT_APPEND:
 	Tcl_AppendResult(interp, "append result", NULL);
@@ -4995,7 +4995,7 @@ TestmainthreadCmd(
 	Tcl_SetObjResult(interp, idObj);
 	return TCL_OK;
     } else {
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "wrong # args", NULL);
 	return TCL_ERROR;
     }
 }
@@ -5796,7 +5796,7 @@ TestWrongNumArgsObjCmd(
 	 * Don't use Tcl_WrongNumArgs here, as that is the function
 	 * we want to test!
 	 */
-	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+	Tcl_AppendResult(interp, "insufficient arguments", NULL);
 	return TCL_ERROR;
     }
 
@@ -5813,7 +5813,7 @@ TestWrongNumArgsObjCmd(
 	/*
 	 * Asked for more arguments than were given.
 	 */
-	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+	Tcl_AppendResult(interp, "insufficient arguments", NULL);
 	return TCL_ERROR;
     }
 
@@ -6586,7 +6586,7 @@ TestgetintCmd(
     const char **argv)
 {
     if (argc < 2) {
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "wrong # args", NULL);
 	return TCL_ERROR;
     } else {
 	int val, i, total=0;
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index ab0a169..9568dfc 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -926,7 +926,7 @@ ThreadSend(
 	    ckfree(resultPtr->errorInfo);
 	}
     }
-    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+    Tcl_AppendResult(interp, resultPtr->result, NULL);
     Tcl_ConditionFinalize(&resultPtr->done);
     code = resultPtr->code;
 
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 79bf0f8..82d652c 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1322,7 +1322,7 @@ TraceCommandProc(
 		Tcl_DStringLength(&cmd), 0);
 	if (code != TCL_OK) {
 	    /* We ignore errors in these traced commands */
-	    /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
+	    /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
 	}
 	Tcl_DStringFree(&cmd);
     }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 3c5ee15..bfb2205 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2033,8 +2033,8 @@ TclIncrObjVar2(
     varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
 	    1, 1, &arrayPtr);
     if (varPtr == NULL) {
-	Tcl_AddObjErrorInfo(interp,
-		"\n    (reading value of variable to increment)", -1);
+	Tcl_AddErrorInfo(interp,
+		"\n    (reading value of variable to increment)");
 	return NULL;
     }
     return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
diff --git a/unix/Makefile.in b/unix/Makefile.in
index f57d0ce..c3b5ee0 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1718,7 +1718,7 @@ install-packages: packages
 	  fi; \
 	done
 
-test-packages: tcltest packages
+test-packages: ${TCLTEST_EXE} packages
 	@for i in $(PKGS_DIR)/*; do \
 	  if [ -d $$i ]; then \
 	    pkg=`basename $$i`; \
diff --git a/unix/configure b/unix/configure
index 82ca9df..e440baa 100755
--- a/unix/configure
+++ b/unix/configure
@@ -6770,7 +6770,7 @@ fi
     if test "$GCC" = yes; then
 
 	CFLAGS_OPTIMIZE=-O2
-	CFLAGS_WARNING="-Wall"
+	CFLAGS_WARNING="-Wall -Wwrite-strings"
 
 else
 
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index b13fddd..0ac4fb1 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1110,7 +1110,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
     CFLAGS_DEBUG=-g
     AS_IF([test "$GCC" = yes], [
 	CFLAGS_OPTIMIZE=-O2
-	CFLAGS_WARNING="-Wall"
+	CFLAGS_WARNING="-Wall -Wwrite-strings"
     ], [
 	CFLAGS_OPTIMIZE=-O
 	CFLAGS_WARNING=""
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 5c03b79..6e90807 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -213,14 +213,14 @@ typedef struct {
     void *hCursor;
     void *hbrBackground;
     void *lpszMenuName;
-    void *lpszClassName;
+    const void *lpszClassName;
 } WNDCLASS;
 
 extern void __stdcall	CloseHandle(void *);
 extern void *__stdcall	CreateEventW(void *, unsigned char, unsigned char,
 			    void *);
-extern void * __stdcall	CreateWindowExW(void *, void *, void *, DWORD, int,
-			    int, int, int, void *, void *, void *, void *);
+extern void * __stdcall	CreateWindowExW(void *, const void *, const void *,
+			    DWORD, int, int, int, int, void *, void *, void *, void *);
 extern DWORD __stdcall	DefWindowProcW(void *, int, void *, void *);
 extern unsigned char __stdcall	DestroyWindow(void *);
 extern int __stdcall	DispatchMessageW(const MSG *);
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 35445d2..fcfe18e 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -200,7 +200,7 @@ TestfilehandlerCmd(
 	    return TCL_ERROR;
 	}
 	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "create") == 0) {
 	if (argc != 5) {
 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -217,8 +217,8 @@ TestfilehandlerCmd(
 	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
 	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
 #else
-	    Tcl_SetResult(interp, "can't make pipes non-blocking",
-		    TCL_STATIC);
+	    Tcl_AppendResult(interp, "can't make pipes non-blocking",
+		    NULL);
 	    return TCL_ERROR;
 #endif
 	}
@@ -281,7 +281,7 @@ TestfilehandlerCmd(
 
 	memset(buffer, 'b', 10);
 	TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
-	Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "oneevent") == 0) {
 	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
     } else if (strcmp(argv[1], "wait") == 0) {
@@ -390,7 +390,7 @@ TestfilewaitCmd(
     if (Tcl_GetChannelHandle(channel,
 	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
 	    (ClientData*) &data) != TCL_OK) {
-	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+	Tcl_AppendResult(interp, "couldn't get channel file", NULL);
 	return TCL_ERROR;
     }
     fd = PTR2INT(data);
diff --git a/win/configure b/win/configure
index ba10113..ae433f0 100755
--- a/win/configure
+++ b/win/configure
@@ -3646,7 +3646,7 @@ echo "$as_me: error: ${CC} does not support the -shared option.
 
 	CFLAGS_DEBUG=-g
 	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
-	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+	CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement"
 	LDFLAGS_DEBUG=
 	LDFLAGS_OPTIMIZE=
 
diff --git a/win/tcl.m4 b/win/tcl.m4
index 8689cea..2aa65a9 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -728,7 +728,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 
 	CFLAGS_DEBUG=-g
 	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
-	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+	CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement"
 	LDFLAGS_DEBUG=
 	LDFLAGS_OPTIMIZE=
 
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 773ed19..e046bd3 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -211,7 +211,7 @@ TestvolumetypeCmd(
 	TclWinConvertError(GetLastError());
 	return TCL_ERROR;
     }
-    Tcl_SetResult(interp, volType, TCL_VOLATILE);
+    Tcl_AppendResult(interp, volType, NULL);
     return TCL_OK;
 #undef VOL_BUF_SIZE
 }