diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-07-08 10:57:11 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-07-08 10:57:11 (GMT) |
commit | adecc7a1e1a45aab0805e6cb440eb3adf09e486a (patch) | |
tree | 4fe8a274a2300c18c6843b1249e2b33e343b895f /generic | |
parent | 7747ac024f699006066d1eb7919fab3f7715d835 (diff) | |
parent | 38cfc0dc1366ca379dae1e0b46b49c953362b043 (diff) | |
download | tcl-adecc7a1e1a45aab0805e6cb440eb3adf09e486a.zip tcl-adecc7a1e1a45aab0805e6cb440eb3adf09e486a.tar.gz tcl-adecc7a1e1a45aab0805e6cb440eb3adf09e486a.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclAssembly.c | 6 | ||||
-rw-r--r-- | generic/tclBasic.c | 18 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 4 | ||||
-rw-r--r-- | generic/tclCompCmds.c | 4 | ||||
-rw-r--r-- | generic/tclCompCmdsSZ.c | 3 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 2 | ||||
-rw-r--r-- | generic/tclCompile.c | 19 | ||||
-rw-r--r-- | generic/tclCompile.h | 13 | ||||
-rw-r--r-- | generic/tclConfig.c | 4 | ||||
-rw-r--r-- | generic/tclEncoding.c | 4 | ||||
-rw-r--r-- | generic/tclEnsemble.c | 16 | ||||
-rw-r--r-- | generic/tclFileName.c | 35 | ||||
-rw-r--r-- | generic/tclIO.c | 8 | ||||
-rw-r--r-- | generic/tclIORChan.c | 11 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 2 | ||||
-rw-r--r-- | generic/tclIndexObj.c | 23 | ||||
-rw-r--r-- | generic/tclInt.h | 19 | ||||
-rw-r--r-- | generic/tclLoad.c | 30 | ||||
-rw-r--r-- | generic/tclNamesp.c | 17 | ||||
-rw-r--r-- | generic/tclOO.c | 6 | ||||
-rw-r--r-- | generic/tclOOBasic.c | 2 | ||||
-rw-r--r-- | generic/tclPkg.c | 6 | ||||
-rw-r--r-- | generic/tclProc.c | 2 | ||||
-rw-r--r-- | generic/tclTrace.c | 22 | ||||
-rw-r--r-- | generic/tclUtil.c | 37 | ||||
-rw-r--r-- | generic/tclZlib.c | 12 |
26 files changed, 188 insertions, 137 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 02144a1..83f4fe9 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -265,7 +265,7 @@ static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, - TalInstDesc*); + const TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, @@ -350,7 +350,7 @@ static const Tcl_ObjType assembleCodeType = { * Source instructions recognized in the Tcl Assembly Language (TAL) */ -TalInstDesc TalInstructionTable[] = { +static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, (INST_PUSH1<<8 | INST_PUSH4), 0, 1}, @@ -1768,7 +1768,7 @@ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ - TalInstDesc* instPtr) /* Instruction that determines whether + const TalInstDesc* instPtr) /* Instruction that determines whether * the script is 'expr' or 'eval' */ { CompileEnv* envPtr = assemEnvPtr->envPtr; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0b02d0d..537750e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -134,6 +134,8 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, static Tcl_NRPostProc NRCoroutineActivateCallback; static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; +static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); + static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc NRTailcallEval; static Tcl_ObjCmdProc OldMathFuncProc; @@ -2610,7 +2612,7 @@ TclRenameCommand( Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { - Tcl_DStringAppend(&newFullName, "::", 2); + TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; @@ -3468,7 +3470,7 @@ Tcl_CreateMathFunc( data->clientData = clientData; Tcl_DStringInit(&bigName); - Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1); + TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); Tcl_DStringAppend(&bigName, name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), @@ -4363,7 +4365,7 @@ TclNRRunCallbacks( return result; } -int +static int NRCommand( ClientData data[], Tcl_Interp *interp, @@ -8593,7 +8595,7 @@ RewindCoroutine( corPtr->eePtr->rewind = 1; TclNRAddCallback(interp, RewindCoroutineCallback, state, NULL, NULL, NULL); - return NRInterpCoroutine(corPtr, interp, 0, NULL); + return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void @@ -8820,7 +8822,7 @@ NRCoroInjectObjCmd( } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); - if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) { + if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_AppendResult(interp, "can only inject a command into a coroutine", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", @@ -8849,7 +8851,7 @@ NRCoroInjectObjCmd( } int -NRInterpCoroutine( +TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -8971,12 +8973,12 @@ TclNRCoroutineObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), - /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine); + /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); Tcl_DStringFree(&ds); corPtr->cmdPtr = cmdPtr; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 6dfc705..f09ee70 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1045,9 +1045,9 @@ TclMakeFileCommandSafe( Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); - Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1); + TclDStringAppendLiteral(&oldBuf, "::tcl::file::"); Tcl_DStringInit(&newBuf); - Tcl_DStringAppend(&newBuf, "tcl:file:", -1); + TclDStringAppendLiteral(&newBuf, "tcl:file:"); for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { if (unsafeInfo[i].unsafe) { const char *oldName, *newName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5b7e0a5..3540716 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -820,7 +820,7 @@ TclCompileDictForCmd( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size); + TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); @@ -1961,7 +1961,7 @@ TclCompileForeachCmd( */ Tcl_DStringInit(&varList); - Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); + TclDStringAppendToken(&varList, &tokenPtr[1]); code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b950e21..8ed3a95 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1558,8 +1558,7 @@ IssueSwitchJumpTable( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, bodyToken[i]->start, - bodyToken[i]->size); + TclDStringAppendToken(&buffer, bodyToken[i]); hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, Tcl_DStringValue(&buffer), &isNew); if (isNew) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 4212b6d..890d518 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2296,7 +2296,7 @@ CompileExprTree( int length; Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); + TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = TclGetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1d88e11..d4ca284 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1661,8 +1661,8 @@ TclCompileScript( * have side effects that rely on the unmodified string. */ - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size); + TclDStringClear(&ds); + TclDStringAppendToken(&ds, &tokenPtr[1]); cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), @@ -2044,7 +2044,7 @@ TclCompileTokens( for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: - Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size); + TclDStringAppendToken(&textBuffer, tokenPtr); TclAdvanceLines(&envPtr->line, tokenPtr->start, tokenPtr->start + tokenPtr->size); break; @@ -2091,9 +2091,7 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; @@ -2120,9 +2118,7 @@ TclCompileTokens( if (Tcl_DStringLength(&textBuffer) > 0) { int literal; - literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); @@ -2145,13 +2141,10 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal; + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); - literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; - if (numCL) { TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, numCL, clPosition); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 58663fd..ba78c36 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -866,8 +866,7 @@ typedef struct { *---------------------------------------------------------------- */ -MODULE_SCOPE Tcl_NRPostProc NRCommand; -MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine; +MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- @@ -1365,6 +1364,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* + * Macros for making it easier to deal with tokens and DStrings. + */ + +#define TclDStringAppendToken(dsPtr, tokenPtr) \ + Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) +#define TclRegisterDStringLiteral(envPtr, dsPtr) \ + TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ + Tcl_DStringLength(dsPtr), /*flags*/ 0) + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index b4735e8..dea487a 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -155,7 +155,7 @@ Tcl_RegisterConfig( */ Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "::", -1); + TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* @@ -173,7 +173,7 @@ Tcl_RegisterConfig( } } - Tcl_DStringAppend(&cmdName, "::pkgconfig", -1); + TclDStringAppendLiteral(&cmdName, "::pkgconfig"); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 49418c9..0fa6661 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1872,9 +1872,9 @@ LoadTableEncoding( * Read lines from the encoding until EOF. */ - for (Tcl_DStringSetLength(&lineString, 0); + for (TclDStringClear(&lineString); (len = Tcl_Gets(chan, &lineString)) >= 0; - Tcl_DStringSetLength(&lineString, 0)) { + TclDStringClear(&lineString)) { const unsigned char *p; int to, from; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1e1a901..754e480 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1425,9 +1425,9 @@ TclMakeEnsemble( Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); - Tcl_DStringAppend(&hiddenBuf, "tcl:", -1); + TclDStringAppendLiteral(&hiddenBuf, "tcl:"); Tcl_DStringAppend(&hiddenBuf, name, -1); - Tcl_DStringAppend(&hiddenBuf, ":", -1); + TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { /* @@ -1443,14 +1443,14 @@ TclMakeEnsemble( * multi-word list differently to a single word. */ - Tcl_DStringAppend(&buf, "::tcl", -1); + TclDStringAppendLiteral(&buf, "::tcl"); if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) { Tcl_Panic("invalid ensemble name '%s'", name); } for (i = 0; i < nameCount; ++i) { - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); Tcl_DStringAppend(&buf, nameParts[i], -1); } } @@ -1485,7 +1485,7 @@ TclMakeEnsemble( Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { fromObj = Tcl_NewStringObj(map[i].name, -1); @@ -1615,10 +1615,10 @@ NsEnsembleImplementationCmdNR( Tcl_Panic("List of ensemble parameters is not a list"); } for (; len>0; len--,elemPtrs++) { - Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1); - Tcl_DStringAppend(&buf, " ", -1); + TclDStringAppendObj(&buf, *elemPtrs); + TclDStringAppendLiteral(&buf, " "); } - Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1); + TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 48c5454..edb6581 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -72,9 +72,9 @@ SetResultLength( { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { - Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); + TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { - Tcl_DStringAppend(resultPtr, "//?/", 4); + TclDStringAppendLiteral(resultPtr, "//?/"); } } @@ -131,7 +131,7 @@ ExtractWinRoot( if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; @@ -161,7 +161,7 @@ ExtractWinRoot( */ *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); @@ -180,9 +180,9 @@ ExtractWinRoot( break; } } - Tcl_DStringAppend(resultPtr, "//", 2); + TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; @@ -221,7 +221,7 @@ ExtractWinRoot( *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return tail; } @@ -1057,7 +1057,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); + TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1413,7 +1413,7 @@ Tcl_GlobObjCmd( search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); - Tcl_DStringAppend(&prefix, "\\", 1); + TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { @@ -1575,8 +1575,7 @@ Tcl_GlobObjCmd( Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&prefix, string, length); + TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } @@ -1592,11 +1591,9 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { - Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix), - Tcl_DStringLength(&prefix)); + TclDStringAppendDString(&str, &prefix); } - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&str, string, length); + TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -2401,9 +2398,9 @@ DoGlob( if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } @@ -2412,9 +2409,9 @@ DoGlob( case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } break; diff --git a/generic/tclIO.c b/generic/tclIO.c index a76aba3..ea6c2d7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4431,14 +4431,12 @@ Tcl_Gets( * for managing the storage. */ { Tcl_Obj *objPtr; - int charsStored, length; - const char *string; + int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); if (charsStored > 0) { - string = TclGetStringFromObj(objPtr, &length); - Tcl_DStringAppend(lineRead, string, length); + TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; @@ -7550,7 +7548,7 @@ Tcl_BadChannelOption( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 938def2..6fec40a 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1947,7 +1947,7 @@ ReflectGetOption( */ if (optionObj != NULL) { - Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); + TclDStringAppendObj(dsPtr, resObj); goto ok; } @@ -1982,7 +1982,7 @@ ReflectGetOption( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(dsPtr, " ", 1); + TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; @@ -3207,8 +3207,7 @@ ForwardProc( if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - Tcl_DStringAppend(paramPtr->getOpt.value, - TclGetString(resObj), -1); + TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); @@ -3233,7 +3232,7 @@ ForwardProc( Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); @@ -3253,7 +3252,7 @@ ForwardProc( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1); + TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bea1897..41a5aac 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -405,7 +405,7 @@ Tcl_GetCwd( return NULL; } Tcl_DStringInit(cwdPtr); - Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1); + TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index b206b35..85e0730 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -302,6 +302,10 @@ Tcl_GetIndexFromObjStruct( entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { + if (p1 == key) { + /* empty keys never match */ + continue; + } index = idx; goto done; } @@ -356,26 +360,31 @@ Tcl_GetIndexFromObjStruct( * Produce a fancy error message. */ - int count; + int count = 0; TclNewObj(resultPtr); + entryPtr = tablePtr; + while ((*entryPtr != NULL) && !**entryPtr) { + entryPtr = NEXT_ENTRY(entryPtr, offset); + } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); - if (STRING_AT(tablePtr, offset, 0) == NULL) { + if (*entryPtr == NULL) { Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", - STRING_AT(tablePtr, offset, 0), NULL); - for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; - *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { + *entryPtr, NULL); + entryPtr = NEXT_ENTRY(entryPtr, offset); + while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); - } else { + } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); + count++; } + entryPtr = NEXT_ENTRY(entryPtr, offset); } } Tcl_SetObjResult(interp, resultPtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 9068dfb..53a88d6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2920,6 +2920,10 @@ MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); +MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, + Tcl_Obj *objPtr); +MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); @@ -4452,6 +4456,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- + * Convenience macros for DStrings. + * The ANSI C "prototypes" for these macros are: + * + * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, + * const char *sLiteral); + * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); + */ + +#define TclDStringAppendLiteral(dsPtr, sLiteral) \ + Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) +#define TclDStringClear(dsPtr) \ + Tcl_DStringSetLength((dsPtr), 0) + +/* + *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 008a99d..ce4d6a4 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -198,9 +198,9 @@ Tcl_LoadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -211,7 +211,7 @@ Tcl_LoadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { @@ -329,7 +329,7 @@ Tcl_LoadObjCmd( code = TCL_ERROR; goto done; } - Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); + Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); } } @@ -348,14 +348,14 @@ Tcl_LoadObjCmd( * package name. */ - Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&initName, "_Init", 5); - Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); - Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&unloadName, "_Unload", 7); - Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11); + TclDStringAppendDString(&initName, &pkgName); + TclDStringAppendLiteral(&initName, "_Init"); + TclDStringAppendDString(&safeInitName, &pkgName); + TclDStringAppendLiteral(&safeInitName, "_SafeInit"); + TclDStringAppendDString(&unloadName, &pkgName); + TclDStringAppendLiteral(&unloadName, "_Unload"); + TclDStringAppendDString(&safeUnloadName, &pkgName); + TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the package and find the two @@ -623,9 +623,9 @@ Tcl_UnloadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -636,7 +636,7 @@ Tcl_UnloadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 73bc644..6a241f0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -24,7 +24,7 @@ */ #include "tclInt.h" -#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */ +#include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not @@ -803,10 +803,9 @@ Tcl_CreateNamespace( if (ancestorPtr != globalNsPtr) { register Tcl_DString *tempPtr = namePtr; - Tcl_DStringAppend(buffPtr, "::", 2); + TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); - Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr), - Tcl_DStringLength(namePtr)); + TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous @@ -814,7 +813,7 @@ Tcl_CreateNamespace( * very wrong (and strange). */ - Tcl_DStringSetLength(namePtr, 0); + TclDStringClear(namePtr); /* * Now swap the buffer pointers so that we build in the other @@ -916,7 +915,7 @@ Tcl_DeleteNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { cmdPtr = Tcl_GetHashValue(entryPtr); - if (cmdPtr->nreProc == NRInterpCoroutine) { + if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); @@ -1667,7 +1666,7 @@ DoImport( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, cmdName, -1); @@ -2241,7 +2240,7 @@ TclGetNamespaceForQualName( * qualName since it may be a string constant. */ - Tcl_DStringSetLength(&buffer, 0); + TclDStringClear(&buffer); Tcl_DStringAppend(&buffer, start, len); nsName = Tcl_DStringValue(&buffer); } @@ -2916,7 +2915,7 @@ NamespaceChildrenCmd( } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); } Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); diff --git a/generic/tclOO.c b/generic/tclOO.c index 26e6d75..821befd 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -356,14 +356,14 @@ InitFoundation( Tcl_DStringInit(&buffer); for (i=0 ; defineCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::define::", 14); + TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i=0 ; objdefCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17); + TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); @@ -657,7 +657,7 @@ AllocObject( Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, Tcl_GetCurrentNamespace(interp)->fullName, -1); - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, nameStr, -1); oPtr->command = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL); diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 5e983fc..35ad1eb 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1190,7 +1190,7 @@ TclOOCopyObjectCmd( Tcl_DStringAppend(&buffer, iPtr->varFramePtr->nsPtr->fullName, -1); } - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, name, -1); name = Tcl_DStringValue(&buffer); } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index fdaea57..382ffe3 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1712,11 +1712,11 @@ AddRequirementsToDString( int i; for (i = 0; i < reqc; i++) { - Tcl_DStringAppend(dsPtr, " ", 1); - Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1); + TclDStringAppendLiteral(dsPtr, " "); + TclDStringAppendObj(dsPtr, reqv[i]); } } else { - Tcl_DStringAppend(dsPtr, " 0-", -1); + TclDStringAppendLiteral(dsPtr, " 0-"); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index 7b0af3a..537008c 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -194,7 +194,7 @@ Tcl_ProcObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 25abdff..529c38a 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1298,9 +1298,9 @@ TraceCommandProc( Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { - Tcl_DStringAppend(&cmd, " rename", 7); + TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { - Tcl_DStringAppend(&cmd, " delete", 7); + TclDStringAppendLiteral(&cmd, " delete"); } /* @@ -1994,24 +1994,24 @@ TraceVarProc( #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " a", 2); + TclDStringAppendLiteral(&cmd, " a"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " r", 2); + TclDStringAppendLiteral(&cmd, " r"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " w", 2); + TclDStringAppendLiteral(&cmd, " w"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " u", 2); + TclDStringAppendLiteral(&cmd, " u"); } } else { #endif if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " array", 6); + TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " read", 5); + TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " write", 6); + TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " unset", 6); + TclDStringAppendLiteral(&cmd, " unset"); } #ifndef TCL_REMOVE_OBSOLETE_TRACES } @@ -2577,7 +2577,7 @@ TclCallVarTraces( char *newPart1; Tcl_DStringInit(&nameCopy); - Tcl_DStringAppend(&nameCopy, part1, (p-part1)); + Tcl_DStringAppend(&nameCopy, part1, p-part1); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index d5a3b94..3379f6c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2438,6 +2438,37 @@ Tcl_DStringAppend( /* *---------------------------------------------------------------------- * + * TclDStringAppendObj, TclDStringAppendDString -- + * + * Simple wrappers round Tcl_DStringAppend that make it easier to append + * from particular sources of strings. + * + *---------------------------------------------------------------------- + */ + +char * +TclDStringAppendObj( + Tcl_DString *dsPtr, + Tcl_Obj *objPtr) +{ + int length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + + return Tcl_DStringAppend(dsPtr, bytes, length); +} + +char * +TclDStringAppendDString( + Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr) +{ + return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr), + Tcl_DStringLength(toAppendPtr)); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. @@ -2793,9 +2824,9 @@ Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { - Tcl_DStringAppend(dsPtr, " {", -1); + TclDStringAppendLiteral(dsPtr, " {"); } else { - Tcl_DStringAppend(dsPtr, "{", -1); + TclDStringAppendLiteral(dsPtr, "{"); } } @@ -2821,7 +2852,7 @@ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { - Tcl_DStringAppend(dsPtr, "}", -1); + TclDStringAppendLiteral(dsPtr, "}"); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index b970b3d..a799639 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -573,9 +573,8 @@ Tcl_ZlibStreamInit( goto error; } Tcl_DStringInit(&cmdname); - Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1); - Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)), - -1); + TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); + TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname), &cmdinfo) == 1) { Tcl_SetResult(interp, @@ -2695,10 +2694,7 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { - int len; - const char *str = Tcl_GetStringFromObj(tmpObj, &len); - - Tcl_DStringAppend(dsPtr, str, len); + TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; } @@ -3022,7 +3018,7 @@ ResultCopy( */ memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); - Tcl_DStringSetLength(&cd->decompressed, 0); + TclDStringClear(&cd->decompressed); return have; } } |