summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--changes.md3
-rw-r--r--doc/clock.n15
-rw-r--r--doc/library.n2
-rw-r--r--doc/msgcat.n11
-rw-r--r--doc/object.n1
-rw-r--r--generic/tclCkalloc.c14
-rw-r--r--generic/tclClock.c2
-rw-r--r--generic/tclCmdAH.c10
-rw-r--r--generic/tclCmdMZ.c33
-rw-r--r--generic/tclCompCmds.c2
-rw-r--r--generic/tclDictObj.c14
-rw-r--r--generic/tclEncoding.c4
-rw-r--r--generic/tclIORTrans.c30
-rw-r--r--generic/tclIOSock.c2
-rw-r--r--generic/tclLink.c30
-rw-r--r--generic/tclListObj.c24
-rw-r--r--generic/tclOO.c2
-rw-r--r--generic/tclPathObj.c72
-rw-r--r--generic/tclResult.c110
-rw-r--r--generic/tclStringObj.c6
-rw-r--r--generic/tclThreadAlloc.c2
-rw-r--r--generic/tclTimer.c36
-rw-r--r--generic/tclTrace.c2
-rw-r--r--generic/tclUtil.c44
-rw-r--r--generic/tclVar.c8
-rw-r--r--generic/tclZipfs.c6
-rw-r--r--tests/clock.test2
-rw-r--r--tests/info.test9
-rw-r--r--tests/zipfs.test3
-rw-r--r--unix/tclUnixPipe.c4
30 files changed, 266 insertions, 237 deletions
diff --git a/changes.md b/changes.md
index 51adf8a..2adbd1e 100644
--- a/changes.md
+++ b/changes.md
@@ -31,7 +31,7 @@ writing Tcl scripts.
- `chan isbinary`
- `coroinject`, `coroprobe`
- `clock add weekdays`
- - `dict getdefault`
+ - `dict getwithdefault`
- `file tempdir`, `file home`, `file tildeexpand`
- `info commandtype`
- `ledit`
@@ -42,6 +42,7 @@ writing Tcl scripts.
- `string insert`, `string is dict`
- `tcl::process`
- `*::build-info`
+ - `readFile`, `writeFile`, `foreachLine`
## New command options
- `regsub ... -command ...`
diff --git a/doc/clock.n b/doc/clock.n
index 8a54e07..12897b2 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -113,7 +113,7 @@ Specifies the desired output format for \fBclock format\fR or the
expected input format for \fBclock scan\fR. The \fIformat\fR string consists
of any number of characters other than the per-cent sign
.PQ \fB%\fR
-interspersed with any number of \fIformat groups\fR, which are two-character
+interspersed with any number of \fIformat groups\fR, which are two- or three-character
sequences beginning with the per-cent sign. The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.RS
@@ -169,6 +169,15 @@ the environment variable \fBTZ\fR.
.IP [3]
on Windows systems, the time zone settings from the Control Panel.
.RE
+.\" OPTION: -validate
+.TP
+\fB\-validate\fR boolean
+.
+If \fIboolean\fR is true, \fBclock scan\fR will raise an error if the
+input contains invalid values, e.g. day of month greater than number
+of days in the month. If specified as false (default), the command
+makes an adjustment to bring values within acceptable range. See
+\fBSCANNING TIMES\fR for details.
.PP
If none of these is present, the C \fBlocaltime\fR and \fBmktime\fR
functions are used to attempt to convert times between local and
@@ -467,7 +476,9 @@ time zone when converting local times. This caveat does not apply to
UTC times.)
.PP
If the interpretation of the groups yields an impossible time because
-a field is out of range, enough of that field's unit will be added to
+a field is out of range, an exception is raised if the \fB-validate\fR
+option is passed as true. If passed as false or not present,
+enough of that field's unit will be added to
or subtracted from the time to bring it in range. Thus, if attempting to
scan or format day 0 of the month, one day will be subtracted from day
1 of the month, yielding the last day of the previous month.
diff --git a/doc/library.n b/doc/library.n
index 0342cbe..5c364bb 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
-auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
+auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, foreachLine, parray, readFile, tcl_findLibrary, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore, writeFile \- standard library of Tcl procedures
.SH SYNOPSIS
.nf
\fBauto_execok \fIcmd\fR
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 9d82688..f486326 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -35,7 +35,7 @@ msgcat \- Tcl message catalog
.VE "TIP 499"
.sp
.VS "TIP 412"
-\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
+\fB::msgcat::mcloadedlocales subcommand\fR
.VE "TIP 412"
.sp
\fB::msgcat::mcload \fIdirname\fR
@@ -239,7 +239,7 @@ configured by:
.PP
.\" COMMAND: mcloadedlocales
.TP
-\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
+\fB::msgcat::mcloadedlocales subcommand\fR
.VS "TIP 499"
This group of commands manage the list of loaded locales for packages not
setting a package locale.
@@ -399,10 +399,9 @@ language[_country][_modifier]
.PP
On Windows and Cygwin, if none of those environment variables is set,
msgcat will attempt to extract locale information from the registry.
-From Windows Vista on, the RFC4747 locale name "lang-script-country-options"
+The RFC4747 locale name "lang-script-country-options"
is transformed to the locale as "lang_country_script" (Example:
-sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is
-transformed analogously (Example: 0c1a -> sr_yu_cyrillic).
+sr-Latn-CS -> sr_cs_latin).
If all these attempts to discover an initial locale from the user's
environment fail, msgcat defaults to an initial locale of
.QW C .
@@ -615,7 +614,7 @@ If a set of locale preferences is given, it is set as package locale preference
list. The package locale is set to the first element of the preference list.
A package locale is activated, if it was not set so far.
.PP
-Locale preferences are loaded now for the package, if not jet loaded.
+Locale preferences are loaded now for the package, if not yet loaded.
.VE "TIP 499"
.RE
.PP
diff --git a/doc/object.n b/doc/object.n
index 7bdbbe2..96f5d39 100644
--- a/doc/object.n
+++ b/doc/object.n
@@ -69,6 +69,7 @@ associated with \fIobj\fR, returning the result of the evaluation.
Note that object-internal commands such as \fBmy\fR and \fBself\fR can be
invoked in this context.
.RE
+.\" METHOD: unknown
.TP
\fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR?
.
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index f0c625f..e0a1224 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -170,7 +170,7 @@ TclDumpMemoryInfo(
char buf[1024];
if (clientData == NULL) {
- return 0;
+ return 0;
}
snprintf(buf, sizeof(buf),
"total mallocs %10" TCL_Z_MODIFIER "u\n"
@@ -826,7 +826,7 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
- TclGetString(objv[2]), Tcl_PosixError(interp)));
+ TclGetString(objv[2]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
@@ -871,8 +871,8 @@ MemoryCmd(
fileP = fopen(fileName, "w");
if (fileP == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot open output file: %s",
- Tcl_PosixError(interp)));
+ "cannot open output file: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
TclDbDumpActiveObjects(fileP);
@@ -936,9 +936,9 @@ MemoryCmd(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad option \"%s\": should be active, break_on_malloc, info, "
- "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
- TclGetString(objv[1])));
+ "bad option \"%s\": should be active, break_on_malloc, info, "
+ "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
+ TclGetString(objv[1])));
return TCL_ERROR;
argError:
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 0b72bf4..3942632 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -3420,7 +3420,7 @@ ClockParseFmtScnArgs(
Tcl_Obj *baseObj = opts->baseObj;
/* bypass integer recognition if looks like "now" or "-now" */
- if ((baseObj->bytes &&
+ if ((baseObj->bytes &&
((baseObj->length == 3 && baseObj->bytes[0] == 'n') ||
(baseObj->length == 4 && baseObj->bytes[1] == 'n')))
|| TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 3a740e5..7a01a58 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -685,7 +685,7 @@ EncodingConvertfromObjCmd(
return TCL_ERROR;
}
result = Tcl_ExternalToUtfDStringEx(interp, encoding, bytesPtr, length, flags,
- &ds, failVarObj ? &errorLocation : NULL);
+ &ds, failVarObj ? &errorLocation : NULL);
/* NOTE: ds must be freed beyond this point even on error */
switch (result) {
case TCL_OK:
@@ -782,7 +782,7 @@ EncodingConverttoObjCmd(
stringPtr = TclGetStringFromObj(data, &length);
result = Tcl_UtfToExternalDStringEx(interp, encoding, stringPtr, length, flags,
- &ds, failVarObj ? &errorLocation : NULL);
+ &ds, failVarObj ? &errorLocation : NULL);
/* NOTE: ds must be freed beyond this point even on error */
switch (result) {
@@ -2480,9 +2480,9 @@ StoreStatData(
TclNewObj(result);
Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue) \
- Tcl_DictObjPut(NULL, result, \
- Tcl_NewStringObj((key), -1), \
- (objValue));
+ Tcl_DictObjPut(NULL, result, \
+ Tcl_NewStringObj((key), -1), \
+ (objValue));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 29e3395..20197aa 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -29,7 +29,7 @@ static Tcl_NRPostProc TryPostFinal;
static Tcl_NRPostProc TryPostHandler;
static int UniCharIsAscii(int character);
static int UniCharIsHexDigit(int character);
-static int StringCmpOpts(Tcl_Interp *interp, int objc,
+static int StringCmpOpts(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int *nocase,
Tcl_Size *reqlength);
@@ -1529,7 +1529,8 @@ StringIsCmd(
{
const char *string1, *end, *stop;
int (*chcomp)(int) = NULL; /* The UniChar comparison function. */
- int i, failat = 0, result = 1, strict = 0, index, length1, length2;
+ int i, result = 1, strict = 0;
+ Tcl_Size failat = 0, length1, length2, index;
Tcl_Obj *objPtr, *failVarObj = NULL;
Tcl_WideInt w;
@@ -1994,7 +1995,8 @@ StringMapCmd(
if (!TclHasStringRep(objv[objc-2])
&& TclHasInternalRep(objv[objc-2], &tclDictType)) {
- int i, done;
+ Tcl_Size i;
+ int done;
Tcl_DictSearch search;
/*
@@ -2245,8 +2247,7 @@ StringMatchCmd(
Tcl_Size length;
const char *string = TclGetStringFromObj(objv[1], &length);
- if ((length > 1) &&
- strncmp(string, "-nocase", length) == 0) {
+ if ((length > 1) && strncmp(string, "-nocase", length) == 0) {
nocase = TCL_MATCH_NOCASE;
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2412,7 +2413,7 @@ StringRplcCmd(
* result is the original string.
*/
- if ((last < 0) || /* Range ends before start of string */
+ if ((last < 0) || /* Range ends before start of string */
(first > end) || /* Range begins after end of string */
(last < first)) { /* Range begins after it starts */
/*
@@ -2663,7 +2664,7 @@ StringEqualCmd(
goto str_cmp_args;
}
i++;
- if (Tcl_GetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+ if (TclGetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
return TCL_ERROR;
}
if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) {
@@ -2766,13 +2767,13 @@ StringCmpOpts(
goto str_cmp_args;
}
i++;
- if (Tcl_GetWideIntFromObj(interp, objv[i], &wreqlength) != TCL_OK) {
+ if (TclGetWideIntFromObj(interp, objv[i], &wreqlength) != TCL_OK) {
return TCL_ERROR;
}
if ((Tcl_WideUInt)wreqlength > TCL_SIZE_MAX) {
- *reqlength = -1;
+ *reqlength = -1;
} else {
- *reqlength = wreqlength;
+ *reqlength = wreqlength;
}
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3184,7 +3185,7 @@ StringTrimCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *string2;
- int triml, trimr, length1, length2;
+ Tcl_Size triml, trimr, length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
@@ -4243,14 +4244,14 @@ Tcl_TimeRateObjCmd(
}
objPtr = objv[i++];
if (i < objc) { /* max-time */
- result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms);
+ result = TclGetWideIntFromObj(interp, objv[i], &maxms);
if (result != TCL_OK) {
return result;
}
- if (i < objc) { /* max-count*/
+ if (++i < objc) { /* max-count*/
Tcl_WideInt v;
- result = Tcl_GetWideIntFromObj(interp, objv[i], &v);
+ result = TclGetWideIntFromObj(interp, objv[i], &v);
if (result != TCL_OK) {
return result;
}
@@ -5005,8 +5006,8 @@ TryPostBody(
continue;
}
for (j=0 ; j<len1 ; j++) {
- if (strcmp(TclGetString(bits1[j]),
- TclGetString(bits2[j])) != 0) {
+ if (TclStringCmp(bits1[j], bits2[j], 1, 0,
+ TCL_INDEX_NONE) != 0) {
/*
* Really want 'continue outerloop;', but C does
* not give us that.
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 1c5f825..c6301f4 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -3367,7 +3367,7 @@ TclLocalScalar(
CompileEnv *envPtr)
{
Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
- {TCL_TOKEN_TEXT, NULL, 0, 0}};
+ {TCL_TOKEN_TEXT, NULL, 0, 0}};
token[1].start = bytes;
token[1].size = numBytes;
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 6059854..eaae6a8 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -151,17 +151,17 @@ const Tcl_ObjType tclDictType = {
#define DictSetInternalRep(objPtr, dictRepPtr) \
do { \
- Tcl_ObjInternalRep ir; \
- ir.twoPtrValue.ptr1 = (dictRepPtr); \
- ir.twoPtrValue.ptr2 = NULL; \
- Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \
+ Tcl_ObjInternalRep ir; \
+ ir.twoPtrValue.ptr1 = (dictRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \
} while (0)
#define DictGetInternalRep(objPtr, dictRepPtr) \
do { \
- const Tcl_ObjInternalRep *irPtr; \
- irPtr = TclFetchInternalRep((objPtr), &tclDictType); \
- (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \
+ const Tcl_ObjInternalRep *irPtr; \
+ irPtr = TclFetchInternalRep((objPtr), &tclDictType); \
+ (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
/*
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index d1096d2..380f3ed 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1272,7 +1272,7 @@ Tcl_ExternalToUtfDStringEx(
Tcl_DString *dstPtr, /* Uninitialized or free DString in which the
* converted string is stored. */
Tcl_Size *errorLocPtr) /* Where to store the error location
- (or TCL_INDEX_NONE if no error). May
+ (or TCL_INDEX_NONE if no error). May
be NULL. */
{
char *dst;
@@ -1562,7 +1562,7 @@ Tcl_UtfToExternalDStringEx(
Tcl_DString *dstPtr, /* Uninitialized or free DString in which the
* converted string is stored. */
Tcl_Size *errorLocPtr) /* Where to store the error location
- (or TCL_INDEX_NONE if no error). May
+ (or TCL_INDEX_NONE if no error). May
be NULL. */
{
char *dst;
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 81345dc..0bc6a50 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -608,9 +608,9 @@ TclChanPushObjCmd(
*/
if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "chan handler \"%s initialize\" returned non-list: %s",
- TclGetString(cmdObj), TclGetString(resObj)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -633,9 +633,9 @@ TclChanPushObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "chan handler \"%s\" does not support all required methods",
- TclGetString(cmdObj)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ TclGetString(cmdObj)));
goto error;
}
@@ -655,9 +655,9 @@ TclChanPushObjCmd(
}
if (!mode) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "chan handler \"%s\" makes the channel inaccessible",
- TclGetString(cmdObj)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ TclGetString(cmdObj)));
goto error;
}
@@ -666,16 +666,16 @@ TclChanPushObjCmd(
*/
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "chan handler \"%s\" supports \"drain\" but not \"read\"",
- TclGetString(cmdObj)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"drain\" but not \"read\"",
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "chan handler \"%s\" supports \"flush\" but not \"write\"",
- TclGetString(cmdObj)));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ TclGetString(cmdObj)));
goto error;
}
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index eaa9cc8..01ec325 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -249,7 +249,7 @@ TclCreateSocketAddress(
(result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
#endif /* EAI_SYSTEM */
gai_strerror(result);
- return 0;
+ return 0;
}
/*
diff --git a/generic/tclLink.c b/generic/tclLink.c
index fc4741b..fd7dd2d 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -323,7 +323,7 @@ Tcl_LinkArray(
/*
* If no address is given create one and use as address the
- * not needed linkPtr->lastValue
+ * not needed linkPtr->lastValue
*/
if (addr == NULL) {
@@ -920,7 +920,7 @@ LinkTraceProc(
if (GetInt(objv[i], varPtr)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have integer values";
+ return (char *) "variable array must have integer values";
}
}
} else {
@@ -988,7 +988,7 @@ LinkTraceProc(
if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have boolean value";
+ return (char *) "variable array must have boolean value";
}
}
} else {
@@ -1007,10 +1007,10 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetInt(objv[i], &valueInt)
- || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
+ || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have char value";
+ return (char *) "variable array must have char value";
}
linkPtr->lastValue.cPtr[i] = (char) valueInt;
}
@@ -1029,7 +1029,7 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetInt(objv[i], &valueInt)
- || !InRange(0, valueInt, (int)UCHAR_MAX)) {
+ || !InRange(0, valueInt, (int)UCHAR_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *)
@@ -1056,7 +1056,7 @@ LinkTraceProc(
|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have short value";
+ return (char *) "variable array must have short value";
}
linkPtr->lastValue.sPtr[i] = (short) valueInt;
}
@@ -1075,10 +1075,10 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetInt(objv[i], &valueInt)
- || !InRange(0, valueInt, (int)USHRT_MAX)) {
+ || !InRange(0, valueInt, (int)USHRT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *)
+ return (char *)
"variable array must have unsigned short value";
}
linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
@@ -1102,7 +1102,7 @@ LinkTraceProc(
|| !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *)
+ return (char *)
"variable array must have unsigned int value";
}
linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
@@ -1127,7 +1127,7 @@ LinkTraceProc(
|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have long value";
+ return (char *) "variable array must have long value";
}
linkPtr->lastValue.lPtr[i] = (long) valueWide;
}
@@ -1149,7 +1149,7 @@ LinkTraceProc(
|| (valueUWide > ULONG_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *)
+ return (char *)
"variable array must have unsigned long value";
}
linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide;
@@ -1173,7 +1173,7 @@ LinkTraceProc(
if (GetUWide(objv[i], &valueUWide)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *)
+ return (char *)
"variable array must have unsigned wide int value";
}
linkPtr->lastValue.uwPtr[i] = valueUWide;
@@ -1193,10 +1193,10 @@ LinkTraceProc(
for (i=0; i < objc; i++) {
if (GetDouble(objv[i], &valueDouble)
&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
- && !IsSpecial(valueDouble)) {
+ && !IsSpecial(valueDouble)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
- return (char *) "variable array must have float value";
+ return (char *) "variable array must have float value";
}
linkPtr->lastValue.fPtr[i] = (float) valueDouble;
}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 228a18a..89e72b6 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2933,11 +2933,11 @@ TclLsetFlat(
}
indexArray++;
- /*
- * Special case 0-length lists. The Tcl indexing function treat
- * will return any value beyond length as TCL_SIZE_MAX for this
- * case.
- */
+ /*
+ * Special case 0-length lists. The Tcl indexing function treat
+ * will return any value beyond length as TCL_SIZE_MAX for this
+ * case.
+ */
if ((index == TCL_SIZE_MAX) && (elemCount == 0)) {
index = 0;
}
@@ -2946,14 +2946,14 @@ TclLsetFlat(
/* ...the index points outside the sublist. */
if (interp != NULL) {
Tcl_SetObjResult(interp,
- Tcl_ObjPrintf("index \"%s\" out of range",
- TclGetString(indexArray[-1])));
+ Tcl_ObjPrintf("index \"%s\" out of range",
+ TclGetString(indexArray[-1])));
Tcl_SetErrorCode(interp,
- "TCL",
- "VALUE",
- "INDEX"
- "OUTOFRANGE",
- (char *)NULL);
+ "TCL",
+ "VALUE",
+ "INDEX"
+ "OUTOFRANGE",
+ (char *)NULL);
}
result = TCL_ERROR;
break;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9df5338..46d81c9 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -751,7 +751,7 @@ AllocObject(
TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
- MyClassDeleted);
+ MyClassDeleted);
return oPtr;
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index ec70add..258c288 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -2377,10 +2377,10 @@ SetFsPathFromAny(
if (transPtr == pathPtr) {
(void)TclGetString(pathPtr);
TclFreeInternalRep(pathPtr);
- transPtr = Tcl_DuplicateObj(pathPtr);
- fsPathPtr->filesystemEpoch = 0;
+ transPtr = Tcl_DuplicateObj(pathPtr);
+ fsPathPtr->filesystemEpoch = 0;
} else {
- fsPathPtr->filesystemEpoch = TclFSEpoch();
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
}
Tcl_IncrRefCount(transPtr);
fsPathPtr->translatedPathPtr = transPtr;
@@ -2612,7 +2612,7 @@ MakeTildeRelativePath(
const char *user, /* User name. NULL -> current user */
const char *subPath, /* Rest of path. May be NULL */
Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be
- freed on success */
+ freed on success */
{
const char *dir;
Tcl_DString dirString;
@@ -2621,30 +2621,30 @@ MakeTildeRelativePath(
Tcl_DStringInit(&dirString);
if (user == NULL || user[0] == 0) {
- /* No user name specified -> current user */
+ /* No user name specified -> current user */
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "couldn't find HOME environment variable to"
- " expand path", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
- "HOMELESS", (char *)NULL);
- }
- return TCL_ERROR;
- }
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find HOME environment variable to"
+ " expand path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
+ "HOMELESS", (char *)NULL);
+ }
+ return TCL_ERROR;
+ }
} else {
- /* User name specified - ~user */
+ /* User name specified - ~user */
dir = TclpGetUserHome(user, &dirString);
if (dir == NULL) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "user \"%s\" doesn't exist", user));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
- (char *)NULL);
- }
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", user));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
+ (char *)NULL);
+ }
+ return TCL_ERROR;
}
}
if (subPath) {
@@ -2730,20 +2730,20 @@ TclResolveTildePath(
split = FindSplitPos(path, '/');
if (split == 1) {
- /* No user name specified -> current user */
+ /* No user name specified -> current user */
if (MakeTildeRelativePath(
interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath)
!= TCL_OK) {
return NULL;
}
} else {
- /* User name specified - ~user */
- const char *expandedUser;
- Tcl_DString userName;
+ /* User name specified - ~user */
+ const char *expandedUser;
+ Tcl_DString userName;
- Tcl_DStringInit(&userName);
- Tcl_DStringAppend(&userName, path+1, split-1);
- expandedUser = Tcl_DStringValue(&userName);
+ Tcl_DStringInit(&userName);
+ Tcl_DStringAppend(&userName, path+1, split-1);
+ expandedUser = Tcl_DStringValue(&userName);
/* path[split] is / or \0 */
if (MakeTildeRelativePath(interp,
@@ -2795,29 +2795,29 @@ TclResolveTildePathList(
const char *path;
if (pathsObj == NULL) {
- return NULL;
+ return NULL;
}
if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) {
- return NULL; /* Not a list */
+ return NULL; /* Not a list */
}
/*
* Figure out if any paths need resolving to avoid unnecessary allocations.
*/
for (i = 0; i < objc; ++i) {
- path = TclGetString(objv[i]);
- if (path[0] == '~') {
- break; /* At least one path needs resolution */
- }
+ path = TclGetString(objv[i]);
+ if (path[0] == '~') {
+ break; /* At least one path needs resolution */
+ }
}
if (i == objc) {
- return pathsObj; /* No paths needed to be resolved */
+ return pathsObj; /* No paths needed to be resolved */
}
resolvedPaths = Tcl_NewListObj(objc, NULL);
for (i = 0; i < objc; ++i) {
Tcl_Obj *resolvedPath;
- path = TclGetString(objv[i]);
+ path = TclGetString(objv[i]);
if (path[0] == 0) {
continue; /* Skip empty strings */
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 5497622..ece2634 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -387,9 +387,9 @@ Tcl_DiscardResult(
if (statePtr->result == statePtr->appendResult) {
ckfree(statePtr->appendResult);
} else if (statePtr->freeProc == TCL_DYNAMIC) {
- ckfree(statePtr->result);
+ ckfree(statePtr->result);
} else if (statePtr->freeProc) {
- statePtr->freeProc(statePtr->result);
+ statePtr->freeProc(statePtr->result);
}
}
@@ -1299,7 +1299,7 @@ TclProcessReturn(
iPtr->errorInfo = NULL;
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
- &valuePtr);
+ &valuePtr);
if (valuePtr != NULL) {
(void) TclGetString(valuePtr);
if (valuePtr->length) {
@@ -1309,41 +1309,41 @@ TclProcessReturn(
}
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
- &valuePtr);
+ &valuePtr);
if (valuePtr != NULL) {
- int len, valueObjc;
- Tcl_Obj **valueObjv;
-
- if (Tcl_IsShared(iPtr->errorStack)) {
- Tcl_Obj *newObj;
-
- newObj = Tcl_DuplicateObj(iPtr->errorStack);
- Tcl_DecrRefCount(iPtr->errorStack);
- Tcl_IncrRefCount(newObj);
- iPtr->errorStack = newObj;
- }
-
- /*
- * List extraction done after duplication to avoid moving the rug
- * if someone does [return -errorstack [info errorstack]]
- */
-
- if (TclListObjGetElements(interp, valuePtr, &valueObjc,
- &valueObjv) == TCL_ERROR) {
- return TCL_ERROR;
- }
- iPtr->resetErrorStack = 0;
- TclListObjLength(interp, iPtr->errorStack, &len);
-
- /*
- * Reset while keeping the list internalrep as much as possible.
- */
-
- Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
- valueObjv);
+ int len, valueObjc;
+ Tcl_Obj **valueObjv;
+
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
+ }
+
+ /*
+ * List extraction done after duplication to avoid moving the rug
+ * if someone does [return -errorstack [info errorstack]]
+ */
+
+ if (TclListObjGetElements(interp, valuePtr, &valueObjc,
+ &valueObjv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ iPtr->resetErrorStack = 0;
+ TclListObjLength(interp, iPtr->errorStack, &len);
+
+ /*
+ * Reset while keeping the list internalrep as much as possible.
+ */
+
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
+ valueObjv);
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
- &valuePtr);
+ &valuePtr);
if (valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
} else {
@@ -1351,7 +1351,7 @@ TclProcessReturn(
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
- &valuePtr);
+ &valuePtr);
if (valuePtr != NULL) {
TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
}
@@ -1424,8 +1424,8 @@ TclMergeReturnOptions(
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad %s value: expected dictionary but got \"%s\"",
- compare, TclGetString(objv[1])));
+ "bad %s value: expected dictionary but got \"%s\"",
+ compare, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
(char *)NULL);
goto error;
@@ -1455,7 +1455,7 @@ TclMergeReturnOptions(
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
if (valuePtr != NULL) {
if (TclGetCompletionCodeFromObj(interp, valuePtr,
- &code) == TCL_ERROR) {
+ &code) == TCL_ERROR) {
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
@@ -1474,8 +1474,8 @@ TclMergeReturnOptions(
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad -level value: expected non-negative integer but got"
- " \"%s\"", TclGetString(valuePtr)));
+ "bad -level value: expected non-negative integer but got"
+ " \"%s\"", TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (char *)NULL);
goto error;
}
@@ -1496,8 +1496,8 @@ TclMergeReturnOptions(
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad -errorcode value: expected a list but got \"%s\"",
- TclGetString(valuePtr)));
+ "bad -errorcode value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
(char *)NULL);
goto error;
@@ -1518,24 +1518,24 @@ TclMergeReturnOptions(
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad -errorstack value: expected a list but got \"%s\"",
- TclGetString(valuePtr)));
+ "bad -errorstack value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
- (char *)NULL);
+ (char *)NULL);
goto error;
}
- if (length % 2) {
- /*
- * Errorstack must always be an even-sized list
- */
+ if (length % 2) {
+ /*
+ * Errorstack must always be an even-sized list
+ */
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "forbidden odd-sized list for -errorstack: \"%s\"",
+ "forbidden odd-sized list for -errorstack: \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT",
- "ODDSIZEDLIST_ERRORSTACK", (char *)NULL);
+ "ODDSIZEDLIST_ERRORSTACK", (char *)NULL);
goto error;
- }
+ }
}
/*
@@ -1615,7 +1615,7 @@ Tcl_GetReturnOptions(
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "");
- Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
+ Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
}
if (iPtr->errorCode) {
Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
@@ -1685,7 +1685,7 @@ Tcl_SetReturnOptions(
if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
|| (objc % 2)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected dict but got \"%s\"", TclGetString(options)));
+ "expected dict but got \"%s\"", TclGetString(options)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (char *)NULL);
code = TCL_ERROR;
} else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index b4da1a9..ebdae0e 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2896,12 +2896,18 @@ Tcl_AppendFormatToObj(
TclNewObj(segment);
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
+ if (allocSegment) {
+ Tcl_DecrRefCount(segment);
+ }
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
bytes = TclGetString(segment);
if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, segment->length, spec, d))) {
+ if (allocSegment) {
+ Tcl_DecrRefCount(segment);
+ }
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index df4d2e3..26680d4 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -214,7 +214,7 @@ GetCache(void)
if (cachePtr == NULL) {
Tcl_Panic("alloc: could not allocate new cache");
}
- memset(cachePtr, 0, sizeof(Cache));
+ memset(cachePtr, 0, sizeof(Cache));
Tcl_MutexLock(listLockPtr);
cachePtr->nextPtr = firstCachePtr;
firstCachePtr = cachePtr;
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index d921854..3609d95 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -820,13 +820,13 @@ Tcl_AfterObjCmd(
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
!= TCL_OK) {
- const char *arg = TclGetString(objv[1]);
+ const char *arg = TclGetString(objv[1]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad argument \"%s\": must be"
- " cancel, idle, info, or an integer", arg));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
- arg, (char *)NULL);
+ "bad argument \"%s\": must be"
+ " cancel, idle, info, or an integer", arg));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
+ arg, (char *)NULL);
return TCL_ERROR;
}
}
@@ -952,7 +952,7 @@ Tcl_AfterObjCmd(
"after#%d", afterPtr->id));
}
}
- Tcl_SetObjResult(interp, resultObj);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (objc != 3) {
@@ -961,11 +961,11 @@ Tcl_AfterObjCmd(
}
afterPtr = GetAfterEvent(assocPtr, objv[2]);
if (afterPtr == NULL) {
- const char *eventStr = TclGetString(objv[2]);
+ const char *eventStr = TclGetString(objv[2]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "event \"%s\" doesn't exist", eventStr));
- Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (char *)NULL);
+ "event \"%s\" doesn't exist", eventStr));
+ Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (char *)NULL);
return TCL_ERROR;
} else {
Tcl_Obj *resultListPtr;
@@ -975,7 +975,7 @@ Tcl_AfterObjCmd(
afterPtr->commandPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
(afterPtr->token == NULL) ? "idle" : "timer", -1));
- Tcl_SetObjResult(interp, resultListPtr);
+ Tcl_SetObjResult(interp, resultListPtr);
}
break;
default:
@@ -1043,17 +1043,17 @@ AfterDelay(
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
- if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
- diff = 1;
- }
+ if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
+ diff = 1;
+ }
if (diff > 0) {
Tcl_Sleep((long) diff);
- if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
- break;
- }
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
+ break;
+ }
} else {
- break;
- }
+ break;
+ }
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 733685a..f169de6 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1276,7 +1276,7 @@ Tcl_UntraceCommand(
cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
- /*
+ /*
* Bug 3484621: up the interp's epoch if this is a BC'ed command
*/
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0119243..4571baf 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3510,10 +3510,10 @@ TclNeedSpace(
end = Tcl_UtfPrev(end, start);
while (*end == '{') {
- if (end == start) {
- return 0;
- }
- end = Tcl_UtfPrev(end, start);
+ if (end == start) {
+ return 0;
+ }
+ end = Tcl_UtfPrev(end, start);
}
*
@@ -3522,7 +3522,7 @@ TclNeedSpace(
while ((--end >= start) && (*end == '{')) {
}
if (end < start) {
- return 0;
+ return 0;
}
/*
@@ -3644,9 +3644,9 @@ GetWideForIndex(
Tcl_Obj *objPtr, /* Points to the value to be parsed */
Tcl_WideInt endValue, /* The value to be stored at *widePtr if
* objPtr holds "end".
- * NOTE: this value may be TCL_INDEX_NONE. */
+ * NOTE: this value may be TCL_INDEX_NONE. */
Tcl_WideInt *widePtr) /* Location filled in with a wide integer
- * representing an index. */
+ * representing an index. */
{
int numType;
void *cd;
@@ -3771,9 +3771,9 @@ GetEndOffsetFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr, /* Pointer to the object to parse */
Tcl_WideInt endValue, /* The value to be stored at "widePtr" if
- * "objPtr" holds "end". */
+ * "objPtr" holds "end". */
Tcl_WideInt *widePtr) /* Location filled in with an integer
- * representing an index. */
+ * representing an index. */
{
Tcl_ObjInternalRep *irPtr;
Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */
@@ -3807,14 +3807,14 @@ GetEndOffsetFromObj(
if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1)
/* If it's possible, do the full list parse. */
- && (TCL_OK == TclListObjLength(NULL, objPtr, &length))
- && (length > 1)) {
- goto parseError;
+ && (TCL_OK == TclListObjLength(NULL, objPtr, &length))
+ && (length > 1)) {
+ goto parseError;
}
/* Passed the list screen, so parse for index arithmetic expression */
if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr,
- TCL_PARSE_INTEGER_ONLY)) {
+ TCL_PARSE_INTEGER_ONLY)) {
Tcl_WideInt w1=0, w2=0;
/* value starts with valid integer... */
@@ -3987,15 +3987,15 @@ GetEndOffsetFromObj(
/* Report a parse error. */
parseError:
if (interp != NULL) {
- char * bytes = TclGetString(objPtr);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad index \"%s\": must be integer?[+-]integer? or"
- " end?[+-]integer?", bytes));
- if (!strncmp(bytes, "end-", 4)) {
- bytes += 4;
- }
- TclCheckBadOctal(interp, bytes);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
+ char * bytes = TclGetString(objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
+ if (!strncmp(bytes, "end-", 4)) {
+ bytes += 4;
+ }
+ TclCheckBadOctal(interp, bytes);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
}
return TCL_ERROR;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 8deb2b7..d2922ec 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -6869,13 +6869,13 @@ SetArrayDefault(
*/
if (tablePtr->defaultObj) {
- Tcl_DecrRefCount(tablePtr->defaultObj);
- Tcl_DecrRefCount(tablePtr->defaultObj);
+ Tcl_DecrRefCount(tablePtr->defaultObj);
+ Tcl_DecrRefCount(tablePtr->defaultObj);
}
tablePtr->defaultObj = defaultObj;
if (tablePtr->defaultObj) {
- Tcl_IncrRefCount(tablePtr->defaultObj);
- Tcl_IncrRefCount(tablePtr->defaultObj);
+ Tcl_IncrRefCount(tablePtr->defaultObj);
+ Tcl_IncrRefCount(tablePtr->defaultObj);
}
}
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 2eb90a5..c288b3f 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -1675,7 +1675,7 @@ ZipFSOpenArchive(
ZIPFS_POSIX_ERROR(interp, "seek error");
goto error;
}
- /* What's the magic about 64 * 1024 * 1024 ? */
+ /* What's the magic about 64 * 1024 * 1024 ? */
if ((zf->length <= ZIP_CENTRAL_END_LEN) ||
(zf->length - ZIP_CENTRAL_END_LEN) >
(64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
@@ -6238,8 +6238,8 @@ TclZipfs_Init(
"proc ::tcl::zipfs::Find dir {\n"
" set result {}\n"
" if {[catch {\n"
- " concat [glob -directory $dir -nocomplain *] [glob -directory $dir -types hidden -nocomplain *]\n"
- " } list]} {\n"
+ " concat [glob -directory $dir -nocomplain *] [glob -directory $dir -types hidden -nocomplain *]\n"
+ " } list]} {\n"
" return $result\n"
" }\n"
" foreach file $list {\n"
diff --git a/tests/clock.test b/tests/clock.test
index 1b70c04..76155b5 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -37265,7 +37265,7 @@ test clock-46.16-pos-fmt2 {scan with format: validation rules: valid day of week
0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 0 947246400 \
0 946641600 0 946728000 0 946814400 0 946900800 0 946987200 0 947073600 0 947160000 \
]
-test clock-46.16-pos-fmt2 {scan with format: validation rules: valid day of week (must work for all weekdays)} \
+test clock-46.16-pos-fmt3 {scan with format: validation rules: valid day of week (must work for all weekdays)} \
-body {
_invalid_test {:GMT -12:00 +12:00} {-format "%w, %d %b %Y %H:%M:%S"} {6, 01 Jan 2000 00:00:00} {0, 02 Jan 2000 00:00:00} {1, 03 Jan 2000 00:00:00} {2, 04 Jan 2000 00:00:00} {3, 05 Jan 2000 00:00:00} {4, 06 Jan 2000 00:00:00} {5, 07 Jan 2000 00:00:00}
} -result [list \
diff --git a/tests/info.test b/tests/info.test
index e08d6d9..19978b0 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2619,6 +2619,15 @@ test info-41.0 {Bug 0de6c1d79c crash} -setup {
unset -nocomplain msg
} -result {1 {type precompiled} {type precompiled} 1 {bad level "-1"} 1 {bad level "2"}}
+test info-41.1 {Bug 0de6c1d79c crash} -setup {
+ interp create child
+ child hide info
+} -cleanup {
+ interp delete child
+} -body {
+ child invokehidden info frame
+} -result 1
+
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 9571d36..b988898 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -1945,11 +1945,12 @@ namespace eval test_ns_zipfs {
set basename bug-7d5f1c1308
set mt //zipfs:/$basename-mt
set zipfile $basename.zip
- set dir [tcltest::makeDirectory $basename]
+ set dir [makeDirectory $basename]
close [open [file join $dir .ext] w]
} -cleanup {
zipfs unmount $mt
file delete $zipfile
+ removeDirectory $basename
} -body {
zipfs mkzip $zipfile $dir [file dirname $dir]
zipfs mount $zipfile $mt
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index be1d422..e3311a3 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -419,8 +419,8 @@ TclpCreateProcess(
TclFile errPipeIn, errPipeOut;
int count, status, fd;
char errSpace[200 + TCL_INTEGER_SPACE];
- Tcl_DString *dsArray;
- char **newArgv;
+ Tcl_DString *volatile dsArray;
+ char **volatile newArgv;
int pid;
int i;
#if defined(HAVE_POSIX_SPAWNP)
generated by cgit v0.12 at 2024-09-28 05:29:37 (GMT)