diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclBasic.c | 6 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 14 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 44 | ||||
| -rw-r--r-- | generic/tclPreserve.c | 6 | ||||
| -rw-r--r-- | generic/tclTest.c | 4 |
6 files changed, 45 insertions, 37 deletions
@@ -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; |