From 76718af2027a541a834a6979b532a1daf4c900cf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Aug 2024 22:44:50 +0000 Subject: Missed some backports from 9.0. Some indenting --- changes.md | 3 +- doc/clock.n | 15 ++++++- doc/library.n | 2 +- doc/msgcat.n | 11 +++-- doc/object.n | 1 + generic/tclCkalloc.c | 14 +++--- generic/tclClock.c | 2 +- generic/tclCmdAH.c | 10 ++--- generic/tclCmdMZ.c | 33 +++++++------- generic/tclCompCmds.c | 2 +- generic/tclDictObj.c | 14 +++--- generic/tclEncoding.c | 4 +- generic/tclIORTrans.c | 30 ++++++------- generic/tclIOSock.c | 2 +- generic/tclLink.c | 30 ++++++------- generic/tclListObj.c | 24 +++++------ generic/tclOO.c | 2 +- generic/tclPathObj.c | 72 +++++++++++++++---------------- generic/tclResult.c | 110 +++++++++++++++++++++++------------------------ generic/tclStringObj.c | 6 +++ generic/tclThreadAlloc.c | 2 +- generic/tclTimer.c | 36 ++++++++-------- generic/tclTrace.c | 2 +- generic/tclUtil.c | 44 +++++++++---------- generic/tclVar.c | 8 ++-- generic/tclZipfs.c | 6 +-- tests/clock.test | 2 +- tests/info.test | 9 ++++ tests/zipfs.test | 3 +- unix/tclUnixPipe.c | 4 +- 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 ; jtwoPtrValue.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) -- cgit v0.12