Various mismatches between Tcl_Panic format string and its arguments,

discovered thanks to [Bug 3159920]

6 files changed, 45 insertions, 37 deletions

diff --git a/ChangeLog b/ChangeLog
index 7e44c77..4a03fe2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+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/tclCompExpr.c:   discovered thanks to [Bug 3159920]
+	* generic/tclPreserve.c:   (Backported)
+	* generic/tclTest.c:
+
 2011-01-17  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tcl.m4:         handle --enable-64bit=ia64 for gcc. BACKPORT.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e686237..f91901d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.295.2.19 2010/11/15 21:32:31 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.295.2.20 2011/01/18 10:02:02 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -830,7 +830,7 @@ Tcl_CreateInterp(void)
     Tcl_InitStubs(interp, TCL_VERSION, 1);
 
     if (TclTommath_Init(interp) != TCL_OK) {
-	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 
     return interp;
@@ -4847,7 +4847,7 @@ TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
 						    (char *) objv[word]);
 		    if (hPtr) {
 			CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
- 
+
 			if (cfwPtr->prevPtr) {
 			    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
 			} else {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5f25c59..934d63d 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.143.2.4 2010/11/05 00:06:58 kennykb Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.143.2.5 2011/01/18 10:02:03 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -497,7 +497,7 @@ TclCompileCatchCmd(
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
     /* Stack at this point: ?script? <mark> result TCL_OK */
 
-    /* 
+    /*
      * Emit the "error case" epilogue. Push the interpreter result
      * and the return code.
      */
@@ -509,13 +509,13 @@ TclCompileCatchCmd(
     TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
 
     /*
-     * Update the target of the jump after the "no errors" code. 
+     * Update the target of the jump after the "no errors" code.
      */
 
     /* 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 */
@@ -573,7 +573,7 @@ TclCompileCatchCmd(
 	TclEmitOpcode(INST_POP, envPtr);
     }
 
-    /* 
+    /*
      * Stack is now ?script? result. Get rid of the subst'ed script
      * if it's hanging arond.
      */
@@ -583,7 +583,7 @@ TclCompileCatchCmd(
 	TclEmitOpcode(INST_POP, envPtr);
     }
 
-    /* 
+    /*
      * Result of all this, on either branch, should have been to leave
      * one operand -- the return code -- on the stack.
      */
@@ -1211,7 +1211,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/tclCompExpr.c b/generic/tclCompExpr.c
index 6eda4d6..224d330 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.97.2.1 2010/01/06 21:35:25 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.97.2.2 2011/01/18 10:02:03 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -50,7 +50,7 @@ typedef struct OpNode {
  * filled with a pointer to its single operand.  When an operand is a
  * subexpression the "pointer" takes the form of the index -- a non-negative
  * integer -- into the OpNode storage array where the root of that
- * subexpression parse tree is found.  
+ * subexpression parse tree is found.
  *
  * Non-operator elements of the expression do not get stored in the OpNode
  * tree.  They are stored in the other structures according to their type.
@@ -150,7 +150,7 @@ enum Marks {
 				 * for it.  Either a literal value will be
 				 * appended to the list of literals in this
 				 * expression, or appropriate Tcl_Tokens will
-				 * be appended in a Tcl_Parse struct to 
+				 * be appended in a Tcl_Parse struct to
 				 * represent those leaves that require some
 				 * form of substitution.
 				 */
@@ -325,7 +325,7 @@ enum Precedence {
 
 /*
  * Here the same information contained in the comments above is stored
- * in inverted form, so that given a lexeme, one can quickly look up 
+ * in inverted form, so that given a lexeme, one can quickly look up
  * its precedence value.
  */
 
@@ -369,7 +369,7 @@ static const unsigned char prec[] = {
     0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
-    0,  
+    0,
     /* Unary operator lexemes */
     PREC_UNARY,		/* UNARY_PLUS */
     PREC_UNARY,		/* UNARY_MINUS */
@@ -424,7 +424,7 @@ static const unsigned char instruction[] = {
     0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
-    0,  
+    0,
     /* Unary operator lexemes */
     INST_UPLUS,		/* UNARY_PLUS */
     INST_UMINUS,	/* UNARY_MINUS */
@@ -492,7 +492,7 @@ static unsigned char Lexeme[] = {
 
 typedef struct JumpList {
     JumpFixup jump;		/* Pass this argument to matching calls of
-				 * TclEmitForwardJump() and 
+				 * TclEmitForwardJump() and
 				 * TclFixupForwardJump(). */
     int depth;			/* Remember the currStackDepth of the
 				 * CompileEnv here. */
@@ -582,7 +582,7 @@ ParseExpr(
 				 * for most expressions to parse with no need
 				 * for array growth and reallocation. */
     int nodesUsed = 0;		/* Number of OpNodes filled. */
-    int scanned = 0;		/* Capture number of byte scanned by 
+    int scanned = 0;		/* Capture number of byte scanned by
 				 * parsing routines. */
     int lastParsed;		/* Stores info about what the lexeme parsed
 				 * the previous pass through the parsing loop
@@ -708,7 +708,7 @@ ParseExpr(
 		 * Most barewords in an expression are a syntax error.
 		 * The exceptions are that when a bareword is followed by
 		 * an open paren, it might be a function call, and when the
-		 * bareword is a legal literal boolean value, we accept that 
+		 * bareword is a legal literal boolean value, we accept that
 		 * as well.
 		 */
 
@@ -833,7 +833,7 @@ ParseExpr(
 
 	    switch (lexeme) {
 	    case NUMBER:
-	    case BOOLEAN: 
+	    case BOOLEAN:
 		/*
 		 * TODO: Consider using a dict or hash to collapse all
 		 * duplicate literals into a single representative value.
@@ -855,7 +855,7 @@ ParseExpr(
 		start += scanned;
 		numBytes -= scanned;
 		continue;
-	    
+
 	    default:
 		break;
 	    }
@@ -1112,7 +1112,7 @@ ParseExpr(
 
 	    /*
 	     * Here is where the tree comes together.  At this point, we
-	     * have a stack of incomplete trees corresponding to 
+	     * have a stack of incomplete trees corresponding to
 	     * substrings that are incomplete expressions, followed by
 	     * a complete tree corresponding to a substring that is itself
 	     * a complete expression, followed by the binary operator we have
@@ -1293,7 +1293,7 @@ ParseExpr(
 	    nodePtr->mark = MARK_LEFT;
 	    nodePtr->left = complete;
 
-	    /* 
+	    /*
 	     * The COMMA operator cannot be optimized, since the function
 	     * needs all of its arguments, and optimization would reduce
 	     * the number.  Other binary operators root constant expressions
@@ -1371,13 +1371,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) ? "" : "...");
 
@@ -1495,7 +1495,7 @@ ConvertTreeToTokens(
 	     * of those few callers of Tcl_ParseExpr() we do not change
 	     * them now.  Internally, we can do better.
 	     */
-	
+
 	    int toCopy = tokenPtr->numComponents + 1;
 
 	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
@@ -1513,7 +1513,7 @@ ConvertTreeToTokens(
 		parsePtr->numTokens += toCopy;
 	    } else {
 
-		/* 
+		/*
 		 * Multiple element word.  Create a TCL_TOKEN_SUB_EXPR
 		 * token to lead, with fields initialized from the leading
 		 * token, then copy entire set of word tokens.
@@ -1553,7 +1553,7 @@ ConvertTreeToTokens(
 	    case COMMA:
 	    case COLON:
 
-		/* 
+		/*
 		 * Historical practice has been to have no Tcl_Tokens for
 		 * these operators.
 		 */
@@ -1680,7 +1680,7 @@ ConvertTreeToTokens(
 		/*
 		 * Before we leave this node/operator/subexpression for the
 		 * last time, finish up its tokens....
-		 * 
+		 *
 		 * Our current position scanning the string is where the
 		 * substring for the subexpression ends.
 		 */
@@ -1988,7 +1988,7 @@ ParseLexeme(
  * TclCompileExpr --
  *
  *	This procedure compiles a string containing a Tcl expression into Tcl
- *	bytecodes. 
+ *	bytecodes.
  *
  * Results:
  *	None.
@@ -2232,7 +2232,7 @@ CompileExprTree(
 		 * Use the numWords count we've kept to invoke the
 		 * function command with the correct number of arguments.
 		 */
-		
+
 		if (numWords < 255) {
 		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
 		} else {
@@ -2439,7 +2439,7 @@ TclSingleOpCmd(
  *----------------------------------------------------------------------
  *
  * TclSortingOpCmd --
- *	Implements the commands: <, <=, >, >=, ==, eq 
+ *	Implements the commands: <, <=, >, >=, ==, eq
  *	in the ::tcl::mathop namespace.  These commands are defined for
  *	arbitrary number of arguments by computing the AND of the base
  * 	operator applied to all neighbor argument pairs.
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index 3c991ea..ef7616e 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.10 2007/03/21 18:02:51 dgp Exp $
+ * RCS: @(#) $Id: tclPreserve.c,v 1.10.4.1 2011/01/18 10:02:03 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));
 }
 
 /*
@@ -281,7 +281,7 @@ Tcl_EventuallyFree(
 	}
 	if (refPtr->mustFree) {
 	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x",
-		    clientData);
+		    PTR2UINT(clientData));
         }
         refPtr->mustFree = 1;
 	refPtr->freeProc = freeProc;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 29c003f..f7d273d 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.114.2.8 2010/11/30 20:59:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.114.2.9 2011/01/18 10:02:03 nijtmans Exp $
  */
 
 #include <math.h>
@@ -4499,7 +4499,7 @@ TestpanicCmd(
      */
 
     argString = Tcl_Merge(argc-1, argv+1);
-    Tcl_Panic(argString);
+    Tcl_Panic("%s", argString);
     ckfree((char *)argString);
 
     return TCL_OK;