From e5a2ebd71b2aa2b31ca5128eb47ae0a7fdd20bd5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 17 Jan 2022 10:35:18 +0000 Subject: Follow-up to [767e070d35]: Tcl_GetRange and Tcl_GetUniChar do not validate index inputs. Now that Tcl_GetRange() checks its arguments, the callers of this function don't have to do that any more. This also shows a off-by-one error in the Tcl_GetRange() check --- generic/tclCmdMZ.c | 10 +--------- generic/tclExecute.c | 33 ++++----------------------------- generic/tclStringObj.c | 7 +++---- 3 files changed, 8 insertions(+), 42 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index da3fc8b..5422b7f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2183,15 +2183,7 @@ StringRangeCmd( return TCL_ERROR; } - if (first < 0) { - first = 0; - } - if (last >= length) { - last = length; - } - if (last >= first) { - Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); - } + Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e5a6b71..c39bc21 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5609,17 +5609,7 @@ TEBCresume( goto gotError; } - if (fromIdx < 0) { - fromIdx = 0; - } - if (toIdx >= length) { - toIdx = length; - } - if (toIdx >= fromIdx) { - objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); - } else { - TclNewObj(objResultPtr); - } + objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); @@ -5652,13 +5642,6 @@ TEBCresume( } toIdx = TclIndexDecode(toIdx, length - 1); - if (toIdx < 0) { - goto emptyRange; - } else if (toIdx >= length) { - toIdx = length - 1; - } - - assert ( toIdx >= 0 && toIdx < length ); /* assert ( fromIdx != TCL_INDEX_BEFORE ); @@ -5670,19 +5653,11 @@ TEBCresume( fromIdx = TCL_INDEX_START; } if (fromIdx == TCL_INDEX_AFTER) { - goto emptyRange; - } - - fromIdx = TclIndexDecode(fromIdx, length - 1); - if (fromIdx < 0) { - fromIdx = 0; - } - - if (fromIdx <= toIdx) { - objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); - } else { emptyRange: TclNewObj(objResultPtr); + } else { + fromIdx = TclIndexDecode(fromIdx, length - 1); + objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index edfcb9f..fc675cf 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -739,8 +739,7 @@ Tcl_GetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. The first and last indices are - * assumed to be in the appropriate range. + * String object, convert it to one. * * Results: * Returns a new Tcl Object of the String type. @@ -818,8 +817,8 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - if (last > stringPtr->numChars) { - last = stringPtr->numChars; + if (last >= stringPtr->numChars) { + last = stringPtr->numChars - 1; } if (last < first) { return Tcl_NewObj(); -- cgit v0.12 From 01a48e2369782044a30d922c5f8ed52262ef4fcd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 17 Jan 2022 16:44:44 +0000 Subject: Tcl_NewObj() -> TclNewObj() --- generic/tclBasic.c | 10 +++++----- generic/tclBinary.c | 10 +++++----- generic/tclCompCmds.c | 35 ++++++++++++++++++----------------- generic/tclCompCmdsGR.c | 19 ++++++++++--------- generic/tclCompCmdsSZ.c | 14 ++++++++------ generic/tclCompExpr.c | 22 ++++++++++++++-------- generic/tclCompile.c | 5 +++-- generic/tclDisassemble.c | 29 ++++++++++++++++------------- generic/tclEncoding.c | 6 ++++-- generic/tclEnsemble.c | 8 +++++--- generic/tclIOCmd.c | 8 ++++---- generic/tclIORTrans.c | 2 +- generic/tclIOUtil.c | 11 ++++++----- generic/tclInterp.c | 10 ++++++---- generic/tclOO.c | 2 +- generic/tclOOBasic.c | 2 +- generic/tclOODefineCmds.c | 18 +++++++++--------- generic/tclOOInfo.c | 36 ++++++++++++++++++------------------ generic/tclOOMethod.c | 7 ++++--- generic/tclPathObj.c | 11 ++++++----- generic/tclPipe.c | 2 +- generic/tclPkg.c | 5 +++-- generic/tclRegexp.c | 2 +- generic/tclResult.c | 10 ++++++---- generic/tclStringObj.c | 11 +++++++---- generic/tclTimer.c | 18 ++++++++++-------- 26 files changed, 172 insertions(+), 141 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index aebcab7..5975fd3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -517,7 +517,7 @@ Tcl_CreateInterp(void) iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; iPtr->errorLine = 0; - iPtr->objResultPtr = Tcl_NewObj(); + TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; @@ -606,7 +606,7 @@ Tcl_CreateInterp(void) iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ - iPtr->emptyObjPtr = Tcl_NewObj(); + TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; @@ -671,7 +671,7 @@ Tcl_CreateInterp(void) * TIP #285, Script cancellation support. */ - iPtr->asyncCancelMsg = Tcl_NewObj(); + TclNewObj(iPtr->asyncCancelMsg); cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo)); cancelInfo->interp = interp; @@ -2652,7 +2652,7 @@ TclRenameCommand( } cmdNsPtr = cmdPtr->nsPtr; - oldFullName = Tcl_NewObj(); + TclNewObj(oldFullName); Tcl_IncrRefCount(oldFullName); Tcl_GetCommandFullName(interp, cmd, oldFullName); @@ -3857,7 +3857,7 @@ Tcl_ListMathFuncs( if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { - result = Tcl_NewObj(); + TclNewObj(result); } Tcl_DecrRefCount(script); Tcl_RestoreInterpState(interp, state); diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 6f36d54..5d317fa 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -927,7 +927,7 @@ BinaryFormatCmd( * bytes and filling with nulls. */ - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, length); @@ -1360,7 +1360,7 @@ BinaryScanCmd( } } src = buffer + offset; - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); @@ -1415,7 +1415,7 @@ BinaryScanCmd( } } src = buffer + offset; - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); @@ -1499,7 +1499,7 @@ BinaryScanCmd( if ((length - offset) < (count * size)) { goto done; } - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); src = buffer + offset; for (i = 0; i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); @@ -2521,7 +2521,7 @@ BinaryEncode64( maxlen = 0; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c8970ce..f28175b 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -311,7 +311,7 @@ TclCompileArraySetCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); dataTokenPtr = TokenAfter(varTokenPtr); - literalObj = Tcl_NewObj(); + TclNewObj(literalObj); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK); @@ -890,10 +890,10 @@ TclCompileConcatCmd( * implement with a simple push. */ - listObj = Tcl_NewObj(); + TclNewObj(listObj); for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { Tcl_DecrRefCount(objPtr); Tcl_DecrRefCount(listObj); @@ -1288,10 +1288,10 @@ TclCompileDictCreateCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - dictObj = Tcl_NewObj(); + TclNewObj(dictObj); Tcl_IncrRefCount(dictObj); for (i=1 ; inumWords ; i+=2) { - keyObj = Tcl_NewObj(); + TclNewObj(keyObj); Tcl_IncrRefCount(keyObj); if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) { Tcl_DecrRefCount(keyObj); @@ -1299,7 +1299,7 @@ TclCompileDictCreateCmd( goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); - valueObj = Tcl_NewObj(); + TclNewObj(valueObj); Tcl_IncrRefCount(valueObj); if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) { Tcl_DecrRefCount(keyObj); @@ -2298,8 +2298,9 @@ DisassembleDictUpdateInfo( { DictUpdateInfo *duiPtr = clientData; int i; - Tcl_Obj *variables = Tcl_NewObj(); + Tcl_Obj *variables; + TclNewObj(variables); for (i=0 ; ilength ; i++) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewIntObj(duiPtr->varIndices[i])); @@ -2722,7 +2723,7 @@ CompileEachloopCmd( * a scalar, or if any var list needs substitutions. */ - varListObj = Tcl_NewObj(); + TclNewObj(varListObj); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { @@ -3041,7 +3042,7 @@ DisassembleForeachInfo( * Data stores. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(infoPtr->firstValueTemp + i)); @@ -3059,9 +3060,9 @@ DisassembleForeachInfo( * Assignment targets. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { - innerPtr = Tcl_NewObj(); + TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, @@ -3095,9 +3096,9 @@ DisassembleNewForeachInfo( * Assignment targets. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; inumLists ; i++) { - innerPtr = Tcl_NewObj(); + TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, @@ -3155,7 +3156,7 @@ TclCompileFormatCmd( * a case we can handle by compiling to a constant. */ - formatObj = Tcl_NewObj(); + TclNewObj(formatObj); Tcl_IncrRefCount(formatObj); tokenPtr = TokenAfter(tokenPtr); if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) { @@ -3166,7 +3167,7 @@ TclCompileFormatCmd( objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); - objv[i] = Tcl_NewObj(); + TclNewObj(objv[i]); Tcl_IncrRefCount(objv[i]); if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) { goto checkForStringConcatCase; @@ -3258,7 +3259,7 @@ TclCompileFormatCmd( start = Tcl_GetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ - tmpObj = Tcl_NewObj(); /* The buffer used to accumulate the literal + TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { @@ -3276,7 +3277,7 @@ TclCompileFormatCmd( if (len > 0) { PushLiteral(envPtr, b, len); Tcl_DecrRefCount(tmpObj); - tmpObj = Tcl_NewObj(); + TclNewObj(tmpObj); i++; } diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index c453878..a324706 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -54,9 +54,10 @@ TclGetIndexFromToken( int after, int *indexPtr) { - Tcl_Obj *tmpObj = Tcl_NewObj(); + Tcl_Obj *tmpObj; int result = TCL_ERROR; + TclNewObj(tmpObj); if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr); } @@ -599,7 +600,7 @@ TclCompileInfoCommandsCmd( return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { goto notCompilable; @@ -1180,9 +1181,9 @@ TclCompileListCmd( numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); - listObj = Tcl_NewObj(); + TclNewObj(listObj); for (i = 1; i < numWords && listObj != NULL; i++) { - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) { (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } else { @@ -2289,7 +2290,7 @@ TclCompileRegsubCmd( Tcl_DStringInit(&pattern); tokenPtr = TokenAfter(tokenPtr); - patternObj = Tcl_NewObj(); + TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } @@ -2300,7 +2301,7 @@ TclCompileRegsubCmd( } tokenPtr = TokenAfter(tokenPtr); Tcl_DecrRefCount(patternObj); - patternObj = Tcl_NewObj(); + TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } @@ -2315,7 +2316,7 @@ TclCompileRegsubCmd( stringTokenPtr = TokenAfter(tokenPtr); tokenPtr = TokenAfter(stringTokenPtr); - replacementObj = Tcl_NewObj(); + TclNewObj(replacementObj); if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { goto done; } @@ -2466,7 +2467,7 @@ TclCompileReturnCmd( */ for (objc = 0; objc < numOptionWords; objc++) { - objv[objc] = Tcl_NewObj(); + TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { /* @@ -2686,7 +2687,7 @@ TclCompileUpvarCmd( * Push the frame index if it is known at compile time */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { CallFrame *framePtr; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index ddfe0dc..862ebb5 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -248,7 +248,7 @@ TclCompileStringCatCmd( folded = NULL; wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { - obj = Tcl_NewObj(); + TclNewObj(obj); if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) { if (folded) { Tcl_AppendObjToObj(folded, obj); @@ -482,7 +482,7 @@ TclCompileStringIsCmd( if (parsePtr->numWords < 3 || parsePtr->numWords > 6) { return TCL_ERROR; } - isClass = Tcl_NewObj(); + TclNewObj(isClass); if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) { Tcl_DecrRefCount(isClass); return TCL_ERROR; @@ -878,7 +878,7 @@ TclCompileStringMapCmd( } mapTokenPtr = TokenAfter(parsePtr->tokenPtr); stringTokenPtr = TokenAfter(mapTokenPtr); - mapObj = Tcl_NewObj(); + TclNewObj(mapObj); Tcl_IncrRefCount(mapObj); if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); @@ -1418,7 +1418,7 @@ TclCompileSubstCmd( objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); for (objc = 0; objc < /*numArgs*/ numOpts; objc++) { - objv[objc] = Tcl_NewObj(); + TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { objc++; @@ -2570,12 +2570,13 @@ DisassembleJumptableInfo( unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; - Tcl_Obj *mapping = Tcl_NewObj(); + Tcl_Obj *mapping; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; + TclNewObj(mapping); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); @@ -3587,8 +3588,9 @@ TclCompileUnsetCmd( */ for (i=1,varTokenPtr=parsePtr->tokenPtr ; inumWords ; i++) { - Tcl_Obj *leadingWord = Tcl_NewObj(); + Tcl_Obj *leadingWord; + TclNewObj(leadingWord); varTokenPtr = TokenAfter(varTokenPtr); if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { TclDecrRefCount(leadingWord); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 52b62fc..ca9a21a 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1001,7 +1001,7 @@ ParseExpr( * later. */ - literal = Tcl_NewObj(); + TclNewObj(literal); if (TclWordKnownAtCompileTime(tokenPtr, literal)) { Tcl_ListObjAppendElement(NULL, litList, literal); complete = lastParsed = OT_LITERAL; @@ -1828,8 +1828,8 @@ Tcl_ParseExpr( { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ - Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */ - Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */ + Tcl_Obj *litList; /* List to hold the literals. */ + Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ @@ -1837,6 +1837,8 @@ Tcl_ParseExpr( numBytes = (start ? strlen(start) : 0); } + TclNewObj(litList); + TclNewObj(funcList); code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); Tcl_DecrRefCount(funcList); @@ -2003,7 +2005,7 @@ ParseLexeme( } } - literal = Tcl_NewObj(); + TclNewObj(literal); if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, TCL_PARSE_NO_WHITESPACE) == TCL_OK) { if (end < start + numBytes && !TclIsBareword(*end)) { @@ -2117,12 +2119,15 @@ TclCompileExpr( int optimize) /* 0 for one-off expressions. */ { OpNode *opTree = NULL; /* Will point to the tree of operators */ - Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ - Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ + Tcl_Obj *litList; /* List to hold the literals */ + Tcl_Obj *funcList; /* List to hold the functon names*/ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ + int code; - int code = ParseExpr(interp, script, numBytes, &opTree, litList, + TclNewObj(litList); + TclNewObj(funcList); + code = ParseExpr(interp, script, numBytes, &opTree, litList, funcList, parsePtr, 0 /* parseOnly */); if (code == TCL_OK) { @@ -2181,9 +2186,10 @@ ExecConstantExprTree( CompileEnv *envPtr; ByteCode *byteCodePtr; int code; - Tcl_Obj *byteCodeObj = Tcl_NewObj(); + Tcl_Obj *byteCodeObj; NRE_callback *rootPtr = TOP_CB(interp); + TclNewObj(byteCodeObj); /* * Note we are compiling an expression with literal arguments. This means * there can be no [info frame] calls when we execute the resulting diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 4a50089..9a59b71 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1710,7 +1710,7 @@ TclWordKnownAtCompileTime( } tokenPtr++; if (valuePtr != NULL) { - tempPtr = Tcl_NewObj(); + TclNewObj(tempPtr); Tcl_IncrRefCount(tempPtr); } while (numComponents--) { @@ -1999,7 +1999,7 @@ CompileCommandTokens( Interp *iPtr = (Interp *) interp; Tcl_Token *tokenPtr = parsePtr->tokenPtr; ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; - Tcl_Obj *cmdObj = Tcl_NewObj(); + Tcl_Obj *cmdObj; Command *cmdPtr = NULL; int code = TCL_ERROR; int cmdKnown, expand = -1; @@ -2010,6 +2010,7 @@ CompileCommandTokens( int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); + TclNewObj(cmdObj); assert (parsePtr->numWords > 0); /* Pre-Compile */ diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 8b137d4..3b03c42 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -798,8 +798,9 @@ Tcl_Obj * TclNewInstNameObj( unsigned char inst) { - Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_Obj *objPtr; + TclNewObj(objPtr); objPtr->typePtr = &tclInstNameType; objPtr->internalRep.longValue = (long) inst; objPtr->bytes = NULL; @@ -943,7 +944,7 @@ DisassembleByteCodeAsDicts( * Get the literals from the bytecode. */ - literals = Tcl_NewObj(); + TclNewObj(literals); for (i=0 ; inumLitObjects ; i++) { Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]); } @@ -952,7 +953,7 @@ DisassembleByteCodeAsDicts( * Get the variables from the bytecode. */ - variables = Tcl_NewObj(); + TclNewObj(variables); if (codePtr->procPtr) { int localCount = codePtr->procPtr->numCompiledLocals; CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr; @@ -960,7 +961,7 @@ DisassembleByteCodeAsDicts( for (i=0 ; inextPtr) { Tcl_Obj *descriptor[2]; - descriptor[0] = Tcl_NewObj(); + TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("scalar", -1)); @@ -1000,12 +1001,12 @@ DisassembleByteCodeAsDicts( * Get the instructions from the bytecode. */ - instructions = Tcl_NewObj(); + TclNewObj(instructions); for (pc=codePtr->codeStart; pccodeStart+codePtr->numCodeBytes;){ const InstructionDesc *instDesc = &tclInstructionTable[*pc]; int address = pc - codePtr->codeStart; - inst = Tcl_NewObj(); + TclNewObj(inst); Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( instDesc->name, -1)); opnd = pc + 1; @@ -1103,21 +1104,23 @@ DisassembleByteCodeAsDicts( * Get the auxiliary data from the bytecode. */ - aux = Tcl_NewObj(); + TclNewObj(aux); for (i=0 ; inumAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); if (auxData->type->disassembleProc) { - Tcl_Obj *desc = Tcl_NewObj(); + Tcl_Obj *desc; + TclNewObj(desc); Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc); auxDesc = desc; auxData->type->disassembleProc(auxData->clientData, auxDesc, codePtr, 0); } else if (auxData->type->printProc) { - Tcl_Obj *desc = Tcl_NewObj(); + Tcl_Obj *desc; + TclNewObj(desc); auxData->type->printProc(auxData->clientData, desc, codePtr, 0); Tcl_ListObjAppendElement(NULL, auxDesc, desc); } @@ -1128,7 +1131,7 @@ DisassembleByteCodeAsDicts( * Get the exception ranges from the bytecode. */ - exn = Tcl_NewObj(); + TclNewObj(exn); for (i=0 ; inumExceptRanges ; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; @@ -1163,7 +1166,7 @@ DisassembleByteCodeAsDicts( ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \ : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1))) - commands = Tcl_NewObj(); + TclNewObj(commands); codeOffPtr = codePtr->codeDeltaStart; codeLenPtr = codePtr->codeLengthStart; srcOffPtr = codePtr->srcDeltaStart; @@ -1176,7 +1179,7 @@ DisassembleByteCodeAsDicts( codeLength = Decode(codeLenPtr); sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); - cmd = Tcl_NewObj(); + TclNewObj(cmd); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1), Tcl_NewIntObj(codeOffset)); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1), @@ -1211,7 +1214,7 @@ DisassembleByteCodeAsDicts( * Build the overall result. */ - description = Tcl_NewObj(); + TclNewObj(description); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1), literals); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1), diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 8fff493..4c59bc6 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -481,12 +481,13 @@ FillEncodingFileMap(void) */ int j, numFiles; - Tcl_Obj *directory, *matchFileList = Tcl_NewObj(); + Tcl_Obj *directory, *matchFileList; Tcl_Obj **filev; Tcl_GlobTypeData readableFiles = { TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL }; + TclNewObj(matchFileList); Tcl_ListObjIndex(NULL, searchPath, i, &directory); Tcl_IncrRefCount(directory); Tcl_IncrRefCount(matchFileList); @@ -903,10 +904,11 @@ Tcl_GetEncodingNames( Tcl_HashTable table; Tcl_HashSearch search; Tcl_HashEntry *hPtr; - Tcl_Obj *map, *name, *result = Tcl_NewObj(); + Tcl_Obj *map, *name, *result; Tcl_DictSearch mapSearch; int dummy, done = 0; + TclNewObj(result); Tcl_InitObjHashTable(&table); /* diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 7f47510..bdf4d84 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2913,7 +2913,7 @@ TclCompileEnsemble( DefineLineInformation; Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; - Tcl_Obj *replaced = Tcl_NewObj(), *replacement; + Tcl_Obj *replaced, *replacement; Tcl_Command ensemble = (Tcl_Command) cmdPtr; Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; @@ -2921,6 +2921,7 @@ TclCompileEnsemble( unsigned numBytes; const char *word; + TclNewObj(replaced); Tcl_IncrRefCount(replaced); if (parsePtr->numWords < depth + 1) { goto failed; @@ -3424,7 +3425,7 @@ CompileToInvokedCommand( * the implementation. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { @@ -3463,8 +3464,9 @@ CompileBasicNArgCommand( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_Obj *objPtr; + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index af1295f..f11a4ab 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -323,7 +323,7 @@ Tcl_GetsObjCmd( } TclChannelPreserve(chan); - linePtr = Tcl_NewObj(); + TclNewObj(linePtr); lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { @@ -463,7 +463,7 @@ Tcl_ReadObjCmd( } } - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); @@ -991,7 +991,7 @@ Tcl_ExecObjCmd( return TCL_OK; } - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) { if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) { /* @@ -1903,7 +1903,7 @@ ChanPipeObjCmd( channelNames[0] = Tcl_GetChannelName(rchan); channelNames[1] = Tcl_GetChannelName(wchan); - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[0], -1)); Tcl_ListObjAppendElement(NULL, resultPtr, diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index eecd412..97540a6 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1224,7 +1224,7 @@ ReflectInput( } if (Tcl_IsShared(bufObj)) { Tcl_DecrRefCount(bufObj); - bufObj = Tcl_NewObj(); + TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } Tcl_SetByteArrayLength(bufObj, 0); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 312fd08..1f8076a 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1775,7 +1775,7 @@ Tcl_FSEvalFileEx( } } - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* @@ -1909,7 +1909,7 @@ TclNREvalFile( } } - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* @@ -3878,8 +3878,9 @@ Tcl_Obj * Tcl_FSListVolumes(void) { FilesystemRecord *fsRecPtr; - Tcl_Obj *resultPtr = Tcl_NewObj(); + Tcl_Obj *resultPtr; + TclNewObj(resultPtr); /* * Call each of the "listVolumes" function in succession. A non-NULL * return value indicates the particular function has succeeded. We call @@ -3945,7 +3946,7 @@ FsListMounts( if (fsRecPtr->fsPtr != &tclNativeFilesystem && fsRecPtr->fsPtr->matchInDirectoryProc != NULL) { if (resultPtr == NULL) { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); } fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr, pattern, &mountsOnly); @@ -4021,7 +4022,7 @@ Tcl_FSSplitPath( * slashes (for example 'ftp://' is a valid vfs drive name) */ - result = Tcl_NewObj(); + TclNewObj(result); p = Tcl_GetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 4f5b300..271bbf2 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1021,7 +1021,7 @@ NRInterpCmd( return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr); @@ -1748,10 +1748,11 @@ AliasList( { Tcl_HashEntry *entryPtr; Tcl_HashSearch hashSearch; - Tcl_Obj *resultPtr = Tcl_NewObj(); + Tcl_Obj *resultPtr; Alias *aliasPtr; Child *childPtr; + TclNewObj(resultPtr); childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch); @@ -2725,7 +2726,7 @@ ChildDebugCmd( iPtr = (Interp *) childInterp; if (objc == 0) { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, @@ -2994,11 +2995,12 @@ ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */ + Tcl_Obj *listObjPtr; /* Local object pointer. */ Tcl_HashTable *hTblPtr; /* For local searches. */ Tcl_HashEntry *hPtr; /* For local searches. */ Tcl_HashSearch hSearch; /* For local searches. */ + TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); diff --git a/generic/tclOO.c b/generic/tclOO.c index 053abfe..9a32543 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -2925,7 +2925,7 @@ TclOOObjectName( if (oPtr->cachedNameObj) { return oPtr->cachedNameObj; } - namePtr = Tcl_NewObj(); + TclNewObj(namePtr); Tcl_GetCommandFullName(interp, oPtr->command, namePtr); Tcl_IncrRefCount(namePtr); oPtr->cachedNameObj = namePtr; diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b7f70e7..e746b64 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -727,7 +727,7 @@ TclOO_Object_VarName( * (including traversing variable links), convert back to a name. */ - varNamePtr = Tcl_NewObj(); + TclNewObj(varNamePtr); if (aryVar != NULL) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index aeee165..c1115be 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -850,8 +850,8 @@ MagicDefinitionInvoke( * comments above for why these contortions are necessary. */ - objPtr = Tcl_NewObj(); - obj2Ptr = Tcl_NewObj(); + TclNewObj(objPtr); + TclNewObj(obj2Ptr); cmd = FindCommand(interp, objv[cmdIndex], nsPtr); if (cmd == NULL) { /* @@ -1874,7 +1874,7 @@ ClassFilterGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->classPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -1954,7 +1954,7 @@ ClassMixinGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->classPtr->mixins) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); @@ -2059,7 +2059,7 @@ ClassSuperGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(superPtr, oPtr->classPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); @@ -2224,7 +2224,7 @@ ClassVarsGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->classPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } @@ -2360,7 +2360,7 @@ ObjFilterGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -2428,7 +2428,7 @@ ObjMixinGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr) { Tcl_ListObjAppendElement(NULL, resultObj, @@ -2512,7 +2512,7 @@ ObjVarsGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 4b25c1a..9f1233c 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -266,13 +266,13 @@ InfoObjectDefnCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -316,7 +316,7 @@ InfoObjectFiltersCmd( if (oPtr == NULL) { return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); @@ -560,7 +560,7 @@ InfoObjectMethodsCmd( } } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); if (recurse) { const char **names; int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names); @@ -671,7 +671,7 @@ InfoObjectMixinsCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; @@ -746,7 +746,7 @@ InfoObjectVariablesCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } @@ -788,7 +788,7 @@ InfoObjectVarsCmd( if (objc == 3) { pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); /* * Extract the information we need from the object's namespace's table of @@ -856,13 +856,13 @@ InfoClassConstrCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -924,13 +924,13 @@ InfoClassDefnCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -1018,7 +1018,7 @@ InfoClassFiltersCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, clsPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -1112,7 +1112,7 @@ InfoClassInstancesCmd( pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(oPtr, clsPtr->instances) { Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr); @@ -1183,7 +1183,7 @@ InfoClassMethodsCmd( } } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); if (recurse) { const char **names; int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); @@ -1290,7 +1290,7 @@ InfoClassMixinsCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, clsPtr->mixins) { if (!mixinPtr) { continue; @@ -1336,7 +1336,7 @@ InfoClassSubsCmd( pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(subclassPtr, clsPtr->subclasses) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); @@ -1387,7 +1387,7 @@ InfoClassSupersCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(superPtr, clsPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); @@ -1426,7 +1426,7 @@ InfoClassVariablesCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, clsPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index cd3c2c2..80e8478 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -394,7 +394,7 @@ TclOONewProcMethod( if (argsObj == NULL) { argsLen = -1; - argsObj = Tcl_NewObj(); + TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = ""; } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { @@ -1293,12 +1293,13 @@ CloneProcedureMethod( * Copy the argument list. */ - argsObj = Tcl_NewObj(); + TclNewObj(argsObj); for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { - Tcl_Obj *argObj = Tcl_NewObj(); + Tcl_Obj *argObj; + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index d919c40..b69607a 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -743,7 +743,7 @@ TclPathPart( (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); } else { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); } } else { /* @@ -781,7 +781,7 @@ GetExtension( tail = TclGetString(pathPtr); extension = TclGetExtension(tail); if (extension == NULL) { - ret = Tcl_NewObj(); + TclNewObj(ret); } else { ret = Tcl_NewStringObj(extension, -1); } @@ -857,7 +857,8 @@ TclJoinPath( assert ( elements >= 0 ); if (elements == 0) { - return Tcl_NewObj(); + TclNewObj(res); + return res; } assert ( elements > 0 ); @@ -1056,7 +1057,7 @@ TclJoinPath( noQuickReturn: if (res == NULL) { - res = Tcl_NewObj(); + TclNewObj(res); ptr = Tcl_GetStringFromObj(res, &length); } else { ptr = Tcl_GetStringFromObj(res, &length); @@ -1317,7 +1318,7 @@ TclNewFSPathObj( return pathPtr; } - pathPtr = Tcl_NewObj(); + TclNewObj(pathPtr); fsPathPtr = ckalloc(sizeof(FsPath)); /* diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 7d5fab0..f5c82f1 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -371,7 +371,7 @@ TclCleanupChildren( Tcl_Obj *objPtr; Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); if (count < 0) { result = TCL_ERROR; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 2150c31..67c91c4 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1014,7 +1014,7 @@ TclNRPackageObjCmd( } else { Tcl_Obj *resultObj; - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { @@ -1257,8 +1257,9 @@ TclNRPackageObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; } else { - Tcl_Obj *resultObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + TclNewObj(resultObj); argv2 = TclGetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 2070956..bd923ba 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -677,7 +677,7 @@ TclRegAbout( * well and Tcl has other limits that constrain things as well... */ - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewIntObj((int) regexpPtr->re.re_nsub)); diff --git a/generic/tclResult.c b/generic/tclResult.c index b1cf9ee..be84a61 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -245,7 +245,7 @@ Tcl_SaveResult( */ statePtr->objResultPtr = iPtr->objResultPtr; - iPtr->objResultPtr = Tcl_NewObj(); + TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); /* @@ -1026,13 +1026,14 @@ Tcl_SetErrorCodeVA( Tcl_Interp *interp, /* Interpreter in which to set errorCode */ va_list argList) /* Variable argument list. */ { - Tcl_Obj *errorObj = Tcl_NewObj(); + Tcl_Obj *errorObj; /* * Scan through the arguments one at a time, appending them to the * errorCode field as list elements. */ + TclNewObj(errorObj); while (1) { char *elem = va_arg(argList, char *); @@ -1387,9 +1388,10 @@ TclMergeReturnOptions( int code = TCL_OK; int level = 1; Tcl_Obj *valuePtr; - Tcl_Obj *returnOpts = Tcl_NewObj(); + Tcl_Obj *returnOpts; Tcl_Obj **keys = GetKeys(); + TclNewObj(returnOpts); for (; objc > 1; objv += 2, objc -= 2) { int optLen; const char *opt = TclGetStringFromObj(objv[0], &optLen); @@ -1585,7 +1587,7 @@ Tcl_GetReturnOptions( if (iPtr->returnOpts) { options = Tcl_DuplicateObj(iPtr->returnOpts); } else { - options = Tcl_NewObj(); + TclNewObj(options); } if (result == TCL_RETURN) { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index fc675cf..756b948 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -776,7 +776,8 @@ Tcl_GetRange( last = length - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } return Tcl_NewByteArrayObj(bytes + first, last - first + 1); } @@ -801,9 +802,10 @@ Tcl_GetRange( last = stringPtr->numChars - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } - newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1); + newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1); /* * Since we know the char length of the result, store it. @@ -821,7 +823,8 @@ Tcl_GetRange( last = stringPtr->numChars - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } #if TCL_UTF_MAX == 4 /* See: bug [11ae2be95dac9417] */ diff --git a/generic/tclTimer.c b/generic/tclTimer.c index d30879f..500a75e 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -949,13 +949,14 @@ Tcl_AfterObjCmd( break; case AFTER_INFO: if (objc == 2) { - Tcl_Obj *resultObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + TclNewObj(resultObj); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (assocPtr->interp == interp) { - Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( - "after#%d", afterPtr->id)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "after#%d", afterPtr->id)); } } Tcl_SetObjResult(interp, resultObj); @@ -974,14 +975,15 @@ Tcl_AfterObjCmd( Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; } else { - Tcl_Obj *resultListPtr = Tcl_NewObj(); + Tcl_Obj *resultListPtr; - Tcl_ListObjAppendElement(interp, resultListPtr, - afterPtr->commandPtr); - Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( + TclNewObj(resultListPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, + afterPtr->commandPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); Tcl_SetObjResult(interp, resultListPtr); - } + } break; default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); -- cgit v0.12 From b563c159d7f63f0a4ca1e9190ec4111d5d4908d9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 17 Jan 2022 17:07:14 +0000 Subject: Fix merge conflict previous commit --- generic/tclBasic.c | 3 +-- generic/tclCompExpr.c | 2 -- generic/tclCompile.c | 1 - generic/tclIOUtil.c | 1 - 4 files changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 35fd5a9..45a430f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -901,8 +901,7 @@ Tcl_CreateInterp(void) iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ - TclNewObj(iPtr->emptyObjPtr); - /* Another empty object. */ + TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); #ifndef TCL_NO_DEPRECATED iPtr->resultSpace[0] = 0; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 8248770..23d8711 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1880,8 +1880,6 @@ Tcl_ParseExpr( numBytes = (start ? strlen(start) : 0); } - TclNewObj(litList); - TclNewObj(funcList); code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); Tcl_DecrRefCount(funcList); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 650a6d4..f7479f0 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2044,7 +2044,6 @@ CompileCommandTokens( int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); - TclNewObj(cmdObj); assert (parsePtr->numWords > 0); /* Pre-Compile */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6b1dc3c..87e60c3 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -3775,7 +3775,6 @@ Tcl_FSListVolumes(void) FilesystemRecord *fsRecPtr; Tcl_Obj *resultPtr; - TclNewObj(resultPtr); /* * Call each "listVolumes" function of each registered filesystem in * succession. A non-NULL return value indicates the particular function -- cgit v0.12 From c3bcd951b8dd8bf57202915b9d914bcddc73b9bb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 17 Jan 2022 17:26:37 +0000 Subject: Possible fix for [e9a2715d91]: Tcl 8.6.11: Incompatible Tcl_GetRange() --- generic/tclCmdMZ.c | 14 ++++++++++---- generic/tclExecute.c | 15 +++++++++++---- generic/tclStringObj.c | 12 ++++++++---- generic/tclTest.c | 2 +- 4 files changed, 30 insertions(+), 13 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 5422b7f..bf75d44 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -395,9 +395,13 @@ Tcl_RegexpObjCmd( newPtr = Tcl_NewListObj(2, objs); } else { if (i <= info.nsubs) { - newPtr = Tcl_GetRange(objPtr, - offset + info.matches[i].start, - offset + info.matches[i].end - 1); + if (info.matches[i].end <= 0) { + TclNewObj(newPtr); + } else { + newPtr = Tcl_GetRange(objPtr, + offset + info.matches[i].start, + offset + info.matches[i].end - 1); + } } else { TclNewObj(newPtr); } @@ -2183,7 +2187,9 @@ StringRangeCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); + if (last >= 0) { + Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); + } return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c39bc21..a3b0401 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5609,7 +5609,11 @@ TEBCresume( goto gotError; } - objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); + if (toIdx < 0) { + TclNewObj(objResultPtr); + } else { + objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); + } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); @@ -5653,11 +5657,14 @@ TEBCresume( fromIdx = TCL_INDEX_START; } if (fromIdx == TCL_INDEX_AFTER) { + goto emptyRange; + } + fromIdx = TclIndexDecode(fromIdx, length - 1); + if (toIdx >= 0) { + objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); + } else { emptyRange: TclNewObj(objResultPtr); - } else { - fromIdx = TclIndexDecode(fromIdx, length - 1); - objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 756b948..b4f05dd 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -772,7 +772,7 @@ Tcl_GetRange( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - if (last >= length) { + if (last < 0 || last >= length) { last = length - 1; } if (last < first) { @@ -798,7 +798,7 @@ Tcl_GetRange( TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - if (last >= stringPtr->numChars) { + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } if (last < first) { @@ -819,7 +819,7 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - if (last >= stringPtr->numChars) { + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } if (last < first) { @@ -2116,7 +2116,11 @@ Tcl_AppendFormatToObj( if (gotPrecision) { numChars = Tcl_GetCharLength(segment); if (precision < numChars) { - segment = Tcl_GetRange(segment, 0, precision - 1); + if (precision < 1) { + TclNewObj(segment); + } else { + segment = Tcl_GetRange(segment, 0, precision - 1); + } numChars = precision; Tcl_IncrRefCount(segment); allocSegment = 1; diff --git a/generic/tclTest.c b/generic/tclTest.c index ed016fe..8d22edf 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -3918,7 +3918,7 @@ TestregexpObjCmd( if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); - } else if (ii > info.nsubs) { + } else if (ii > info.nsubs || info.matches[ii].end <= 0) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, -- cgit v0.12 From d0b286927306af8bde7031529ad180eaa07dcc73 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 18 Jan 2022 23:26:20 +0000 Subject: Update documentation for Tcl_GetRange() --- doc/StringObj.3 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 772073e..90b53f2 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -111,10 +111,12 @@ If negative, all characters up to the first null character are used. The index of the Unicode character to return. .AP int first in The index of the first Unicode character in the Unicode range to be -returned as a new value. +returned as a new value. If negative, behave the same as if the +value was 0. .AP int last in The index of the last Unicode character in the Unicode range to be -returned as a new value. +returned as a new value. If negative, take all characters up to +the last one available. .AP Tcl_Obj *objPtr in/out Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in -- cgit v0.12 From b97786c85dbd70fd4445f8161b205d5dbc56e844 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 19 Jan 2022 14:21:38 +0000 Subject: (partial) fix for [https://core.tcl-lang.org/tk/tktview?name=a9929f112a|a9929f112a]. WIP --- generic/tclUtil.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 32721f6..86b6369 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3647,12 +3647,15 @@ GetWideForIndex( if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; + if (*widePtr < -1) { + *widePtr = -1; + } return TCL_OK; } if (numType == TCL_NUMBER_BIG) { /* objPtr holds an integer outside the signed wide range */ /* Truncate to the signed wide range. */ - *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX); + *widePtr = ((mp_isneg((mp_int *)cd)) ? -1 : WIDE_MAX); return TCL_OK; } } -- cgit v0.12 From e433c571581eae56161e5c4dc8dcae36e31d8039 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Jan 2022 08:43:13 +0000 Subject: Add test-cases for Tcl_GetIntForIndex(). This reveals a minor bug --- generic/tclTest.c | 29 +++++++++++++++++++++++++++++ generic/tclUtil.c | 7 ++----- tests/indexObj.test | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 78 insertions(+), 5 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 7ec3c41..95ef5b7 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -327,6 +327,7 @@ static Tcl_ObjCmdProc TestNumUtfCharsCmd; static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; +static Tcl_ObjCmdProc TestGetIntForIndexCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; @@ -598,6 +599,8 @@ Tcltest_Init( TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testgetintforindex", + TestGetIntForIndexCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, @@ -7036,6 +7039,32 @@ TestFindLastCmd( return TCL_OK; } +static int +TestGetIntForIndexCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + int result, endvalue; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "index endvalue"); + return TCL_ERROR; + } + + if (Tcl_GetIntFromObj(interp, objv[2], &endvalue) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + return TCL_OK; +} + + + #if defined(HAVE_CPUID) || defined(_WIN32) /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 86b6369..10153fb 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3647,15 +3647,12 @@ GetWideForIndex( if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; - if (*widePtr < -1) { - *widePtr = -1; - } return TCL_OK; } if (numType == TCL_NUMBER_BIG) { /* objPtr holds an integer outside the signed wide range */ /* Truncate to the signed wide range. */ - *widePtr = ((mp_isneg((mp_int *)cd)) ? -1 : WIDE_MAX); + *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX); return TCL_OK; } } @@ -3706,7 +3703,7 @@ Tcl_GetIntForIndex( return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue > TCL_INDEX_END)) { + if ((wide < 0) && (endValue >= 0)) { *indexPtr = -1; } else if (wide > INT_MAX) { *indexPtr = INT_MAX; diff --git a/tests/indexObj.test b/tests/indexObj.test index 40418b3..9fd31b4 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -17,6 +17,7 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testindexobj [llength [info commands testindexobj]] +testConstraint testgetintforindex [llength [info commands testgetintforindex]] testConstraint testparseargs [llength [info commands testparseargs]] test indexObj-1.1 {exact match} testindexobj { @@ -165,6 +166,52 @@ test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs { testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0 } {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}} +test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex 0 0 +} 0 +test indexObj-8.2 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex -1 0 +} -1 +test indexObj-8.3 {Tcl_GetIntForIndex integer} testgetintforindex { + testgetintforindex -2 0 +} -1 +test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex { + testgetintforindex 2147483647 0 +} 2147483647 +test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex { + testgetintforindex 2147483648 0 +} 2147483647 +test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 2147483646 +} 2147483645 +test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 2147483647 +} 2147483646 +test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end 2147483646 +} 2147483646 +test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end 2147483647 +} 2147483647 +test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 -1 +} -2 +test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex { + testgetintforindex end-1 -2 +} -3 +test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end -1 +} -1 +test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex { + testgetintforindex end -2 +} -2 +test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex { + testgetintforindex end+1 -1 +} 0 +test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex { + testgetintforindex end+1 -2 +} -1 + # cleanup ::tcltest::cleanupTests return -- cgit v0.12 From d4e2ae119e3f6d6e5d430cf810ea4dc396ecd9b7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Jan 2022 14:44:58 +0000 Subject: Undo part of [26539e78a7]. Although Tcl_GetRange() does it's own parameter check, it's caller doesn't have to do it any more. However, put back these check, better not depend on the improved behavior of Tcl_GetRange (yet). This gives the freedom to bring back Tcl_GetRange() to how it was in Tcl 8.6.10, if desired --- generic/tclCmdMZ.c | 20 +++++++++++--------- generic/tclExecute.c | 26 ++++++++++++++++++++++---- generic/tclStringObj.c | 7 ++++--- 3 files changed, 37 insertions(+), 16 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bf75d44..34fd6bf 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -394,14 +394,10 @@ Tcl_RegexpObjCmd( newPtr = Tcl_NewListObj(2, objs); } else { - if (i <= info.nsubs) { - if (info.matches[i].end <= 0) { - TclNewObj(newPtr); - } else { - newPtr = Tcl_GetRange(objPtr, - offset + info.matches[i].start, - offset + info.matches[i].end - 1); - } + if ((i <= info.nsubs) && (info.matches[i].end > 0)) { + newPtr = Tcl_GetRange(objPtr, + offset + info.matches[i].start, + offset + info.matches[i].end - 1); } else { TclNewObj(newPtr); } @@ -2187,7 +2183,13 @@ StringRangeCmd( return TCL_ERROR; } - if (last >= 0) { + if (first < 0) { + first = 0; + } + if (last >= length) { + last = length; + } + if (last >= first) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a3b0401..e5a6b71 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5609,10 +5609,16 @@ TEBCresume( goto gotError; } - if (toIdx < 0) { - TclNewObj(objResultPtr); - } else { + if (fromIdx < 0) { + fromIdx = 0; + } + if (toIdx >= length) { + toIdx = length; + } + if (toIdx >= fromIdx) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); + } else { + TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); @@ -5646,6 +5652,13 @@ TEBCresume( } toIdx = TclIndexDecode(toIdx, length - 1); + if (toIdx < 0) { + goto emptyRange; + } else if (toIdx >= length) { + toIdx = length - 1; + } + + assert ( toIdx >= 0 && toIdx < length ); /* assert ( fromIdx != TCL_INDEX_BEFORE ); @@ -5659,8 +5672,13 @@ TEBCresume( if (fromIdx == TCL_INDEX_AFTER) { goto emptyRange; } + fromIdx = TclIndexDecode(fromIdx, length - 1); - if (toIdx >= 0) { + if (fromIdx < 0) { + fromIdx = 0; + } + + if (fromIdx <= toIdx) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { emptyRange: diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index b4f05dd..9e0e4af 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -819,6 +819,7 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } @@ -829,12 +830,12 @@ Tcl_GetRange( #if TCL_UTF_MAX == 4 /* See: bug [11ae2be95dac9417] */ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) - && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { + && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } if ((last + 1 < stringPtr->numChars) - && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) - && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { + && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) + && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; } #endif -- cgit v0.12 From 641cba82ec80d575338440d9d8bbf84f711eb12c Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 22 Jan 2022 14:47:29 +0000 Subject: Rewrite of documentation for [chan] --- doc/chan.n | 1106 +++++++++++++++++++++++++----------------------------------- 1 file changed, 466 insertions(+), 640 deletions(-) diff --git a/doc/chan.n b/doc/chan.n index f788bbf..aa8bbca 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -1,5 +1,6 @@ '\" '\" Copyright (c) 2005-2006 Donal K. Fellows +'\" Copyright (c) 2021 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -8,761 +9,586 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -chan \- Read, write and manipulate channels +chan \- Reads, writes and manipulates channels. .SH SYNOPSIS -\fBchan \fIoption\fR ?\fIarg arg ...\fR? +\fBchan \fIoperation\fR ?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP -This command provides several operations for reading from, writing to -and otherwise manipulating open channels (such as have been created -with the \fBopen\fR and \fBsocket\fR commands, or the default named -channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR which correspond to -the process's standard input, output and error streams respectively). -\fIOption\fR indicates what to do with the channel; any unique -abbreviation for \fIoption\fR is acceptable. Valid options are: -.TP -\fBchan blocked \fIchannelId\fR -. -This tests whether the last input operation on the channel called -\fIchannelId\fR failed because it would have otherwise caused the -process to block, and returns 1 if that was the case. It returns 0 -otherwise. Note that this only ever returns 1 when the channel has -been configured to be non-blocking; all Tcl channels have blocking -turned on by default. -.TP -\fBchan close \fIchannelId\fR ?\fIdirection\fR? -. -Close and destroy the channel called \fIchannelId\fR. Note that this -deletes all existing file-events registered on the channel. -If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or -any unique abbreviation of them) is present, the channel will only be -half-closed, so that it can go from being read-write to write-only or -read-only respectively. If a read-only channel is closed for reading, it is -the same as if the channel is fully closed, and respectively similar for -write-only channels. Without the \fIdirection\fR argument, the channel is -closed for both reading and writing (but only if those directions are -currently open). It is an error to close a read-only channel for writing, or a -write-only channel for reading. +\fBchan\fR provides several operations for reading from, writing to, and +otherwise manipulating channels, e.g. those created by \fBopen\fR and +\fBsocket\fR, or the default channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR +which correspond respectively to the standard input, output, and error streams +of the process. Any unique abbreviation for \fIoperation\fR is acceptable. +Available operations are: +.TP +\fBchan blocked \fIchannelName\fR +. +Returns 1 when the channel is in non-blocking mode and the last input operation +on the channel failed because it would have otherwise caused the process to +block, and 0 otherwise. Each Tcl channel is in blocking mode unless configured +otherwise. +.TP +\fBchan close \fIchannelName\fR ?\fIdirection\fR? +. +Closes and destroys the named channel, deleting any existing event handlers +established for the channel, and returns the empty string. If \fIdirection\fR is +given, it is +.QW\fBread\fR +or +.QW\fBwrite\fR +or any unique abbreviation of those words, and only that side of the channel is +closed. I.e. a read-write channel may become read-only or write-only. +Closing a read-only channel for reading, or closing a write-only channel for +writing is the same as simply closing the channel. It is an error to close a +read-only channel for writing or to close a write-only channel for reading. .RS .PP -As part of closing the channel, all buffered output is flushed to the -channel's output device (only if the channel is ceasing to be writable), any -buffered input is discarded (only if the channel is ceasing to be readable), -the underlying operating system resource is closed and \fIchannelId\fR becomes -unavailable for future use (both only if the channel is being completely -closed). -.PP -If the channel is blocking and the channel is ceasing to be writable, the -command does not return until all output is flushed. If the channel is -non-blocking and there is unflushed output, the channel remains open and the -command returns immediately; output will be flushed in the background and the -channel will be closed when all the flushing is complete. -.PP -If \fIchannelId\fR is a blocking channel for a command pipeline then -\fBchan close\fR waits for the child processes to complete. -.PP -If the channel is shared between interpreters, then \fBchan close\fR -makes \fIchannelId\fR unavailable in the invoking interpreter but has -no other effect until all of the sharing interpreters have closed the -channel. When the last interpreter in which the channel is registered -invokes \fBchan close\fR (or \fBclose\fR), the cleanup actions -described above occur. With half-closing, the half-close of the channel only -applies to the current interpreter's view of the channel until all channels -have closed it in that direction (or completely). -See the \fBinterp\fR command for a description of channel sharing. -.PP -Channels are automatically fully closed when an interpreter is destroyed and -when the process exits. Channels are switched to blocking mode, to -ensure that all output is correctly flushed before the process exits. -.PP -The command returns an empty string, and may generate an error if -an error occurs while flushing output. If a command in a command -pipeline created with \fBopen\fR returns an error, \fBchan close\fR -generates an error (similar to the \fBexec\fR command.) -.PP -Note that half-closes of sockets and command pipelines can have important side -effects because they result in a shutdown() or close() of the underlying -system resource, which can change how other processes or systems respond to -the Tcl program. +When a channel is closed for writing, any buffered output on the channel is +flushed. When a channel is closed for reading, any buffered input is discarded. +When a channel is destroyed the underlying resource is closed and the channel +is thereafter unavailable. +.PP +\fBchan close\fR fully flushes any output before closing the write side of a +channel unless it is non-blocking mode, where it returns immediately and the +channel is flushed in the background before finally being closed. +.PP +\fBchan close\fR may return an error if an error occurs while flushing +output. If a process in a command pipeline created by \fBopen\fR returns an +error, \fBchan close\fR generates an error in the same manner as \fBexec\fR. +.PP +Closing one side of a socket or command pipeline may lead to the shutdown() or +close() of the underlying system resource, leading to a reaction from whatever +is on the other side of the pipeline or socket. +.PP +If the channel for a command pipeline is in blocking mode, \fBchan close\fR +waits for the connected processes to complete. +.PP +\fBchan close\fR only affects the current interpreter. If the channel is open +in any other interpreter, its state is unchanged there. See \fBinterp\fR for a +description of channel sharing. +.PP +When the last interpreter sharing a channel is destroyed, the channel is +switched to blocking mode and fully flushed and then closed. .RE .TP -\fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... +\fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . -Query or set the configuration options of the channel named -\fIchannelId\fR. +Configures or reports the configuration of \fIchannelName\fR. .RS .PP -If no \fIoptionName\fR or \fIvalue\fR arguments are supplied, the -command returns a list containing alternating option names and values -for the channel. If \fIoptionName\fR is supplied but no \fIvalue\fR -then the command returns the current value of the given option. If -one or more pairs of \fIoptionName\fR and \fIvalue\fR are supplied, -the command sets each of the named options to the corresponding -\fIvalue\fR; in this case the return value is an empty string. -.PP -The options described below are supported for all channels. In -addition, each channel type may add options that only it supports. See -the manual entry for the command that creates each type of channel -for the options supported by that specific type of channel. For -example, see the manual entry for the \fBsocket\fR command for additional -options for sockets, and the \fBopen\fR command for additional options for -serial devices. +If no \fIoptionName\fR or \fIvalue\fR arguments are given, +\fBchan configure\fR returns a dictionary of option names and +values for the channel. If \fIoptionName\fR is supplied without a \fIvalue\fR, +\fBchan configure\fR returns the current value of the named option. If one or +more pairs of \fIoptionName\fR and \fIvalue\fR are supplied, +\fBchan configure\fR sets each of the named options to the corresponding +\fIvalue\fR and returns the empty string. +.PP +The options described below are supported for all channels. Each type of +channel may provide additional options. Those options are described in the +relevant documentation. For example, additional options are documented for +\fBsocket\fR, and also for serial devices at \fBopen\fR. .TP \fB\-blocking\fR \fIboolean\fR . -The \fB\-blocking\fR option determines whether I/O operations on the -channel can cause the process to block indefinitely. The value of the -option must be a proper boolean value. Channels are normally in -blocking mode; if a channel is placed into non-blocking mode it will -affect the operation of the \fBchan gets\fR, \fBchan read\fR, \fBchan -puts\fR, \fBchan flush\fR, and \fBchan close\fR commands; see the -documentation for those commands for details. For non-blocking mode to -work correctly, the application must be using the Tcl event loop -(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR -command). +If \fB\-blocking\fR is set to \fBtrue\fR, which is the default, reading from or +writing to the channel may cause the process to block indefinitely. Otherwise, +operations such as \fBchan gets\fR, \fBchan read\fR, \fBchan puts\fR, \fBchan +flush\fR, and \fBchan close\fR take care not to block. Non-blocking mode in +generally requires that the event loop is entered, e.g. by calling +\fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, to give Tcl a chance to +process events on the channel. .TP \fB\-buffering\fR \fInewValue\fR . -If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output -until its internal buffer is full or until the \fBchan flush\fR -command is invoked. If \fInewValue\fR is \fBline\fR, then the I/O -system will automatically flush output for the channel whenever a -newline character is output. If \fInewValue\fR is \fBnone\fR, the I/O -system will flush automatically after every output operation. The -default is for \fB\-buffering\fR to be set to \fBfull\fR except for -channels that connect to terminal-like devices; for these channels the -initial setting is \fBline\fR. Additionally, \fBstdin\fR and -\fBstdout\fR are initially set to \fBline\fR, and \fBstderr\fR is set -to \fBnone\fR. +If \fInewValue\fR is \fBfull\fR, which is the default, output is buffered +until the internal buffer is full or until \fBchan flush\fR is called. If +\fInewValue\fR is \fBline\fR, output is flushed each time a end-of-line +character is written. If \fInewValue\fR is \fBnone\fR, output is flushed after +every output operation. For \fBstdin\fR, \fBstdout\fR, and channels that +connect to terminal-like devices, the default value is \fBline\fR. For +\fBstderr\fR the default value is \fBnone\fR. .TP \fB\-buffersize\fR \fInewSize\fR . -\fINewvalue\fR must be an integer; its value is used to set the size -of buffers, in bytes, subsequently allocated for this channel to store -input or output. \fINewvalue\fR must be a number of no more than one -million, allowing buffers of up to one million bytes in size. -.TP -\fB\-encoding\fR \fIname\fR -. -This option is used to specify the encoding of the channel as one of -the named encodings returned by \fBencoding names\fR or the special -value \fBbinary\fR, so that the data can be converted to and from -Unicode for use in Tcl. For instance, in order for Tcl to read -characters from a Japanese file in \fBshiftjis\fR and properly process -and display the contents, the encoding would be set to \fBshiftjis\fR. -Thereafter, when reading from the channel, the bytes in the Japanese -file would be converted to Unicode as they are read. Writing is also -supported \- as Tcl strings are written to the channel they will -automatically be converted to the specified encoding on output. +\fInewSize\fR, an integer no greater than one million, is the size in bytes of +any input or output buffers subsequently allocated for this channel. +.TP +\fB\-encoding\fR ?\fIname\fR? +. +Sets the encoding of the channel. \fIname\fR is either one of the names +returned by \fBencoding names\fR, or +.QW \fBbinary\fR +\&. Input is converted from the encoding into Unicode, and output is converted +from Unicode to the encoding. .RS .PP -If a file contains pure binary data (for instance, a JPEG image), the -encoding for the channel should be configured to be \fBbinary\fR. Tcl -will then assign no interpretation to the data in the file and simply -read or write raw bytes. The Tcl \fBbinary\fR command can be used to -manipulate this byte-oriented data. It is usually better to set the -\fB\-translation\fR option to \fBbinary\fR when you want to transfer -binary data, as this turns off the other automatic interpretations of -the bytes in the stream as well. -.PP -The default encoding for newly opened channels is the same platform- -and locale-dependent system encoding used for interfacing with the -operating system, as returned by \fBencoding system\fR. +\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the +channel becomes the Unicode character having the same value as that byte, and +each character written to the channel becomes a single byte in the output, +allowing Tcl to work seamlessly with binary data as long as each "character" in +the data remains in the range of 0 to 255 so that there is no distinction between +binary data and text. For example, A JPEG image can be read from a +\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR +channel. + +For working with binary data \fB\-translation binary\fR is usually used +instead, as it sets the encoding to \fBbinary\fR and also disables other +translations on the channel. +.PP +The encoding of a new channel is the value of \fBencoding system\fR, +which returns the platform- and locale-dependent system encoding used to +interface with the operating system, .RE .TP \fB\-eofchar\fR \fIchar\fR .TP \fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR . -This option supports DOS file systems that use Control-z (\ex1A) as an -end of file marker. If \fIchar\fR is not an empty string, then this -character signals end-of-file when it is encountered during input. -For output, the end-of-file character is output when the channel is -closed. If \fIchar\fR is the empty string, then there is no special -end of file character marker. For read-write channels, a two-element -list specifies the end of file marker for input and output, -respectively. As a convenience, when setting the end-of-file -character for a read-write channel you can specify a single value that -will apply to both reading and writing. When querying the end-of-file -character of a read-write channel, a two-element list will always be -returned. The default value for \fB\-eofchar\fR is the empty string -in all cases except for files under Windows. In that case the -\fB\-eofchar\fR is Control-z (\ex1A) for reading and the empty string -for writing. -The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f; -attempting to set \fB\-eofchar\fR to a value outside of this range will -generate an error. -.TP -\fB\-translation\fR \fImode\fR -.TP -\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR -. -In Tcl scripts the end of a line is always represented using a single -newline character (\en). However, in actual files and devices the end -of a line may be represented differently on different platforms, or -even for different devices on the same platform. For example, under -UNIX newlines are used in files, whereas carriage-return-linefeed -sequences are normally used in network connections. On input (i.e., -with \fBchan gets\fR and \fBchan read\fR) the Tcl I/O system -automatically translates the external end-of-line representation into -newline characters. Upon output (i.e., with \fBchan puts\fR), the I/O -system translates newlines to the external end-of-line representation. -The default translation mode, \fBauto\fR, handles all the common cases -automatically, but the \fB\-translation\fR option provides explicit -control over the end of line translations. +\fIchar\fR signals the end of the data when it is encountered in the input. +For output, the character is added when the channel is closed. If \fIchar\fR +is the empty string, there is no special character that marks the end of the +data. For read-write channels, one end-of-file character for input and another +for output may be given. When only one end-of-file character is given it is +applied to both input and output. For a read-write channel two values are +returned even if they are are identical. + +The default value is the empty string, except that under Windows the default +value for reading is Control-z (\ex1A). The acceptable range is \ex01 - +\ex7f. A value outside this range results in an error. +.TP +\fB\-translation\fR \fItranslation\fR +.TP +\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR +. +In Tcl a single line feed (\en) represents the end of a line. However, +at the destination the end of a line may be represented differently on +different platforms, or even for different devices on the same platform. For +example, under UNIX line feed is used in files and a +carriage-return-linefeed sequence is normally used in network connections. +Therefore, on input, e.g. with \fBchan gets\fR and \fBchan read\fR, each +external end-of-line character is translated into a line feed. On +output, e.g. with \fBchan puts\fR, each line feed is translated to the external +end-of-line character. The default translation, \fBauto\fR, handles all the common +cases, and \fB\-translation\fR provides explicit control over the end-of-line +character. .RS .PP -The value associated with \fB\-translation\fR is a single item for -read-only and write-only channels. The value is a two-element list for -read-write channels; the read translation mode is the first element of -the list, and the write translation mode is the second element. As a -convenience, when setting the translation mode for a read-write channel -you can specify a single value that will apply to both reading and -writing. When querying the translation mode of a read-write channel, a -two-element list will always be returned. The following values are -currently supported: +Returns the input translation for a read-only channel, the output translation +for a write-only channel, and both the input translation and the the output +translation for a read-write channel. When two translations are given, they +are the input and output translation, respectively. When only one translation +is given for a read-write channel, it is the translation for both input and +output. The following values are currently supported: .TP \fBauto\fR . -As the input translation mode, \fBauto\fR treats any of newline -(\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by -a newline (\fBcrlf\fR) as the end of line representation. The end of -line representation can even change from line-to-line, and all cases -are translated to a newline. As the output translation mode, -\fBauto\fR chooses a platform specific representation; for sockets on -all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses -\fBlf\fR, and for the various flavors of Windows it chooses -\fBcrlf\fR. The default setting for \fB\-translation\fR is \fBauto\fR -for both input and output. +The default. For input each occurrence of a line feed (\fBlf\fR), carriage +return (\fBcr\fR), or carriage return followed by a line feed (\fBcrlf\fR) is +translated into a line feed. For output, each line feed is translated into a +platform-specific representation: For all Unix variants it is \fBlf\fR, and +for all Windows variants it is \fBcrlf\fR, except that for sockets on all +platforms it is \fBcrlf\fR for both input and output. .TP \fBbinary\fR . -No end-of-line translations are performed. This is nearly identical -to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets -the end-of-file character to the empty string (which disables it) and -sets the encoding to \fBbinary\fR (which disables encoding filtering). -See the description of \fB\-eofchar\fR and \fB\-encoding\fR for more -information. +Like \fBlf\fR, no end-of-line translation is performed, but in addition, +\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR +is set to \fBbinary\fR. With this one setting, a channel is fully configured +for binary input and output. .TP \fBcr\fR . -The end of a line in the underlying file or device is represented by a -single carriage return character. As the input translation mode, -\fBcr\fR mode converts carriage returns to newline characters. As the -output translation mode, \fBcr\fR mode translates newline characters -to carriage returns. +The end of a line is represented in the external data by a single carriage +return character. For input, each carriage return is translated to a line +feed, and for output each line feed character is translated to a carriage +return. .TP \fBcrlf\fR . -The end of a line in the underlying file or device is represented by a -carriage return character followed by a linefeed character. As the -input translation mode, \fBcrlf\fR mode converts -carriage-return-linefeed sequences to newline characters. As the -output translation mode, \fBcrlf\fR mode translates newline characters -to carriage-return-linefeed sequences. This mode is typically used on -Windows platforms and for network connections. +The end of a line is represented in the external data by a carriage return +character followed by a line feed. For input, each carriage-return-linefeed +sequence is translated to a line feed. For output, each line feed is +translated to a carriage-return-linefeed sequence. This translation is +typically used for network connections, and also on Windows systems. .TP \fBlf\fR . -The end of a line in the underlying file or device is represented by a -single newline (linefeed) character. In this mode no translations -occur during either input or output. This mode is typically used on -UNIX platforms. +The end of a line in the external data is represented by a line feed so no +translations occur during either input or output. This translation is +typically used on UNIX platforms, .RE .RE .TP \fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? . -Copy data from the channel \fIinputChan\fR, which must have been -opened for reading, to the channel \fIoutputChan\fR, which must have -been opened for writing. The \fBchan copy\fR command leverages the -buffering in the Tcl I/O system to avoid extra copies and to avoid -buffering too much data in main memory when copying large files to -slow destinations like network sockets. +Copies data from \fIinputChan\fR to \fIoutputChan\fR, leveraging internal +buffers to avoid extra copies and to avoid buffering too much data in main +memory when copying large files to slow destinations like network sockets. .RS .PP -The \fBchan copy\fR command transfers data from \fIinputChan\fR until -end of file or \fIsize\fR bytes or characters have been transferred; -\fIsize\fR is in bytes if the two channels are using the same encoding, -and is in characters otherwise. If no \fB\-size\fR argument is given, -then the copy goes until end of file. All the data read from -\fIinputChan\fR is copied to \fIoutputChan\fR. Without the -\fB\-command\fR option, \fBchan copy\fR blocks until the copy is -complete and returns the number of bytes or characters (using the same -rules as for the \fB\-size\fR option) written to \fIoutputChan\fR. -.PP -The \fB\-command\fR argument makes \fBchan copy\fR work in the -background. In this case it returns immediately and the -\fIcallback\fR is invoked later when the copy completes. The -\fIcallback\fR is called with one or two additional arguments that -indicates how many bytes were written to \fIoutputChan\fR. If an -error occurred during the background copy, the second argument is the -error string associated with the error. With a background copy, it is -not necessary to put \fIinputChan\fR or \fIoutputChan\fR into -non-blocking mode; the \fBchan copy\fR command takes care of that -automatically. However, it is necessary to enter the event loop by -using the \fBvwait\fR command or by using Tk. -.PP -You are not allowed to do other I/O operations with \fIinputChan\fR or -\fIoutputChan\fR during a background \fBchan copy\fR. If either -\fIinputChan\fR or \fIoutputChan\fR get closed while the copy is in -progress, the current copy is stopped and the command callback is -\fInot\fR made. If \fIinputChan\fR is closed, then all data already -queued for \fIoutputChan\fR is written out. -.PP -Note that \fIinputChan\fR can become readable during a background -copy. You should turn off any \fBchan event\fR or \fBfileevent\fR -handlers during a background copy so those handlers do not interfere -with the copy. Any I/O attempted by a \fBchan event\fR or -\fBfileevent\fR handler will get a -.QW "channel busy" -error. -.PP -\fBChan copy\fR translates end-of-line sequences in \fIinputChan\fR -and \fIoutputChan\fR according to the \fB\-translation\fR option for -these channels (see \fBchan configure\fR above). The translations -mean that the number of bytes read from \fIinputChan\fR can be -different than the number of bytes written to \fIoutputChan\fR. Only -the number of bytes written to \fIoutputChan\fR is reported, either as -the return value of a synchronous \fBchan copy\fR or as the argument -to the callback for an asynchronous \fBchan copy\fR. -.PP -\fBChan copy\fR obeys the encodings and character translations -configured for the channels. This means that the incoming characters -are converted internally first UTF-8 and then into the encoding of the -channel \fBchan copy\fR writes to (see \fBchan configure\fR above for -details on the \fB\-encoding\fR and \fB\-translation\fR options). No -conversion is done if both channels are set to encoding \fBbinary\fR -and have matching translations. If only the output channel is set to -encoding \fBbinary\fR the system will write the internal UTF-8 -representation of the incoming characters. If only the input channel -is set to encoding \fBbinary\fR the system will assume that the -incoming bytes are valid UTF-8 characters and convert them according -to the output encoding. The behaviour of the system for bytes which -are not valid UTF-8 characters is undefined in this case. +If \fB\-size\fR is given, the size is in bytes if the two channels have the +same encoding and in characters otherwise, and only that amount is copied. +Otherwise, all data until the end of the file is copied. + +\fBchan copy\fR blocks until the copy is complete and returns the number of +bytes or characters written to \fIoutputChan\fR. +.PP +If \fB\-command\fR is given, \fBchan copy\fR returns immediately, the copy is +carried out in the background, and then \fIcallback\fR is called with the +number of bytes written to \fIoutputChan\fR as its first argument, and the +error message for any error that occurred as its second argument. +\fIinputChan\fR and \fIoutputChan\fR are automatically configured for +non-blocking mode if needed. Background copying only works correctly if the +event loop is active, e.g. via \fBvwait\fR or Tk. +.PP +During a background copy no other read or write operation may be performed on +\fIinputChan\fR or \fIoutputChan\fR. If either \fIinputChan\fR or +\fIoutputChan\fR is closed while the copy is in progress copying ceases and +\fBno\fR callback is made. If \fIinputChan\fR is closed all data already queued +is written to \fIoutputChan\fR. +.PP +The should be no event handler established for \fIinputChan\fR because it may +become readable during a background copy. An attempt to read or write +from within an event handler results result in the error, "channel busy". +.PP +Due to end-of-line translation the number of bytes read from \fIinputChan\fR +may be different than the number of bytes written to \fIoutputChan\fR. Only +the number of bytes written to \fIoutputChan\fR is reported. +.PP +\fBChan copy\fR reads the data according to the \fB\-encoding\fR, +\fB\-translation\fR, and \fB\-eofchar\fR of the source and writes to the +destination according to the configuration for that channel. If the encoding +and translation of both channels is \fBbinary\fR and the \fB\-eofchar\fR of +both channels is the empty string, an identical copy is made. If only the +encoding of the destination is \fBbinary\fR, Tcl's internal modified UTF-8 +representation of the characters read from the source is written to the +destination. If only the encoding of the source is \fBbinary\fR, each byte read +becomes one Unicode character in the range of 0 to 255, and that character is +subject to the encoding and translation of the destination as it is written. .RE .TP \fBchan create \fImode cmdPrefix\fR . -This subcommand creates a new script level channel using the command -prefix \fIcmdPrefix\fR as its handler. Any such channel is called a -\fBreflected\fR channel. The specified command prefix, \fBcmdPrefix\fR, -must be a non-empty list, and should provide the API described in the -\fBrefchan\fR manual page. The handle of the new channel is -returned as the result of the \fBchan create\fR command, and the -channel is open. Use either \fBclose\fR or \fBchan close\fR to remove -the channel. +Creates a new channel, called a \fBreflected\fR channel, with \fIcmdPrefix\fR +as its handler, and returns the name of the channel. \fBcmdPrefix\fR is the +first words of a command that provides the interface for a \fBrefchan\fR. .RS .PP -The argument \fImode\fR specifies if the new channel is opened for -reading, writing, or both. It has to be a list containing any of the -strings +\fBImode\fR is a list of one or more of the strings .QW \fBread\fR or -.QW \fBwrite\fR . -The list must have at least one -element, as a channel you can neither write to nor read from makes no -sense. The handler command for the new channel must support the chosen -mode, or an error is thrown. -.PP -The command prefix is executed in the global namespace, at the top of -call stack, following the appending of arguments as described in the -\fBrefchan\fR manual page. Command resolution happens at the -time of the call. Renaming the command, or destroying it means that -the next call of a handler method may fail, causing the channel -command invoking the handler to fail as well. Depending on the -subcommand being invoked, the error message may not be able to explain -the reason for that failure. -.PP -Every channel created with this subcommand knows which interpreter it -was created in, and only ever executes its handler command in that -interpreter, even if the channel was shared with and/or was moved into -a different interpreter. Each reflected channel also knows the thread -it was created in, and executes its handler command only in that -thread, even if the channel was moved into a different thread. To this -end all invocations of the handler are forwarded to the original -thread by posting special events to it. This means that the original -thread (i.e. the thread that executed the \fBchan create\fR command) -must have an active event loop, i.e. it must be able to process such -events. Otherwise the thread sending them will \fIblock -indefinitely\fR. Deadlock may occur. -.PP -Note that this permits the creation of a channel whose two endpoints -live in two different threads, providing a stream-oriented bridge -between these threads. In other words, we can provide a way for -regular stream communication between threads instead of having to send -commands. -.PP -When a thread or interpreter is deleted, all channels created with -this subcommand and using this thread/interpreter as their computing -base are deleted as well, in all interpreters they have been shared -with or moved into, and in whatever thread they have been transferred -to. While this pulls the rug out under the other thread(s) and/or -interpreter(s), this cannot be avoided. Trying to use such a channel -will cause the generation of a regular error about unknown channel -handles. -.PP -This subcommand is \fBsafe\fR and made accessible to safe -interpreters. While it arranges for the execution of arbitrary Tcl -code the system also makes sure that the code is always executed -within the safe interpreter. +.QW \fBwrite\fR +, indicating whether the channel is a read channel, a write channel, or both. +It is an error if the handler does not support the chosen mode. +.PP +The handler is called as needed from the global namespace at the top level, and +command resolution happens there at the time of the call. If the handler is +renamed or deleted any subsequent attempt to call it is an error, which may +not be able to describe the failure. +.PP +The handler is always called in the interpreter and thread it was created in, +even if the channel was shared with or moved into a different interpreter in a +different thread. This is achieved through event dispatch, so if the event +loop is not entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or +using Tk, the thread performing the channel operation \fIblocks +indefinitely\fR, resulting in deadlock. +.PP +One side of a channel may be in one thread while the other side is in a +different thread, providing a stream-oriented bridge between the threads. This +provides a method for regular stream communication between threads as an +alternative to sending commands. +.PP +When the interpreter the handler is in is deleted each channel associated with +the handler is deleted as well, regardless of which interpreter or thread it +is currently in or shared with. +.PP +\fBchan create\fR is \fBsafe\fR and is accessible to safe interpreters. The +handler is always called in the safe interpreter it was created in. .RE .TP -\fBchan eof \fIchannelId\fR -. -Test whether the last input operation on the channel called -\fIchannelId\fR failed because the end of the data stream was reached, -returning 1 if end-of-file was reached, and 0 otherwise. -.TP -\fBchan event \fIchannelId event\fR ?\fIscript\fR? -. -Arrange for the Tcl script \fIscript\fR to be installed as a \fIfile -event handler\fR to be called whenever the channel called -\fIchannelId\fR enters the state described by \fIevent\fR (which must -be either \fBreadable\fR or \fBwritable\fR); only one such handler may -be installed per event per channel at a time. If \fIscript\fR is the -empty string, the current handler is deleted (this also happens if the -channel is closed or the interpreter deleted). If \fIscript\fR is -omitted, the currently installed script is returned (or an empty -string if no such handler is installed). The callback is only -performed if the event loop is being serviced (e.g. via \fBvwait\fR or -\fBupdate\fR). -.RS -.PP -A file event handler is a binding between a channel and a script, such -that the script is evaluated whenever the channel becomes readable or -writable. File event handlers are most commonly used to allow data to -be received from another process on an event-driven basis, so that the -receiver can continue to interact with the user or with other channels -while waiting for the data to arrive. If an application invokes -\fBchan gets\fR or \fBchan read\fR on a blocking channel when there is -no input data available, the process will block; until the input data -arrives, it will not be able to service other events, so it will -appear to the user to -.QW "freeze up" . -With \fBchan event\fR, the -process can tell when data is present and only invoke \fBchan gets\fR -or \fBchan read\fR when they will not block. -.PP -A channel is considered to be readable if there is unread data -available on the underlying device. A channel is also considered to -be readable if there is unread data in an input buffer, except in the -special case where the most recent attempt to read from the channel -was a \fBchan gets\fR call that could not find a complete line in the -input buffer. This feature allows a file to be read a line at a time -in non-blocking mode using events. A channel is also considered to be -readable if an end of file or error condition is present on the -underlying file or device. It is important for \fIscript\fR to check -for these conditions and handle them appropriately; for example, if -there is no special check for end of file, an infinite loop may occur -where \fIscript\fR reads no data, returns, and is immediately invoked -again. -.PP -A channel is considered to be writable if at least one byte of data -can be written to the underlying file or device without blocking, or -if an error condition is present on the underlying file or device. -Note that client sockets opened in asynchronous mode become writable -when they become connected or if the connection fails. -.PP -Event-driven I/O works best for channels that have been placed into -non-blocking mode with the \fBchan configure\fR command. In blocking -mode, a \fBchan puts\fR command may block if you give it more data -than the underlying file or device can accept, and a \fBchan gets\fR -or \fBchan read\fR command will block if you attempt to read more data -than is ready; no events will be processed while the commands block. -In non-blocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan -gets\fR never block. -.PP -The script for a file event is executed at global level (outside the -context of any Tcl procedure) in the interpreter in which the \fBchan -event\fR command was invoked. If an error occurs while executing the -script then the command registered with \fBinterp bgerror\fR is used -to report the error. In addition, the file event handler is deleted -if it ever returns an error; this is done in order to prevent infinite -loops due to buggy handlers. -.RE +\fBchan eof \fIchannelName\fR +. +Returns 1 if the last read on the channel failed because the end of the data +was already reached, and 0 otherwise. .TP -\fBchan flush \fIchannelId\fR +\fBchan event \fIchannelName event\fR ?\fIscript\fR? . -Ensures that all pending output for the channel called \fIchannelId\fR -is written. +Arranges for the given script, called a \fBchannel event hndler\fR, to be +called whenever the given event, one of +.QW \fBreadable\fR +or +.QW \fBwritable\fR +occurs on the given channel, replacing any script that was previously set. If +\fIscript\fR is the empty string the current handler is deleted. It is also +deleted when the channel is closed. If \fIscript\fR is omitted, either the +existing script or the empty string is returned. The event loop must be +entered, e.g. via \fBvwait\fR or \fBupdate\fR, or by using Tk, for handlers to +be evaluated. + .RS .PP -If the channel is in blocking mode the command does not return until -all the buffered output has been flushed to the channel. If the -channel is in non-blocking mode, the command may return before all -buffered output has been flushed; the remainder will be flushed in the -background as fast as the underlying file or device is able to absorb -it. +\fIscript\fR is evaluated at the global level in the interpreter it was +established in. Any resulting error is handled in the background, i.e. via +\fBinterp bgerror\fR. In order to prevent an endless loop due to a buggy +handler, the handler is deleted if \fIscript\fR returns an error so that it is +not evaluated again. + +.PP +Without an event handler, \fBchan gets\fR or \fBchan read\fR on a channel in +blocking mode may block until data becomes available, become during which the +thread is unable to perform other work or respond to events on other channels. +This could cause the application to appear to +.QW "freeze up" +\&. +Channel event handlers allow events on the channel to direct channel handling +so that the reader or writer can continue to perform other processing while +waiting for a channel to become available and then handle channel operations +when the channel is ready for the operation. +.PP +A +.QW readable +event occurs when there is data that can be read from the channel and also when +there is an error on the channel. The handler must check for these conditions +and handle them appropriately. For example, a handler that does not check +whether the end of the data has been reached may be repeatedly evaluated in a +busy loop until the channel is closed. +.PP +A +.QW writable +event occurs when at least one byte of data can be written, or if there is an +error on the channel. A client socket opened in non-blocking mode becomes +writable when it becomes connected or if the connection fails. +.PP +Event-driven channel handling works best for channels in non-blocking mode. A +channel in blocking mode blocks when \fBchan puts\fR writes more data than the +channel can accept at the moment, and when \fBchan gets\fR or \fBchan read\fR +requests more data than is currently available. When a channel blocks, the +thread can not do any other processing or service any other events. A channel +in non-blocking mode allows a thread to carry on with other work and get back +to the channel at the right time. .RE .TP -\fBchan gets \fIchannelId\fR ?\fIvarName\fR? -. -Reads the next line from the channel called \fIchannelId\fR. If -\fIvarName\fR is not specified, the result of the command will be the -line that has been read (without a trailing newline character) or an -empty string upon end-of-file or, in non-blocking mode, if the data -available is exhausted. If \fIvarName\fR is specified, the line that -has been read will be written to the variable called \fIvarName\fR and -result will be the number of characters that have been read or -1 if -end-of-file was reached or, in non-blocking mode, if the data -available is exhausted. +\fBchan flush \fIchannelName\fR +. +For a channel in blocking mode, flushes all buffered output to the destination, +and then returns. For a channel in non-blocking mode, returns immediately +while all buffered output is flushed in the background as soon as possible. +.TP +\fBchan gets \fIchannelName\fR ?\fIvarName\fR? +. +Returns the next line from the channel, removing the trailing line feed, or if +\fIvarName\fR is given, assigns the line to that variable and returns the +number of characters read. +the line that was read, removing the trailing line feed, or returns the +empty string if there is no data to return and the end of the file has been +reached, or in non-blocking mode, if no complete line is currently available. +If \fIvarName\fR is given, assigns the line that was read to variable named +\fIvarName\fR and returns the number of characters that were read, or -1 if +there no data available and the end of the channel was reached or the channel +is in non-blocking mode. .RS .PP -If an end-of-file occurs while part way through reading a line, the -partial line will be returned (or written into \fIvarName\fR). When -\fIvarName\fR is not specified, the end-of-file case can be -distinguished from an empty line using the \fBchan eof\fR command, and -the partial-line-but-non-blocking case can be distinguished with the -\fBchan blocked\fR command. +If the end of the channel is reached the data read so far is returned or +assigned to \fIvarName\fR. When \fIvarName\fR is not given, \fBchan eof\fR may +indicate that the empty string means that the end of the data has been reached, +and \fBchan blocked\fR may indicate that that the empty string means there +isn't currently enough data do return the next line. .RE .TP \fBchan names\fR ?\fIpattern\fR? . -Produces a list of all channel names. If \fIpattern\fR is specified, -only those channel names that match it (according to the rules of -\fBstring match\fR) will be returned. +Returns a list of all channel names, or if \fIpattern\fR is given, only those +names that match according to the rules of \fBstring match\fR. .TP -\fBchan pending \fImode channelId\fR +\fBchan pending \fImode channelName\fR . -Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR, -returns the number of -bytes of input or output (respectively) currently buffered -internally for \fIchannelId\fR (especially useful in a readable event -callback to impose application-specific limits on input line lengths to avoid -a potential denial-of-service attack where a hostile user crafts -an extremely long line that exceeds the available memory to buffer it). -Returns -1 if the channel was not opened for the mode in question. +Returns the number of bytes of input +when \fImode\fR is +.QW\fBinput\fR +, or output when \fImode\fR is +.QW\fBoutput\fR +, that are currently internally buffered for the channel. Useful in a readable +event callback to impose limits on input line length to avoid a potential +denial-of-service attack where an extremely long line exceeds the available +memory to buffer it. Returns -1 if the channel was not opened for the mode in +question. .TP \fBchan pipe\fR -Creates a standalone pipe whose read- and write-side channels are -returned as a 2-element list, the first element being the read side and -the second the write side. Can be useful e.g. to redirect -separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do -this, spawn with "2>@" or -">@" redirection operators onto the write side of a pipe, and then -immediately close it in the parent. This is necessary to get an EOF on -the read side once the child has exited or otherwise closed its output. +Creates a pipe, i.e. a readable channel and a writable channel, and returns the +names of the readable channel and the writable channel. Data written to the +writable channel can be read from the readable channel. Because the pipe is a +real system-level pipe, it can be connected to other processes using +redirection. For example, to redirect \fBstderr\fR from a subprocess into one +channel, and \fBstdout\fR into another, \fBexec\fR with "2>@" and ">@", each +onto the writable side of a pipe, closing the writable side immediately +thereafter so that EOF is signaled on the read side once the subprocess has +closed its output, typically on exit. .RS .PP -Note that the pipe buffering semantics can vary at the operating system level -substantially; it is not safe to assume that a write performed on the output -side of the pipe will appear instantly to the input side. This is a -fundamental difference and Tcl cannot conceal it. The overall stream semantics -\fIare\fR compatible, so blocking reads and writes will not see most of the -differences, but the details of what exactly gets written when are not. This -is most likely to show up when using pipelines for testing; care should be -taken to ensure that deadlocks do not occur and that potential short reads are -allowed for. +Due to buffering, data written to one side of a pipe might not immediately +become available on the other side. Tcl's own buffers can be configured via +\fBchan configure -buffering\fR, but overall behaviour still depends on +operating system buffers outside of Tcl's control. Once the write side of the +channel is closed, any data remaining in the buffers is flushed through to the +read side. It may be useful to arrange for the connected process to flush at +some point after writing to the channel or to have it use some system-provided +mechanism to configure buffering. When two pipes are connected to the same +process, one to send data to the process, and one to read data from the +process, a deadlock may occur if the channels are in blocking mode: If +reading, the channel may block waiting for data that can never come because +buffers are only flushed on subsequent writes, and if writing, the channel may +block while waiting for the buffers to become free, which can never happen +because the reader can not read while the writer is blocking. To avoid this +issue, either put the channels into non-blocking mode and use event handlers, +or place the read channel and the write channel in separate interpreters in +separate threads. .RE .TP -\fBchan pop \fIchannelId\fR -Removes the topmost transformation from the channel \fIchannelId\fR, if there -is any. If there are no transformations added to \fIchannelId\fR, this is -equivalent to \fBchan close\fR of that channel. The result is normally the -empty string, but can be an error in some situations (i.e. where the -underlying system stream is closed and that results in an error). -.TP -\fBchan postevent \fIchannelId eventSpec\fR -. -This subcommand is used by command handlers specified with \fBchan -create\fR. It notifies the channel represented by the handle -\fIchannelId\fR that the event(s) listed in the \fIeventSpec\fR have -occurred. The argument has to be a list containing any of the strings -\fBread\fR and \fBwrite\fR. The list must contain at least one -element as it does not make sense to invoke the command if there are -no events to post. +\fBchan pop \fIchannelName\fR +Removes the topmost transformation handler from the channel if there is one, +and closes the channel otherwise. The result is normally the empty string, but +may be an error in some situations, e.g. when closing the underlying resource +results in an error. +.TP +\fBchan postevent \fIchannelName eventSpec\fR +. +For use by handlers established with \fBchan create\fR. Notifies Tcl that +that one or more event(s) listed in \fIeventSpec\fR, each of which is either +.QW\fBread\fR +or +.QW\fBwrite\fR. +, have occurred. .RS .PP -Note that this subcommand can only be used with channel handles that -were created/opened by \fBchan create\fR. All other channels will -cause this subcommand to report an error. -.PP -As only the Tcl level of a channel, i.e. its command handler, should -post events to it we also restrict the usage of this command to the -interpreter that created the channel. In other words, posting events -to a reflected channel from an interpreter that does not contain it's -implementation is not allowed. Attempting to post an event from any -other interpreter will cause this subcommand to report an error. -.PP -Another restriction is that it is not possible to post events that the -I/O core has not registered an interest in. Trying to do so will cause -the method to throw an error. See the command handler method -\fBwatch\fR described in \fBrefchan\fR, the document specifying -the API of command handlers for reflected channels. -.PP -This command is \fBsafe\fR and made accessible to safe interpreters. -It can trigger the execution of \fBchan event\fR handlers, whether in the -current interpreter or in other interpreters or other threads, even -where the event is posted from a safe interpreter and listened for by -a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR -executed in the interpreter that set them up. +For use only by handlers for a channel created by \fBchan create\fR. It is an +error to post an event for any other channel. +.PP +Since only the handler for a reflected channel channel should post events it is +an error to post an event from any interpreter other than the interpreter that +created the channel. +.PP +It is an error to post an event that the channel has no interest in. See +\fBwatch\fR in the \fBrefchan\fR documentation for more information +.PP +\fBchan postevent\fR is available in safe interpreters, as any handler for a +reflected channel would have been created, and will be evaluated in that +interpreter as well. .RE .TP -\fBchan push \fIchannelId cmdPrefix\fR -Adds a new transformation on top of the channel \fIchannelId\fR. The -\fIcmdPrefix\fR argument describes a list of one or more words which represent -a handler that will be used to implement the transformation. The command -prefix must provide the API described in the \fBtranschan\fR manual page. -The result of this subcommand is a handle to the transformation. Note that it -is important to make sure that the transformation is capable of supporting the -channel mode that it is used with or this can make the channel neither -readable nor writable. -.TP -\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR -. -Writes \fIstring\fR to the channel named \fIchannelId\fR followed by a -newline character. A trailing newline character is written unless the -optional flag \fB\-nonewline\fR is given. If \fIchannelId\fR is -omitted, the string is written to the standard output channel, +\fBchan push \fIchannelName cmdPrefix\fR +Adds a new transformation handler on top of the channel and returns a handle +for the transformation. \fIcmdPrefix\fR is the first words of a command that +provides the interface documented for \fBtranschan\fR, and transforms data on +the channel, It is an error if handler does not support the mode(s) the channel +is in. +.TP +\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelName\fR? \fIstring\fR +. +Writes \fIstring\fR and a line feed to the channel. If \fB\-nonewline\fR is +given, the trailing line feed is not written. The default channel is \fBstdout\fR. .RS .PP -Newline characters in the output are translated by \fBchan puts\fR to -platform-specific end-of-line sequences according to the currently -configured value of the \fB\-translation\fR option for the channel -(for example, on PCs newlines are normally replaced with -carriage-return-linefeed sequences; see \fBchan configure\fR above for -details). -.PP -Tcl buffers output internally, so characters written with \fBchan -puts\fR may not appear immediately on the output file or device; Tcl -will normally delay output until the buffer is full or the channel is -closed. You can force output to appear immediately with the \fBchan -flush\fR command. -.PP -When the output buffer fills up, the \fBchan puts\fR command will -normally block until all the buffered data has been accepted for -output by the operating system. If \fIchannelId\fR is in non-blocking -mode then the \fBchan puts\fR command will not block even if the -operating system cannot accept the data. Instead, Tcl continues to -buffer the data and writes it in the background as fast as the -underlying file or device can accept it. The application must use the -Tcl event loop for non-blocking output to work; otherwise Tcl never -finds out that the file or device is ready for more output data. It -is possible for an arbitrarily large amount of data to be buffered for -a channel in non-blocking mode, which could consume a large amount of -memory. To avoid wasting memory, non-blocking I/O should normally be -used in an event-driven fashion with the \fBchan event\fR command -(do not invoke \fBchan puts\fR unless you have recently been notified -via a file event that the channel is ready for more output data). +Each line feed in the output is translated according to the configuration of +\fB\-translation\fR. +.PP +Because Tcl internally buffers output, characters written to a channel may not +immediately be available at the destination. Tcl normally delays output until +the buffer is full or the channel is closed. \fBchan flush\fR forces output in +the direction of the destination. +.PP +When the output for a channel in blocking mode fills up, \fBchan puts\fR blocks +until space in the buffer is available again, but for a channel in non-blocking +mode, it returns immediately and the data is written in the background as fast +possible, constrained by the speed at which as the destination accepts it. +Output to a channel in non-blocking mode only works properly when the +application enters the event loop, giving Tcl a chance to find out that the +destination is ready to accept more data. When a channel is in non-blocking +mode, Tcl's internal buffers can hold an arbitrary amount of data, possibly +consuming a large amount of memory. To avoid wasting memory, channels in +non-blocking mode should normally be handled using \fBchan event\fR, where the +application only invokes \fBchan puts\fR after being recently notified through +a file event handler that the channel is ready for more output data. .RE .TP -\fBchan read \fIchannelId\fR ?\fInumChars\fR? +\fBchan read \fIchannelName\fR ?\fInumChars\fR? .TP -\fBchan read \fR?\fB\-nonewline\fR? \fIchannelId\fR +\fBchan read \fR?\fB\-nonewline\fR? \fIchannelName\fR . -In the first form, the result will be the next \fInumChars\fR -characters read from the channel named \fIchannelId\fR; if -\fInumChars\fR is omitted, all characters up to the point when the -channel would signal a failure (whether an end-of-file, blocked or -other error condition) are read. In the second form (i.e. when -\fInumChars\fR has been omitted) the flag \fB\-nonewline\fR may be -given to indicate that any trailing newline in the string that has -been read should be trimmed. +Reads and returns the next \fInumChars\fR characters from the channel. If +\fInumChars\fR is omitted, all available characters up to the end of the file +are read, or if the channel is in non-blocking mode, all currently-available +characters are read. If there is an error on the channel, reading ceases and +an error is returned. If \fInumChars\fR is not given, \fB\-nonewline\fR +may be given, causing any any trailing line feed to be trimmed. .RS .PP -If \fIchannelId\fR is in non-blocking mode, \fBchan read\fR may not -read as many characters as requested: once all available input has -been read, the command will return the data that is available rather -than blocking for more input. If the channel is configured to use a -multi-byte encoding, then there may actually be some bytes remaining -in the internal buffers that do not form a complete character. These -bytes will not be returned until a complete character is available or -end-of-file is reached. The \fB\-nonewline\fR switch is ignored if -the command returns before reaching the end of the file. -.PP -\fBChan read\fR translates end-of-line sequences in the input into -newline characters according to the \fB\-translation\fR option for the -channel (see \fBchan configure\fR above for a discussion on the ways -in which \fBchan configure\fR will alter input). -.PP -When reading from a serial port, most applications should configure -the serial port channel to be non-blocking, like this: -.PP -.CS -\fBchan configure \fIchannelId \fB\-blocking \fI0\fR. -.CE -.PP -Then \fBchan read\fR behaves much like described above. Note that -most serial ports are comparatively slow; it is entirely possible to -get a \fBreadable\fR event for each character read from them. Care -must be taken when using \fBchan read\fR on blocking serial ports: -.TP -\fBchan read \fIchannelId numChars\fR -. -In this form \fBchan read\fR blocks until \fInumChars\fR have been -received from the serial port. -.TP -\fBchan read \fIchannelId\fR -. -In this form \fBchan read\fR blocks until the reception of the -end-of-file character, see \fBchan configure -eofchar\fR. If there no -end-of-file character has been configured for the channel, then -\fBchan read\fR will block forever. +If the channel is in non-blocking mode, fewer characters than requested may be +returned. If the channel is configured to use a multi-byte encoding, bytes +that do not form a complete character are retained in the buffers until enough +bytes to complete the character accumulate, or the end of the data is reached. +\fB\-nonewline\fR is ignored if characters are returned before reaching the end +of the file. +.PP +Each end-of-line sequence according to the value of \fB\-translation\fR is +translated into a line feed. +.PP +When reading from a serial port, most applications should configure the serial +port channel to be in non-blocking mode, but not necessarily use an event +handler since most serial ports are comparatively slow. It is entirely +possible to get a \fBreadable\fR event for each individual character. In +blocking mode, \fBchan read\fR blocks forever when reading to the end of the +data if there is no \fBchan configure -eofchar\fR configured for the channel. .RE .TP -\fBchan seek \fIchannelId offset\fR ?\fIorigin\fR? +\fBchan seek \fIchannelName offset\fR ?\fIorigin\fR? . -Sets the current access position within the underlying data stream for -the channel named \fIchannelId\fR to be \fIoffset\fR bytes relative to -\fIorigin\fR. \fIOffset\fR must be an integer (which may be negative) -and \fIorigin\fR must be one of the following: +Sets the current position for the data in the channel to integer \fIoffset\fR +bytes relative to \fIorigin\fR. A negative offset moves the current position +backwards from the origin. \fIorigin\fR is one of the +following: .RS +.PP .TP 10 \fBstart\fR . -The new access position will be \fIoffset\fR bytes from the start -of the underlying file or device. +The origin is the start of the data. This is the default. .TP 10 \fBcurrent\fR . -The new access position will be \fIoffset\fR bytes from the current -access position; a negative \fIoffset\fR moves the access position -backwards in the underlying file or device. +The origin is the current position. .TP 10 \fBend\fR . -The new access position will be \fIoffset\fR bytes from the end of the -file or device. A negative \fIoffset\fR places the access position -before the end of file, and a positive \fIoffset\fR places the access -position after the end of file. -.PP -The \fIorigin\fR argument defaults to \fBstart\fR. +The origin is the end of the data. .PP -\fBChan seek\fR flushes all buffered output for the channel before the -command returns, even if the channel is in non-blocking mode. It also -discards any buffered and unread input. This command returns an empty -string. An error occurs if this command is applied to channels whose -underlying file or device does not support seeking. +\fBChan seek\fR flushes all buffered output even if the channel is in +non-blocking mode, discards any buffered and unread input, and returns the +empty string or an error if the channel does not support seeking. .PP -Note that \fIoffset\fR values are byte offsets, not character offsets. -Both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes, -not characters, unlike \fBchan read\fR. +\fIoffset\fR values are byte offsets, not character offsets. Unlike \fBchan +read\fR, both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes, +not characters, .RE .TP -\fBchan tell \fIchannelId\fR +\fBchan tell \fIchannelName\fR . -Returns a number giving the current access position within the -underlying data stream for the channel named \fIchannelId\fR. This -value returned is a byte offset that can be passed to \fBchan seek\fR -in order to set the channel to a particular position. Note that this -value is in terms of bytes, not characters like \fBchan read\fR. The -value returned is -1 for channels that do not support seeking. +Returns the offset in bytes of the current position in the underlying data, or +-1 if the channel does not suport seeking. The value can be passed to \fBchan +seek\fR to set current position to that offset. .TP -\fBchan truncate \fIchannelId\fR ?\fIlength\fR? +\fBchan truncate \fIchannelName\fR ?\fIlength\fR? . -Sets the byte length of the underlying data stream for the channel -named \fIchannelId\fR to be \fIlength\fR (or to the current byte -offset within the underlying data stream if \fIlength\fR is -omitted). The channel is flushed before truncation. +Flushes the channel and truncates the data in the channel to \fIlength\fR +bytes, or to the current position in bytes if \fIlength\fR is omitted. . .SH EXAMPLES .PP -This opens a file using a known encoding (CP1252, a very common encoding -on Windows), searches for a string, rewrites that part, and truncates the -file after a further two lines. +In the following example a file is opened using the encoding CP1252, which is +common on Windows, searches for a string, rewrites that part, and truncates the +file two lines later. .PP .CS set f [open somefile.txt r+] @@ -793,12 +619,12 @@ while {[\fBchan gets\fR $f line] >= 0} { \fBchan close\fR $f .CE .PP -A network server that does echoing of its input line-by-line without -preventing servicing of other connections at the same time. +A network server that echoes its input line-by-line without +preventing servicing of other connections at the same time: .PP .CS # This is a very simple logger... -proc log {message} { +proc log message { \fBchan puts\fR stdout $message } -- cgit v0.12 From 511e85013ac111a96845721348abc019321ab15e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 23 Jan 2022 16:21:42 +0000 Subject: eol-spacing from previous commit --- doc/chan.n | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/chan.n b/doc/chan.n index aa8bbca..9589f98 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -113,7 +113,7 @@ connect to terminal-like devices, the default value is \fBline\fR. For \fB\-buffersize\fR \fInewSize\fR . \fInewSize\fR, an integer no greater than one million, is the size in bytes of -any input or output buffers subsequently allocated for this channel. +any input or output buffers subsequently allocated for this channel. .TP \fB\-encoding\fR ?\fIname\fR? . @@ -148,7 +148,7 @@ interface with the operating system, . \fIchar\fR signals the end of the data when it is encountered in the input. For output, the character is added when the channel is closed. If \fIchar\fR -is the empty string, there is no special character that marks the end of the +is the empty string, there is no special character that marks the end of the data. For read-write channels, one end-of-file character for input and another for output may be given. When only one end-of-file character is given it is applied to both input and output. For a read-write channel two values are @@ -279,14 +279,14 @@ first words of a command that provides the interface for a \fBrefchan\fR. \fBImode\fR is a list of one or more of the strings .QW \fBread\fR or -.QW \fBwrite\fR +.QW \fBwrite\fR , indicating whether the channel is a read channel, a write channel, or both. It is an error if the handler does not support the chosen mode. .PP The handler is called as needed from the global namespace at the top level, and command resolution happens there at the time of the call. If the handler is renamed or deleted any subsequent attempt to call it is an error, which may -not be able to describe the failure. +not be able to describe the failure. .PP The handler is always called in the interpreter and thread it was created in, even if the channel was shared with or moved into a different interpreter in a @@ -374,7 +374,7 @@ to the channel at the right time. . For a channel in blocking mode, flushes all buffered output to the destination, and then returns. For a channel in non-blocking mode, returns immediately -while all buffered output is flushed in the background as soon as possible. +while all buffered output is flushed in the background as soon as possible. .TP \fBchan gets \fIchannelName\fR ?\fIvarName\fR? . @@ -522,7 +522,7 @@ Reads and returns the next \fInumChars\fR characters from the channel. If are read, or if the channel is in non-blocking mode, all currently-available characters are read. If there is an error on the channel, reading ceases and an error is returned. If \fInumChars\fR is not given, \fB\-nonewline\fR -may be given, causing any any trailing line feed to be trimmed. +may be given, causing any any trailing line feed to be trimmed. .RS .PP If the channel is in non-blocking mode, fewer characters than requested may be @@ -562,7 +562,7 @@ The origin is the current position. .TP 10 \fBend\fR . -The origin is the end of the data. +The origin is the end of the data. .PP \fBChan seek\fR flushes all buffered output even if the channel is in non-blocking mode, discards any buffered and unread input, and returns the -- cgit v0.12 From bc8c2ad47a5fc72622020a829493e50e449bd040 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Jan 2022 11:01:07 +0000 Subject: Fix another bug in Tcl_GetIntForIndex() (demonstrated by the new testcases from the previous commit) --- generic/tclTest.c | 7 ++++--- generic/tclUtil.c | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 95ef5b7..5e6ca8c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7046,20 +7046,21 @@ TestGetIntForIndexCmd( int objc, Tcl_Obj *const objv[]) { - int result, endvalue; + int result; + Tcl_WideInt endvalue; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "index endvalue"); return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &endvalue) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); return TCL_OK; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 10153fb..e29afcc 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3699,7 +3699,7 @@ Tcl_GetIntForIndex( { Tcl_WideInt wide; - if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) { + if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { return TCL_ERROR; } if (indexPtr != NULL) { -- cgit v0.12 From d46657f1f739cdf35daf961140c922498eb151f7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Jan 2022 11:15:39 +0000 Subject: Don't document the size_t form of Tcl_GetStringFromObj() (yet), because it's only available if TCL_NO_DEPRECATED is defined --- doc/StringObj.3 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 90b53f2..1b04dd4 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -121,7 +121,7 @@ the last one available. Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. -.AP size_t | int *lengthPtr out +.AP int *lengthPtr out The location where \fBTcl_GetStringFromObj\fR will store the length of a value's string representation. May be (int *)NULL when not used. .AP "const char" *string in -- cgit v0.12 From 5d9db7d9acbe609d68bb6f81daeaa5abeea212aa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 24 Jan 2022 15:29:36 +0000 Subject: intPtr -> lengthPtr in Tcl_ListObjLength() documentation, so the documentation matches the signature in the header file --- doc/ListObj.3 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/ListObj.3 b/doc/ListObj.3 index ab836d8..f282039 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -28,7 +28,7 @@ int \fBTcl_ListObjGetElements\fR(\fIinterp, listPtr, objcPtr, objvPtr\fR) .sp int -\fBTcl_ListObjLength\fR(\fIinterp, listPtr, intPtr\fR) +\fBTcl_ListObjLength\fR(\fIinterp, listPtr, lengthPtr\fR) .sp int \fBTcl_ListObjIndex\fR(\fIinterp, listPtr, index, objPtrPtr\fR) @@ -76,7 +76,7 @@ An array of pointers to values. \fBTcl_NewListObj\fR will insert these values into a new list value and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR. Each value will become a separate list element. -.AP int *intPtr out +.AP int *lengthPtr out Points to location where \fBTcl_ListObjLength\fR stores the length of the list. .AP int index in @@ -162,7 +162,7 @@ Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer. .PP \fBTcl_ListObjLength\fR returns the number of elements in the list value referenced by \fIlistPtr\fR. -It returns this count by storing an integer in the address \fIintPtr\fR. +It returns this count by storing an integer in the address \fIlengthPtr\fR. If the value is not already a list value, \fBTcl_ListObjLength\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR -- cgit v0.12 From 5c2bc08ea4edc13e386422d6c6f86bb65014a0a3 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 26 Jan 2022 17:48:34 +0000 Subject: Add back a clarification to the documentation for [expr] that an operand is interpreted as a number wherever possible, and rework text to be more compact. --- doc/expr.n | 137 +++++++++++++++++++++++++++++++------------------------------ 1 file changed, 69 insertions(+), 68 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 43ad26f..490217c 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -17,7 +17,7 @@ expr \- Evaluate an expression .BE .SH DESCRIPTION .PP -The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates +Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates that expression, returning its value. The operators permitted in an expression include a subset of the operators permitted in C expressions. For those operators @@ -37,76 +37,36 @@ operands are specified. Expressions also support non-numeric operands, string comparisons, and some additional operators not found in C. .PP -When an expression evaluates to an integer, the value is the decimal form of -the integer, and when an expression evaluates to a floating-point number, the -value is the form produced by the \fB%g\fR format specifier of Tcl's -\fBformat\fR command. +When the result of expression is an integer, it is in decimal form, and when +the result is a floating-point number, it is in the form produced by the +\fB%g\fR format specifier of \fBformat\fR. .PP .VS "TIP 582" -You can use \fB#\fR at any point in the expression (except inside double -quotes or braces) to start a comment. Comments last to the end of the line or +At any point in the expression except within double quotes or braces, \fB#\fR +is the beginning of a comment, which lasts to the end of the line or the end of the expression, whichever comes first. .VE "TIP 582" .SS OPERANDS .PP An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is -ignored. +ignored. Each operand is intepreted as a numeric value if at all possible. .PP -An operand may be specified in any of the following ways: -.IP [1] -As a numeric value, either integer or floating-point. -.IP [2] -As a boolean value, using any form understood by \fBstring is\fR -\fBboolean\fR. -.IP [3] -As a variable, using standard \fB$\fR notation. -The value of the variable is then the value of the operand. -.IP [4] -As a string enclosed in double-quotes. -Backslash, variable, and command substitution are performed as described in -\fBTcl\fR. -.IP [5] -As a string enclosed in braces. -The operand is treated as a braced value as described in \fBTcl\fR. -.IP [6] -As a Tcl command enclosed in brackets. -Command substitution is performed as described in \fBTcl\fR. -.IP [7] -As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above -forms for operands. See \fBMATH FUNCTIONS\fR below for -a discussion of how mathematical functions are handled. -.PP -Because \fBexpr\fR parses and performs substitutions on values that have -already been parsed and substituted by \fBTcl\fR, it is usually best to enclose -expressions in braces to avoid the first round of substitutions by -\fBTcl\fR. -.PP -Below are some examples of simple expressions where the value of \fBa\fR is 3 -and the value of \fBb\fR is 6. The command on the left side of each line -produces the value on the right side. -.PP -.CS -.ta 9c -\fBexpr\fR {3.1 + $a} \fI6.1\fR -\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR -\fBexpr\fR {4*[llength "6 2"]} \fI8\fR -\fBexpr\fR {{word one} < "word $a"} \fI0\fR -.CE -.PP -\fBInteger value\fR +Each operand has one of the following forms: +.RS .PP -An integer operand may be specified in decimal (the normal case, the optional -first two characters are \fB0d\fR), binary -(the first two characters are \fB0b\fR), octal -(the first two characters are \fB0o\fR), or hexadecimal -(the first two characters are \fB0x\fR) form. For -compatibility with older Tcl releases, an operand that begins with \fB0\fR is -interpreted as an octal integer even if the second character is not \fBo\fR. +.TP +A \fBnumeric value\fR .PP -\fBFloating-point value\fR +.RS +. +Either integer or floating-point. The first two characters of an integer may +also be \fB0d\fR for decimal, \fB0b\fR for binary, \fB0o\fR for octal or +\fB0x\fR for hexadicimal. For compatibility with older Tcl releases, an +operand that begins with \fB0\fR is interpreted as an octal integer even if the +second character is not \fBo\fR. .PP -A floating-point number may be specified in any of several +A floating-point number may be take any of several common decimal formats, and may use the decimal point \fB.\fR, \fBe\fR or \fBE\fR for scientific notation, and the sign characters \fB+\fR and \fB\-\fR. The @@ -116,16 +76,9 @@ and \fBNaN\fR, in any combination of case, are also recognized as floating point values. An operand that doesn't have a numeric interpretation must be quoted with either braces or with double quotes. .PP -\fBBoolean value\fR -.PP -A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR, -or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR. -.PP -\fBDigit Separator\fR -.PP Digits in any numeric value may be separated with one or more underscore -characters, "\fB_\fR", to improve readability. These separators may only -appear between digits. The separator may not appear at the start of a +characters, "\fB_\fR". A separator may only +appear between digits, not appear at the start of a numeric value, between the leading 0 and radix specifier, or at the end of a numeric value. Here are some examples: .PP @@ -135,6 +88,54 @@ end of a numeric value. Here are some examples: \fBexpr\fR 0xffff_ffff \fI4294967295\fR \fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR .CE +.RE + +.TP +A \fBboolean value\fR +. +Using any form understood by \fBstring is\fR +\fBboolean\fR. +.TP +A \fBvariable\fR +. +Using standard \fB$\fR notation. +The value of the variable is the value of the operand. +.TP +A string enclosed in \fBdouble-quotes\fR +. +Backslash, variable, and command substitution are performed according to the +rules for \fBTcl\fR. +.TP +A string enclosed in \fBbraces\fR. +The operand is treated as a braced value according to the rule for braces in +\fBTcl\fR. +.TP +A Tcl command enclosed in \fBbrackets\fR +. +Command substitution is performed as according to the command substitution rule +for \fBTcl\fR. +.TP +A mathematical function such as \fBsin($x)\fR, whose arguments have any of the above +forms for operands. See \fBMATH FUNCTIONS\fR below for +a discussion of how mathematical functions are handled. +.RE +.PP +Because \fBexpr\fR parses and performs substitutions on values that have +already been parsed and substituted by \fBTcl\fR, it is usually best to enclose +expressions in braces to avoid the first round of substitutions by +\fBTcl\fR. +.PP +Below are some examples of simple expressions where the value of \fBa\fR is 3 +and the value of \fBb\fR is 6. The command on the left side of each line +produces the value on the right side. +.PP +.CS +.ta 9c +\fBexpr\fR {3.1 + $a} \fI6.1\fR +\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR +\fBexpr\fR {4*[llength {6 2}]} \fI8\fR +\fBexpr\fR {{word one} < "word $a"} \fI0\fR +.CE .PP .SS OPERATORS .PP -- cgit v0.12 From cc66f3601ff68b38489ca84cb582dbbe3ea804ef Mon Sep 17 00:00:00 2001 From: bch Date: Fri, 28 Jan 2022 23:28:24 +0000 Subject: rejig argv/argc handling in response to investigation prompted by [https://arstechnica.com/information-technology/2022/01/a-bug-lurking-for- 12-years-gives-attackers-root-on-every-major-linux-distro/|this "polkit issue"] and some experimenting w/ execve() (ab)use. Essentially port of [0e1d2702ab] and its parent; discussed at length on IRC --- generic/tclMain.c | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index bb48dbb..f1b1ae2 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -288,6 +288,8 @@ Tcl_MainEx( * but before starting to execute commands. */ Tcl_Interp *interp) { + char *progname = NULL; /* may/may-not be able to use argv[0] */ + int i=0; /* argv[i] index */ Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; @@ -296,7 +298,14 @@ Tcl_MainEx( InteractiveState is; TclpSetInitialEncodings(); - TclpFindExecutable((const char *)argv[0]); + if (0 < argc) { + progname = argv[0]; + --argc; /* consume argv[0] */ + ++i; + } + TclpFindExecutable ((const char *)progname); /* nb: this could be NULL + * w/ (eg) a malformed + * execve() */ Tcl_InitMemory(interp); @@ -318,36 +327,35 @@ Tcl_MainEx( * FILENAME */ - if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) + /* mind argc is being adjusted as we proceed */ + if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2]); Tcl_SetStartupScript(NewNativeObj(argv[3]), Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; - argv += 3; - } else if ((argc > 1) && ('-' != argv[1][0])) { + i += 3; + } else if ((argc >= 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; - argv++; + i++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - appName = NewNativeObj(argv[0]); + appName = NewNativeObj(progname); } else { appName = path; } Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); - argc--; - argv++; Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++)); + Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++])); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); -- cgit v0.12 From 95bcc538075fc86ab77313a173e2c4ce89a38f0d Mon Sep 17 00:00:00 2001 From: bch Date: Fri, 28 Jan 2022 23:52:10 +0000 Subject: take advantage of what we know re: argv guarantees [https://www.iso-9899.info/n1570.html#5.1.2.2.1|argv spec] (per @cousteau on #tcl) --- generic/tclMain.c | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index f1b1ae2..be9ec4c 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -288,7 +288,6 @@ Tcl_MainEx( * but before starting to execute commands. */ Tcl_Interp *interp) { - char *progname = NULL; /* may/may-not be able to use argv[0] */ int i=0; /* argv[i] index */ Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; @@ -299,13 +298,12 @@ Tcl_MainEx( TclpSetInitialEncodings(); if (0 < argc) { - progname = argv[0]; - --argc; /* consume argv[0] */ + --argc; /* "consume" argv[0] */ ++i; } - TclpFindExecutable ((const char *)progname); /* nb: this could be NULL - * w/ (eg) a malformed - * execve() */ + TclpFindExecutable ((const char *)argv [0]); /* nb: this could be NULL + * w/ (eg) an empty argv + * supplied to execve() */ Tcl_InitMemory(interp); @@ -345,7 +343,7 @@ Tcl_MainEx( path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - appName = NewNativeObj(progname); + appName = NewNativeObj(argv[0]); } else { appName = path; } -- cgit v0.12 From 3311ca7d306a1bf7de8e03bac9eac81d63677899 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 1 Feb 2022 12:03:54 +0000 Subject: Code cleanup in tclMain.c and tclAppInit.c: Make them Tcl-8.7-aware, usable as more generic examples for extensions. --- generic/tclMain.c | 21 +++++++++++---------- unix/tclAppInit.c | 15 +++++++++++---- win/tclAppInit.c | 26 +++++++++++++++++--------- 3 files changed, 39 insertions(+), 23 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index f0b2682..30a206f 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -95,7 +95,7 @@ typedef enum { PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; -typedef struct InteractiveState { +typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a @@ -229,7 +229,7 @@ Tcl_SourceRCFile( const char *fileName; Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; @@ -515,7 +515,7 @@ Tcl_MainEx( * error messages troubles deeper in, so lop it back off. */ - Tcl_GetStringFromObj(is.commandPtr, &length); + (void)Tcl_GetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); @@ -532,7 +532,7 @@ Tcl_MainEx( } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - Tcl_GetStringFromObj(resultPtr, &length); + (void)Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); @@ -745,17 +745,18 @@ TclFullFinalizationRequested(void) *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { - int code, length; - InteractiveState *isPtr = clientData; + int code; + int length; + InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; + (void)mask; if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); @@ -791,7 +792,7 @@ StdinProc( goto prompt; } isPtr->prompt = PROMPT_START; - Tcl_GetStringFromObj(commandPtr, &length); + (void)Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* @@ -823,7 +824,7 @@ StdinProc( chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); - Tcl_GetStringFromObj(resultPtr, &length); + (void)Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); @@ -925,7 +926,7 @@ static void FreeMainInterp( ClientData clientData) { - Tcl_Interp *interp = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; /*if (TclInExit()) return;*/ diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..552f9e4 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -15,15 +15,19 @@ #undef BUILD_tcl #undef STATIC_BUILD #include "tcl.h" +#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 +# define Tcl_LibraryInitProc Tcl_PackageInitProc +# define Tcl_StaticLibrary Tcl_StaticPackage +#endif #ifdef TCL_TEST -extern Tcl_PackageInitProc Tcltest_Init; -extern Tcl_PackageInitProc Tcltest_SafeInit; +extern Tcl_LibraryInitProc Tcltest_Init; +extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST extern void XtToolkitInitialize(void); -extern Tcl_PackageInitProc Tclxttest_Init; +extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ /* @@ -79,6 +83,9 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) + /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); @@ -122,7 +129,7 @@ Tcl_AppInit( if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 695099e..058b92a 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -23,16 +23,20 @@ #include #include #include +#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 +# define Tcl_LibraryInitProc Tcl_PackageInitProc +# define Tcl_StaticLibrary Tcl_StaticPackage +#endif #ifdef TCL_TEST -extern Tcl_PackageInitProc Tcltest_Init; -extern Tcl_PackageInitProc Tcltest_SafeInit; +extern Tcl_LibraryInitProc Tcltest_Init; +extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES -extern Tcl_PackageInitProc Registry_Init; -extern Tcl_PackageInitProc Dde_Init; -extern Tcl_PackageInitProc Dde_SafeInit; +extern Tcl_LibraryInitProc Registry_Init; +extern Tcl_LibraryInitProc Dde_Init; +extern Tcl_LibraryInitProc Dde_SafeInit; #endif #if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS) @@ -87,7 +91,7 @@ MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); int main( int argc, /* Number of command-line arguments. */ - char *dummy[]) /* Not used. */ + char **argv1) /* Not used. */ { TCHAR **argv; #else @@ -111,6 +115,7 @@ _tmain( * Get our args from the c-runtime. Ignore command line. */ + (void)argv1; setargv(&argc, &argv); #endif @@ -126,6 +131,9 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) + /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); @@ -163,19 +171,19 @@ Tcl_AppInit( if (Registry_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL); + Tcl_StaticLibrary(interp, "Registry", Registry_Init, NULL); if (Dde_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit); + Tcl_StaticLibrary(interp, "Dde", Dde_Init, Dde_SafeInit); #endif #ifdef TCL_TEST if (Tcltest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); + Tcl_StaticLibrary(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit); #endif /* TCL_TEST */ /* -- cgit v0.12 From 7b1d345686119335c547557b1029df64b0d3c5c5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 2 Feb 2022 16:42:18 +0000 Subject: Change DEFAULT_PRIMARY_PROMPT from #define to static const string (saves a strlen() call) --- generic/tclMain.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index 30a206f..3f72838 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -28,7 +28,7 @@ * The default prompt used when the user has not overridden it. */ -#define DEFAULT_PRIMARY_PROMPT "% " +static const char DEFAULT_PRIMARY_PROMPT[] = "% "; /* * This file can be compiled on Windows in UNICODE mode, as well as on all @@ -887,7 +887,7 @@ Prompt( chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT, - strlen(DEFAULT_PRIMARY_PROMPT)); + sizeof(DEFAULT_PRIMARY_PROMPT) - 1); } } } else { -- cgit v0.12 From 99678d70f78441ead651c6b62e7af986648deaeb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 3 Feb 2022 12:49:55 +0000 Subject: Fix Tcl_UtfToWChar() typedef --- generic/tclDecls.h | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 6ca7633..f1962b2 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4269,8 +4269,8 @@ extern const TclStubs *tclStubsPtr; ? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ - ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \ - : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) + ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ + : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \ @@ -4279,8 +4279,8 @@ extern const TclStubs *tclStubsPtr; ? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ - ? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \ - : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) + ? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ + : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) #endif /* -- cgit v0.12 From 8be8b508867864add7ba4793c6b856384ef8b873 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 4 Feb 2022 16:19:25 +0000 Subject: See [https://github.com/tcltk/tcl/pull/10] --- generic/tclTest.c | 6 +++--- tests/env.test | 4 +++- win/configure | 12 ++++++++++-- win/rules.vc | 9 +++++++++ win/tcl.m4 | 9 ++++++++- win/tclWin32Dll.c | 6 +++--- 6 files changed, 36 insertions(+), 10 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 8d22edf..9c94f91 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -326,7 +326,7 @@ static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) static Tcl_ObjCmdProc TestcpuidCmd; #endif @@ -600,7 +600,7 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, NULL, NULL); #endif @@ -6955,7 +6955,7 @@ TestFindLastCmd( return TCL_OK; } -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) /* *---------------------------------------------------------------------- * diff --git a/tests/env.test b/tests/env.test index e4e209f..905cdab 100644 --- a/tests/env.test +++ b/tests/env.test @@ -102,7 +102,9 @@ variable keep { SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM - CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 + CommonProgramFiles CommonProgramFiles(x86) ProgramFiles + ProgramFiles(x86) CommonProgramW6432 ProgramW6432 + WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { diff --git a/win/configure b/win/configure index b4eeb4f..8abb3d3 100755 --- a/win/configure +++ b/win/configure @@ -3763,10 +3763,15 @@ echo "$as_me: error: ${CC} does not support the -shared option. echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 ;; + arm64) + MACHINE="ARM64" + echo "$as_me:$LINENO: result: Using ARM64 $MACHINE mode" >&5 +echo "${ECHO_T} Using ARM64 $MACHINE mode" >&6 + ;; ia64) MACHINE="IA64" - echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5 -echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 + echo "$as_me:$LINENO: result: Using IA64 $MACHINE mode" >&5 +echo "${ECHO_T} Using IA64 $MACHINE mode" >&6 ;; *) cat >conftest.$ac_ext <<_ACEOF @@ -3863,6 +3868,9 @@ echo "${ECHO_T}using shared flags" >&6 amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build ;; + arm64) + MACHINE="ARM64" + ;; ia64) MACHINE="IA64" ;; diff --git a/win/rules.vc b/win/rules.vc index 8a91b58..37723c8 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -435,6 +435,8 @@ VCVER=0 && ![echo ARCH=IX86 >> vercl.x] \ && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ && ![echo ARCH=AMD64 >> vercl.x] \ + && ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \ + && ![echo ARCH=ARM64 >> vercl.x] \ && ![echo $(_HASH)endif >> vercl.x] \ && ![$(cc32) -nologo -TC -P vercl.x 2>NUL] !include vercl.i @@ -490,6 +492,8 @@ MULTIPLATFORM_INSTALL = 0 !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] NATIVE_ARCH=IX86 +!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] +NATIVE_ARCH=ARM64 !else NATIVE_ARCH=AMD64 !endif @@ -1476,6 +1480,11 @@ carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE carch = !endif +# cpuid is only available on intel machines +!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64" +carch = $(carch) /DHAVE_CPUID=1 +!endif + !if $(DEBUG) # Turn warnings into errors cwarn = $(cwarn) -WX diff --git a/win/tcl.m4 b/win/tcl.m4 index 00cd4d2..e2117d2 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -783,9 +783,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ MACHINE="AMD64" ; # assume AMD64 as default 64-bit build AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) ;; + arm64) + MACHINE="ARM64" + AC_MSG_RESULT([ Using ARM64 $MACHINE mode]) + ;; ia64) MACHINE="IA64" - AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + AC_MSG_RESULT([ Using IA64 $MACHINE mode]) ;; *) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ @@ -837,6 +841,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ amd64|x64|yes) MACHINE="AMD64" ; # assume AMD64 as default 64-bit build ;; + arm64) + MACHINE="ARM64" + ;; ia64) MACHINE="IA64" ;; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 9061dd0..8620a08 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -661,12 +661,12 @@ TclWinCPUID( { int status = TCL_ERROR; -#if defined(HAVE_INTRIN_H) && defined(_WIN64) +#if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID) __cpuid((int *)regsPtr, index); status = TCL_OK; -#elif defined(__GNUC__) +#elif defined(__GNUC__) && defined(HAVE_CPUID) # if defined(_WIN64) /* * Execute the CPUID instruction with the given index, and store results @@ -782,7 +782,7 @@ TclWinCPUID( status = registration.status; # endif /* !_WIN64 */ -#elif defined(_MSC_VER) +#elif defined(_MSC_VER) && defined(HAVE_CPUID) # if defined(_WIN64) __cpuid(regsPtr, index); -- cgit v0.12 From 8f8b424c15d02d04e3289418b601c7443c1c6f27 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 6 Feb 2022 12:47:54 +0000 Subject: another try, rules.vc version 1.10 --- win/rules.vc | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/win/rules.vc b/win/rules.vc index 37723c8..2f01de0 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -24,7 +24,7 @@ _RULES_VC = 1 # For modifications that are not backward-compatible, you *must* change # the major version. RULES_VERSION_MAJOR = 1 -RULES_VERSION_MINOR = 9 +RULES_VERSION_MINOR = 10 # The PROJECT macro must be defined by parent makefile. !if "$(PROJECT)" == "" @@ -411,8 +411,8 @@ _INSTALLDIR=$(_INSTALLDIR)\lib # compiler version 1200. This is kept only for legacy reasons as it # does not make sense for recent Microsoft compilers. Only used for # output directory names. -# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target -# NATIVE_ARCH - set to IX86 or AMD64 for the host machine +# ARCH - set to IX86, ARM64 or AMD64 depending on 32- or 64-bit target +# NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine # MACHINE - same as $(ARCH) - legacy # _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed @@ -461,6 +461,9 @@ VCVER = $(VCVERSION) !if "$(MACHINE)" == "x86" !undef MACHINE MACHINE = IX86 +!elseif "$(MACHINE)" == "arm64" +!undef MACHINE +MACHINE = ARM64 !elseif "$(MACHINE)" == "x64" !undef MACHINE MACHINE = AMD64 @@ -477,6 +480,8 @@ MACHINE=$(ARCH) # the Tcl platform::identify command !if "$(MACHINE)" == "AMD64" PLATFORM_IDENTIFY = win32-x86_64 +!elseif "$(MACHINE)" == "ARM64" +PLATFORM_IDENTIFY = win32-arm !else PLATFORM_IDENTIFY = win32-ix86 !endif @@ -492,7 +497,7 @@ MULTIPLATFORM_INSTALL = 0 !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] NATIVE_ARCH=IX86 -!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] +!elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit] NATIVE_ARCH=ARM64 !else NATIVE_ARCH=AMD64 -- cgit v0.12 From f48af06d664b9d4f48755833e764c916ec561f68 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 7 Feb 2022 14:42:11 +0000 Subject: Fix [bae42b3d24]: [d86e92fb33] et.al. eliminates cpuid when cross compiling for win32 --- win/configure | 14 ++++++++++++-- win/configure.in | 2 +- win/makefile.vc | 4 ++-- win/tcl.m4 | 12 +++++++++++- 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/win/configure b/win/configure index 8abb3d3..1701b6f 100755 --- a/win/configure +++ b/win/configure @@ -3279,7 +3279,7 @@ fi SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, - # which requires x86|amd64|ia64. + # which requires x86|amd64|arm64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then @@ -3352,6 +3352,13 @@ echo "${ECHO_T}$ac_cv_cross" >&6 RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; + arm64) + CC="arm64-w64-mingw32-${CC}" + LD="arm64-w64-mingw32-ld" + AR="arm64-w64-mingw32-ar" + RANLIB="arm64-w64-mingw32-ranlib" + RC="arm64-w64-mingw32-windres" + ;; *) CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" @@ -3470,6 +3477,9 @@ echo "${ECHO_T}$ac_cv_win32" >&6 echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} { (exit 1); exit 1; }; } fi + if test "$MACHINE" != "ARM64"; then + extra_cflags="$extra_cflags -DHAVE_CPUID=1" + fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 @@ -5277,7 +5287,7 @@ case "$TCL_PATCH_LEVEL" in esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" -# X86|AMD64|IA64 for manifest +# X86|AMD64|ARM64|IA64 for manifest diff --git a/win/configure.in b/win/configure.in index 0aa3224..45ee1fb 100644 --- a/win/configure.in +++ b/win/configure.in @@ -375,7 +375,7 @@ case "$TCL_PATCH_LEVEL" in esac TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" AC_SUBST(TCL_WIN_VERSION) -# X86|AMD64|IA64 for manifest +# X86|AMD64|ARM64|IA64 for manifest AC_SUBST(MACHINE) AC_SUBST(TCL_VERSION) diff --git a/win/makefile.vc b/win/makefile.vc index 22e0267..08ffc31 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -97,7 +97,7 @@ # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # -# MACHINE=(ALPHA|AMD64|IA64|IX86) +# MACHINE=(ALPHA|AMD64|ARM64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default @@ -520,7 +520,7 @@ $(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win64\zlib1.dll $(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll $(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win64\zdll.lib $(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib -!else +!elseif "$(MACHINE)" == "IX86" $(OUT_DIR)\zlib1.dll: $(COMPATDIR)\zlib\win32\zlib1.dll $(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll $(OUT_DIR)\zdll.lib: $(COMPATDIR)\zlib\win32\zdll.lib diff --git a/win/tcl.m4 b/win/tcl.m4 index e2117d2..ad0cf4f 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -557,7 +557,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_SUFFIX=".dll" # MACHINE is IX86 for LINK, but this is used by the manifest, - # which requires x86|amd64|ia64. + # which requires x86|amd64|arm64|ia64. MACHINE="X86" if test "$GCC" = "yes"; then @@ -582,6 +582,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RANLIB="x86_64-w64-mingw32-ranlib" RC="x86_64-w64-mingw32-windres" ;; + arm64) + CC="arm64-w64-mingw32-${CC}" + LD="arm64-w64-mingw32-ld" + AR="arm64-w64-mingw32-ar" + RANLIB="arm64-w64-mingw32-ranlib" + RC="arm64-w64-mingw32-windres" + ;; *) CC="i686-w64-mingw32-${CC}" LD="i686-w64-mingw32-ld" @@ -642,6 +649,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "$ac_cv_win32" != "yes"; then AC_MSG_ERROR([${CC} cannot produce win32 executables.]) fi + if test "$MACHINE" != "ARM64"; then + extra_cflags="$extra_cflags -DHAVE_CPUID=1" + fi hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" AC_CACHE_CHECK(for working -municode linker flag, -- cgit v0.12