Various mismatches between Tcl_Panic format string and its arguments,

discovered thanks to [Bug 3159920]

8 files changed, 35 insertions, 25 deletions

diff --git a/ChangeLog b/ChangeLog
index a5000cf..45c4657 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2011-01-18  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* generic/tclBasic.c:      Various mismatches between Tcl_Panic 
+	* generic/tclCompCmds.c:   format string and its arguments,
+	* generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920]
+	* generic/tclCompExpr.c
+	* generic/tclEnsemble.c
+	* generic/tclPreserve.c
+	* generic/tclTest.c
+
 2011-01-17  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d863347..0238d8f 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.472 2010/12/09 15:09:07 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.473 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -947,11 +947,11 @@ Tcl_CreateInterp(void)
     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
 
     if (TclTommath_Init(interp) != TCL_OK) {
-	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 
     if (TclOOInit(interp) != TCL_OK) {
-	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 
     /*
@@ -961,7 +961,7 @@ Tcl_CreateInterp(void)
 
 #ifdef HAVE_ZLIB
     if (TclZlibInit(interp) != TCL_OK) {
-	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 #endif
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b7f9eb2..3528bab 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.173 2010/11/04 12:22:07 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.174 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -411,7 +411,7 @@ TclCompileCatchCmd(
     /* Stack at this point: ?script? result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
-		CurrentOffset(envPtr) - jumpFixup.codeOffset);
+		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
     /* Push the return options if the caller wants them */
@@ -1125,7 +1125,7 @@ TclCompileDictUpdateCmd(
 
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
-		CurrentOffset(envPtr) - jumpFixup.codeOffset);
+		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
     TclStackFree(interp, keyTokenPtrs);
     return TCL_OK;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 8fef58d..2f86be1 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.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: tclCompCmdsSZ.c,v 1.9 2010/05/28 09:11:31 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.10 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -717,7 +717,7 @@ TclSubstCompile(
 	    /* Start */
 	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
 		Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
-			CurrentOffset(envPtr) - startFixup.codeOffset);
+			(int) (CurrentOffset(envPtr) - startFixup.codeOffset));
 	    }
 	}
 
@@ -774,7 +774,7 @@ TclSubstCompile(
 	/* BREAK destination */
 	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
-		    CurrentOffset(envPtr) - breakFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
 	}
 	TclEmitOpcode(INST_POP, envPtr);
 	TclEmitOpcode(INST_POP, envPtr);
@@ -789,7 +789,7 @@ TclSubstCompile(
 	/* CONTINUE destination */
 	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
-		    CurrentOffset(envPtr) - continueFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
 	}
 	TclEmitOpcode(INST_POP, envPtr);
 	TclEmitOpcode(INST_POP, envPtr);
@@ -798,11 +798,11 @@ TclSubstCompile(
 	/* RETURN + other destination */
 	if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
-		    CurrentOffset(envPtr) - returnFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
 	}
 	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
-		    CurrentOffset(envPtr) - otherFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
 	}
 
 	/*
@@ -826,7 +826,7 @@ TclSubstCompile(
 	/* OK destination */
 	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
-		    CurrentOffset(envPtr) - okFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
 	}
 	if (count > 1) {
 	    TclEmitInstInt1(INST_CONCAT1, count, envPtr);
@@ -836,7 +836,7 @@ TclSubstCompile(
 	/* CONTINUE jump to here */
 	if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
 	    Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
-		    CurrentOffset(envPtr) - endFixup.codeOffset);
+		    (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
 	}
 	bline = envPtr->line;
     }
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 672b1cd..97410df 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.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: tclCompExpr.c,v 1.106 2010/09/27 19:42:38 msofer Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.107 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -1381,13 +1381,13 @@ ParseExpr(
 	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
 		((start - limit) < parsePtr->string) ? "" : "...",
 		((start - limit) < parsePtr->string)
-			? (start - parsePtr->string) : limit - 3,
+			? (int) (start - parsePtr->string) : limit - 3,
 		((start - limit) < parsePtr->string)
 			? parsePtr->string : start - limit + 3,
 		(scanned < limit) ? scanned : limit - 3, start,
 		(scanned < limit) ? "" : "...", insertMark ? mark : "",
 		(start + scanned + limit > parsePtr->end)
-			? parsePtr->end - (start + scanned) : limit-3,
+			? (int) (parsePtr->end - start) - scanned : limit-3,
 		start + scanned,
 		(start + scanned + limit > parsePtr->end) ? "" : "...");
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index cfdeb94..ae90b9b 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.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: tclEnsemble.c,v 1.6 2010/12/09 15:09:07 dkf Exp $
+ * RCS: @(#) $Id: tclEnsemble.c,v 1.7 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -1513,7 +1513,7 @@ TclMakeEnsemble(
 		    Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
 		    if (Tcl_HideCommand(interp, "___tmp",
 			    Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) {
-			Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+			Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
 		    }
 		} else {
 		    /*
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index f90e4bc..427ba77 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.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: tclPreserve.c,v 1.12 2009/01/09 11:21:46 dkf Exp $
+ * RCS: @(#) $Id: tclPreserve.c,v 1.13 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -240,7 +240,7 @@ Tcl_Release(
      * Reference not found. This is a bug in the caller.
      */
 
-    Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", clientData);
+    Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", PTR2UINT(clientData));
 }
 
 /*
@@ -280,7 +280,7 @@ Tcl_EventuallyFree(
 	    continue;
 	}
 	if (refPtr->mustFree) {
-	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x", clientData);
+	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x", PTR2UINT(clientData));
 	}
 	refPtr->mustFree = 1;
 	refPtr->freeProc = freeProc;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 81ba0fb..e12153d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.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: tclTest.c,v 1.156 2010/12/01 09:58:52 nijtmans Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.157 2011/01/18 08:43:53 nijtmans Exp $
  */
 
 #include <math.h>
@@ -4492,7 +4492,7 @@ TestpanicCmd(
      */
 
     argString = Tcl_Merge(argc-1, argv+1);
-    Tcl_Panic(argString);
+    Tcl_Panic("%s", argString);
     ckfree((char *)argString);
 
     return TCL_OK;