From f218c1f1ebf34e6f5820d88789b16104c954a071 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 May 2019 07:19:10 +0000 Subject: =?UTF-8?q?(cherry-pick=20from8.6):=20Japanese=20Reiwa=20(?= =?UTF-8?q?=E4=BB=A4=E5=92=8C)=20era?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- library/msgs/ja.msg | 2 +- tests/clock.test | 22 ++++++++++++---------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg index 2767665..cf70c2f 100644 --- a/library/msgs/ja.msg +++ b/library/msgs/ja.msg @@ -40,5 +40,5 @@ namespace eval ::tcl::clock { ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5" ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2" ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z" - ::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3061011600 \u660e\u6cbb 1867\u007d \u007b-1812186000 \u5927\u6b63 1911\u007d \u007b-1357635600 \u662d\u548c 1925\u007d \u007b600220800 \u5e73\u6210 1988\u007d" + ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 \u897f\u66a6 0} {-3061011600 \u660e\u6cbb 1867} {-1812186000 \u5927\u6b63 1911} {-1357635600 \u662d\u548c 1925} {600220800 \u5e73\u6210 1988} {1556668800 \u4ee4\u548c 2018}" } diff --git a/tests/clock.test b/tests/clock.test index a697714..f6cba28 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36699,16 +36699,18 @@ test clock-58.1 {clock l10n - Japanese localisation} {*}{ } -body { set trouble {} - foreach {date jdate} [list \ - 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 \ - 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 \ - 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 \ - 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 \ - 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 \ - 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 \ - 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 \ - 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 \ - ] { + foreach {date jdate} { + 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 + 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 + 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 + 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 + 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 + 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 + 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 + 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 + 2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5 + 2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5 + } { set status [catch { set secs [clock scan $date \ -timezone +0900 \ -- cgit v0.12 From 9d68b2dbd19c376370345b938be80f15aab880d4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 May 2019 06:53:00 +0000 Subject: Make more clear that TCL_INDEX_END|TCL_INDEX_NONE not necessary are int's (in Tcl 9 they are not). Eliminate use of (local) list_index_t type --- generic/tclCmdIL.c | 40 +++++++++++++++++++--------------------- generic/tclCompCmdsGR.c | 48 ++++++++++++++++++++++++------------------------ generic/tclCompCmdsSZ.c | 36 ++++++++++++++++++------------------ generic/tclIORChan.c | 8 ++++---- generic/tclInt.h | 2 +- 5 files changed, 66 insertions(+), 68 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index ef7a42c..c11534e 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); * The following structure is used to pass this information. */ -typedef struct SortInfo { +typedef struct { int isIncreasing; /* Nonzero means sort in increasing order. */ int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ @@ -566,7 +566,7 @@ InfoBodyCmd( * the object do not invalidate the internal rep. */ - bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes); + bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes); Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes)); return TCL_OK; } @@ -1047,7 +1047,7 @@ InfoErrorStackCmd( target = interp; if (objc == 2) { - target = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); + target = Tcl_GetSlave(interp, TclGetString(objv[1])); if (target == NULL) { return TCL_ERROR; } @@ -2155,7 +2155,7 @@ InfoCmdTypeCmd( Tcl_WrongNumArgs(interp, 1, objv, "commandName"); return TCL_ERROR; } - command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL, + command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL, TCL_LEAVE_ERR_MSG); if (command == NULL) { return TCL_ERROR; @@ -2231,7 +2231,7 @@ Tcl_JoinObjCmd( joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); - (void) Tcl_GetStringFromObj(joinObjPtr, &length); + (void) TclGetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { @@ -2721,15 +2721,13 @@ Tcl_LrangeObjCmd( *---------------------------------------------------------------------- */ -typedef int list_index_t; - static int LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { - list_index_t idx1 = *((const list_index_t *) el1Ptr); - list_index_t idx2 = *((const list_index_t *) el2Ptr); + int idx1 = *((const int *) el1Ptr); + int idx2 = *((const int *) el2Ptr); /* * This will put the larger element first. @@ -2746,7 +2744,7 @@ Tcl_LremoveObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int i, idxc; - list_index_t listLen, *idxv, prevIdx, first, num; + int listLen, *idxv, prevIdx, first, num; Tcl_Obj *listObj; /* @@ -2768,7 +2766,7 @@ Tcl_LremoveObjCmd( Tcl_SetObjResult(interp, listObj); return TCL_OK; } - idxv = ckalloc((objc - 2) * sizeof(list_index_t)); + idxv = ckalloc((objc - 2) * sizeof(int)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { @@ -2783,7 +2781,7 @@ Tcl_LremoveObjCmd( */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(list_index_t), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(int), LremoveIndexCompare); } /* @@ -2796,7 +2794,7 @@ Tcl_LremoveObjCmd( num = 0; first = listLen; for (i = 0, prevIdx = -1 ; i < idxc ; i++) { - list_index_t idx = idxv[i]; + int idx = idxv[i]; /* * Repeated index and sanity check. @@ -3003,7 +3001,7 @@ Tcl_LreplaceObjCmd( return result; } - if (first < 0) { + if (first == TCL_INDEX_NONE) { first = 0; } if (first > listLen) { @@ -3382,10 +3380,10 @@ Tcl_LsearchObjCmd( TCL_INDEX_NONE, &encoded) != TCL_OK) { result = TCL_ERROR; } - if (encoded == TCL_INDEX_NONE) { + if (encoded == (int)TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" cannot select an element " - "from any list", Tcl_GetString(indices[j]))); + "from any list", TclGetString(indices[j]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", NULL); result = TCL_ERROR; @@ -3515,8 +3513,8 @@ Tcl_LsearchObjCmd( if (result != TCL_OK) { goto done; } - if (start < 0) { - start = 0; + if (start == TCL_INDEX_NONE) { + start = TCL_INDEX_START; } /* @@ -4099,10 +4097,10 @@ Tcl_LsortObjCmd( int result = TclIndexEncode(interp, indexv[j], TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded); - if ((result == TCL_OK) && (encoded == TCL_INDEX_NONE)) { + if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" cannot select an element " - "from any list", Tcl_GetString(indexv[j]))); + "from any list", TclGetString(indexv[j]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", NULL); result = TCL_ERROR; @@ -4859,7 +4857,7 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - if (index == TCL_INDEX_NONE) { + if (index == (int)TCL_INDEX_NONE) { index = TCL_INDEX_END - infoPtr->indexv[i]; Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element end-%d missing from sublist \"%s\"", diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 441611e..a8a85f8 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -433,7 +433,7 @@ TclCompileIfCmd( jumpFalseDist += 3; TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); } else { - Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); + Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", opCode); } } } @@ -606,7 +606,7 @@ TclCompileInfoCommandsCmd( if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { goto notCompilable; } - bytes = Tcl_GetString(objPtr); + bytes = TclGetString(objPtr); /* * We require that the argument start with "::" and not have any of "*\[?" @@ -1038,7 +1038,7 @@ TclCompileLassignCmd( */ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); return TCL_OK; } @@ -1243,7 +1243,7 @@ TclCompileListCmd( if (concat && numWords == 2) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); } return TCL_OK; } @@ -1319,7 +1319,7 @@ TclCompileLrangeCmd( tokenPtr = TokenAfter(listTokenPtr); if ((TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE, - &idx1) != TCL_OK) || (idx1 == TCL_INDEX_NONE)) { + &idx1) != TCL_OK) || (idx1 == (int)TCL_INDEX_NONE)) { return TCL_ERROR; } /* @@ -1408,7 +1408,7 @@ TclCompileLinsertCmd( CompileWord(envPtr, listTokenPtr, interp, 1); if (parsePtr->numWords == 3) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); return TCL_OK; } @@ -1418,10 +1418,10 @@ TclCompileLinsertCmd( } TclEmitInstInt4( INST_LIST, i - 3, envPtr); - if (idx == TCL_INDEX_START) { + if (idx == (int)TCL_INDEX_START) { TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); - } else if (idx == TCL_INDEX_END) { + } else if (idx == (int)TCL_INDEX_END) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { /* @@ -1436,7 +1436,7 @@ TclCompileLinsertCmd( * differ in their interpretation of the "end" index. */ - if (idx < TCL_INDEX_END) { + if (idx < (int)TCL_INDEX_END) { idx++; } TclEmitInstInt4( INST_OVER, 1, envPtr); @@ -1444,7 +1444,7 @@ TclCompileLinsertCmd( TclEmitInt4( idx - 1, envPtr); TclEmitInstInt4( INST_REVERSE, 3, envPtr); TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); TclEmitOpcode( INST_LIST_CONCAT, envPtr); } @@ -1505,14 +1505,14 @@ TclCompileLreplaceCmd( * we must defer to direct evaluation. */ - if (idx1 == TCL_INDEX_NONE) { - suffixStart = TCL_INDEX_NONE; - } else if (idx2 == TCL_INDEX_NONE) { + if (idx1 == (int)TCL_INDEX_NONE) { + suffixStart = (int)TCL_INDEX_NONE; + } else if (idx2 == (int)TCL_INDEX_NONE) { suffixStart = idx1; - } else if (idx2 == TCL_INDEX_END) { - suffixStart = TCL_INDEX_NONE; - } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END)) - || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) { + } else if (idx2 == (int)TCL_INDEX_END) { + suffixStart = (int)TCL_INDEX_NONE; + } else if (((idx2 < (int)TCL_INDEX_END) && (idx1 <= (int)TCL_INDEX_END)) + || ((idx2 >= (int)TCL_INDEX_START) && (idx1 >= (int)TCL_INDEX_START))) { suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1; } else { return TCL_ERROR; @@ -1546,11 +1546,11 @@ TclCompileLreplaceCmd( * and canonicalization side effects. */ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); return TCL_OK; } - if (idx1 != TCL_INDEX_START) { + if (idx1 != (int)TCL_INDEX_START) { /* Prefix may not be empty; generate bytecode to push it */ if (emptyPrefix) { TclEmitOpcode( INST_DUP, envPtr); @@ -1570,7 +1570,7 @@ TclCompileLreplaceCmd( TclEmitInstInt4( INST_REVERSE, 2, envPtr); } - if (suffixStart == TCL_INDEX_NONE) { + if (suffixStart == (int)TCL_INDEX_NONE) { TclEmitOpcode( INST_POP, envPtr); if (emptyPrefix) { PushStringLiteral(envPtr, ""); @@ -1578,7 +1578,7 @@ TclCompileLreplaceCmd( } else { /* Suffix may not be empty; generate bytecode to push it */ TclEmitInstInt4( INST_LIST_RANGE_IMM, suffixStart, envPtr); - TclEmitInt4( TCL_INDEX_END, envPtr); + TclEmitInt4( (int)TCL_INDEX_END, envPtr); if (!emptyPrefix) { TclEmitOpcode( INST_LIST_CONCAT, envPtr); } @@ -2295,8 +2295,8 @@ TclCompileRegsubCmd( if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } - if (Tcl_GetString(patternObj)[0] == '-') { - if (strcmp(Tcl_GetString(patternObj), "--") != 0 + if (TclGetString(patternObj)[0] == '-') { + if (strcmp(TclGetString(patternObj), "--") != 0 || parsePtr->numWords == 5) { goto done; } @@ -2361,7 +2361,7 @@ TclCompileRegsubCmd( bytes++; } isSimpleGlob: - for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) { + for (bytes = TclGetString(replacementObj); *bytes; bytes++) { switch (*bytes) { case '\\': case '&': goto done; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 4663fac..83ade0b 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -482,16 +482,16 @@ TclCompileStringInsertCmd( tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 3); - if (idx == TCL_INDEX_START) { + if (idx == (int)TCL_INDEX_START) { /* Prepend the insertion string */ OP4( REVERSE, 2); OP1( STR_CONCAT1, 2); - } else if (idx == TCL_INDEX_END) { + } else if (idx == (int)TCL_INDEX_END) { /* Append the insertion string */ OP1( STR_CONCAT1, 2); } else { /* Prefix + insertion + suffix */ - if (idx < TCL_INDEX_END) { + if (idx < (int)TCL_INDEX_END) { /* See comments in compiler for [linsert]. */ idx++; } @@ -821,7 +821,7 @@ TclCompileStringMatchCmd( } str = tokenPtr[1].start; length = tokenPtr[1].size; - if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) { + if ((length <= 1) || strncmp(str, "-nocase", length)) { /* * Fail at run time, not in compilation. */ @@ -1012,7 +1012,7 @@ TclCompileStringRangeCmd( * the string the same as the start of the string. */ - if (idx1 == TCL_INDEX_NONE) { + if (idx1 == (int)TCL_INDEX_NONE) { /* [string range $s end+1 $last] must be empty string */ OP( POP); PUSH( ""); @@ -1027,7 +1027,7 @@ TclCompileStringRangeCmd( * Token parsed as an index expression. We treat all indices after * the string the same as the end of the string. */ - if (idx2 == TCL_INDEX_NONE) { + if (idx2 == (int)TCL_INDEX_NONE) { /* [string range $s $first -1] must be empty string */ OP( POP); PUSH( ""); @@ -1105,8 +1105,8 @@ TclCompileStringReplaceCmd( * compile direct to bytecode implementing the no-op. */ - if ((last == TCL_INDEX_NONE) /* Know (last < 0) */ - || (first == TCL_INDEX_NONE) /* Know (first > end) */ + if ((last == (int)TCL_INDEX_NONE) /* Know (last < 0) */ + || (first == (int)TCL_INDEX_NONE) /* Know (first > end) */ /* * Tricky to determine when runtime (last < first) can be @@ -1117,7 +1117,7 @@ TclCompileStringReplaceCmd( * (last <= TCL_INDEX END) && (last < first) => ACCEPT * else => cannot tell REJECT */ - || ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END) + || ((first <= (int)TCL_INDEX_END) && (last <= (int)TCL_INDEX_END) && (last < first)) /* Know (last < first) */ /* * (first == TCL_INDEX_NONE) && @@ -1128,7 +1128,7 @@ TclCompileStringReplaceCmd( * (last <= TCL_INDEX_END) => cannot tell REJECT * else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT */ - || ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START) + || ((first >= (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START) && (last < first))) { /* Know (last < first) */ if (parsePtr->numWords == 5) { tokenPtr = TokenAfter(tokenPtr); @@ -1179,7 +1179,7 @@ TclCompileStringReplaceCmd( * getting a guarantee that first <= last. */ - if ((first == TCL_INDEX_START) && (last >= TCL_INDEX_START)) { + if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { /* empty prefix */ tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); @@ -1187,13 +1187,13 @@ TclCompileStringReplaceCmd( if (last == INT_MAX) { OP( POP); /* Pop original */ } else { - OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); OP1( STR_CONCAT1, 2); } return TCL_OK; } - if ((last == TCL_INDEX_NONE) && (first <= TCL_INDEX_END)) { + if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { OP44( STR_RANGE_IMM, 0, first-1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); @@ -1210,19 +1210,19 @@ TclCompileStringReplaceCmd( * are harmless when they are replaced by another empty string. */ - if (first == TCL_INDEX_START) { + if (first == (int)TCL_INDEX_START) { /* empty prefix - build suffix only */ - if (last == TCL_INDEX_END) { + if (last == (int)TCL_INDEX_END) { /* empty suffix too => empty result */ OP( POP); /* Pop original */ PUSH ( ""); return TCL_OK; } - OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); return TCL_OK; } else { - if (last == TCL_INDEX_END) { + if (last == (int)TCL_INDEX_END) { /* empty suffix - build prefix only */ OP44( STR_RANGE_IMM, 0, first-1); return TCL_OK; @@ -1230,7 +1230,7 @@ TclCompileStringReplaceCmd( OP( DUP); OP44( STR_RANGE_IMM, 0, first-1); OP4( REVERSE, 2); - OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); OP1( STR_CONCAT1, 2); return TCL_OK; } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cebc33f..23049fb 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -114,15 +114,15 @@ typedef struct { int dead; /* Boolean signal that some operations * should no longer be attempted. */ - Tcl_TimerToken readTimer; /* + Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in order to call Tcl_NotifyChannel when the - channel is readable + channel is readable */ - Tcl_TimerToken writeTimer; /* + Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in order to call Tcl_NotifyChannel when the - channel is writable + channel is writable */ /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 8453fba..e76b2a8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4545,7 +4545,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (bignum).alloc = (bignumPayload >> 15) & 0x7fff; \ (bignum).used = bignumPayload & 0x7fff; \ } \ - } while (0) + } while (0) /* *---------------------------------------------------------------- -- cgit v0.12 From 5419f8e0ba508cfedb5c68a88aee618e25e17983 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 8 May 2019 18:06:23 +0000 Subject: For historical/hysterical reasons, the (unused??) public routines Tcl_UpVar() and Tcl_UpVar2() accept random garbage for a level argument (treat it as 1) while the [upvar] command has come to reject such values as bad levels. Add a test to call it to our attention if we ever change that disparity so we do so only on purpose. --- tests/upvar.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/upvar.test b/tests/upvar.test index 5ea870d..437f422 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -356,6 +356,10 @@ test upvar-8.11 {upvar will not create a variable that looks like an array} -set test upvar-9.1 {Tcl_UpVar2 procedure} testupvar { list [catch {testupvar xyz a {} x global} msg] $msg } {1 {bad level "xyz"}} +test upvar-9.1.1 {TclGetFrame, via Tcl_UpVar2} testupvar { + apply {{} {testupvar xyz a {} x local; set x foo}} + set a +} foo test upvar-9.2 {Tcl_UpVar2 procedure} testupvar { catch {unset a} catch {unset x} -- cgit v0.12 From b1139d3d2099aad8ad1981deaa0f689e1b4c322a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 May 2019 20:06:34 +0000 Subject: If compiling with -DTCL_NO_DEPRECATED, make Tcl_GetStringResult() a macro. This opens up one more simplification for Tcl 9. Compile the load-test dll's/so's with -DTCL_NO_DEPRECATED --- generic/tclDecls.h | 2 ++ generic/tclResult.c | 6 +----- generic/tclStubInit.c | 2 ++ unix/dltest/Makefile.in | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3b67796..3d40bef 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3986,6 +3986,8 @@ extern const TclStubs *tclStubsPtr; #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) #ifdef TCL_NO_DEPRECATED +#undef Tcl_GetStringResult +#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, 0) diff --git a/generic/tclResult.c b/generic/tclResult.c index 5a03421..4d14f01 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -464,7 +464,6 @@ Tcl_SetResult( ResetObjResult(iPtr); } -#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -488,9 +487,6 @@ Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED - return Tcl_GetString(iPtr->objResultPtr); -#else /* * If the string result is empty, move the object result to the string * result, then reset the object result. @@ -501,8 +497,8 @@ Tcl_GetStringResult( TCL_VOLATILE); } return iPtr->result; -#endif } +#endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 2eb2259..8945e0b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -368,6 +368,8 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig # define Tcl_Eval 0 # undef Tcl_GlobalEval # define Tcl_GlobalEval 0 +# undef Tcl_GetStringResult +# define Tcl_GetStringResult 0 # undef Tcl_SaveResult # define Tcl_SaveResult 0 # undef Tcl_RestoreResult diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 25b9376..500bf97 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -17,7 +17,7 @@ TCL_VERSION= @TCL_VERSION@ CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ -CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ +CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ -- cgit v0.12