From 516f8e365dd94bfc9af0fb2d86516cae5bb2ec7f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 27 Jun 2012 15:12:46 +0000 Subject: Experimental support for UNC paths (through VFS) on UNIX/Mac --- doc/filename.n | 7 +++---- generic/tclFileName.c | 8 ++------ tests/cmdAH.test | 8 ++++---- tests/fileName.test | 6 +++--- 4 files changed, 12 insertions(+), 17 deletions(-) diff --git a/doc/filename.n b/doc/filename.n index d481fc9..f1cd703 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -47,7 +47,8 @@ absolute, and file names may contain any character other than slash. The file names \fB\&.\fR and \fB\&..\fR are special and refer to the current directory and the parent of the current directory respectively. Multiple adjacent slash characters are interpreted as a single -separator. Any number of trailing slash characters at the end of a +separator, except for the first double slash \fB//\fR in absolute paths. +Any number of trailing slash characters at the end of a path are simply ignored, so the paths \fBfoo\fR, \fBfoo/\fR and \fBfoo//\fR are all identical, and in particular \fBfoo/\fR does not necessarily mean a directory is being referred. @@ -150,9 +151,7 @@ The safest approach is to use names consisting of alphanumeric characters only. Care should be taken with filenames which contain spaces (common on Windows systems) and filenames where the backslash is the directory separator (Windows -native path names). Also Windows 3.1 only supports file -names with a root of no more than 8 characters and an extension of no -more than 3 characters. +native path names). .PP On Windows platforms there are file and path length restrictions. Complete paths or filenames longer than about 260 characters will lead diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 48c5454..3e78a05 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -424,14 +424,12 @@ TclpGetNativePathType( } #endif if (path[0] == '/') { -#ifdef __CYGWIN__ /* - * Check for Cygwin // network path prefix + * Check for "//" prefix */ if (path[1] == '/') { path++; } -#endif if (driveNameLengthPtr != NULL) { /* * We need this addition in case the QNX or Cygwin code was used. @@ -665,15 +663,13 @@ SplitUnixPath( if (*p == '/') { Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1); p++; -#ifdef __CYGWIN__ /* - * Check for Cygwin // network path prefix + * Check for "//" prefix */ if (*p == '/') { Tcl_AppendToObj(rootElt, "/", 1); p++; } -#endif Tcl_ListObjAppendElement(NULL, result, rootElt); } diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 291df8d..fbe51d2 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -303,19 +303,19 @@ test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform { test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo -} / +} // test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo/bar -} /foo +} //foo test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz} -} {/foo\/bar} +} {//foo\/bar} test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz/blat} -} {/foo\/bar/baz} +} {//foo\/bar/baz} test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /foo// diff --git a/tests/fileName.test b/tests/fileName.test index 251f12c..aab8d33 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -196,7 +196,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split //foo -} "[file split //] foo" +} "// foo" test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo//bar @@ -433,11 +433,11 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b -} "[file split //]a/b" +} "//a/b" test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /// a b -} "[file split //]a/b" +} "//a/b" test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win -- cgit v0.12 From f942af920c1c31f578e24aae999d86191ec65f39 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 Aug 2012 15:44:12 +0000 Subject: integrate QNX special path handling better with TIP #402 --- generic/tclFileName.c | 46 +++++++++++++++++++--------------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 013f788..cae2657 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -411,28 +411,24 @@ TclpGetNativePathType( * Paths that begin with / are absolute. */ -#ifdef __QNX__ - /* - * Check for QNX // prefix - */ - if (*path && (pathLen > 3) && (path[0] == '/') - && (path[1] == '/') && isdigit(UCHAR(path[2]))) { - path += 3; - while (isdigit(UCHAR(*path))) { - path++; - } - } -#endif if (path[0] == '/') { /* * Check for "//" prefix */ if (path[1] == '/') { path++; +#ifdef __QNX__ + /* + * Check for QNX // prefix + */ + while (isdigit(UCHAR(path[1]))) { + path++; + } +#endif } if (driveNameLengthPtr != NULL) { /* - * We need this addition in case the QNX or Cygwin code was used. + * We need this addition in case the QNX or "//" code was used. */ *driveNameLengthPtr = (1 + path - origPath); @@ -645,20 +641,6 @@ SplitUnixPath( * Deal with the root directory as a special case. */ -#ifdef __QNX__ - /* - * Check for QNX // prefix - */ - - if ((path[0] == '/') && (path[1] == '/') - && isdigit(UCHAR(path[2]))) { /* INTL: digit */ - path += 3; - while (isdigit(UCHAR(*path))) { /* INTL: digit */ - path++; - } - } -#endif - p = path; if (*p == '/') { Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1); @@ -669,6 +651,16 @@ SplitUnixPath( if (*p == '/') { Tcl_AppendToObj(rootElt, "/", 1); p++; +#ifdef __QNX__ */ + /* + * Check for QNX // prefix + */ + + while (isdigit(UCHAR(*p))) { /* INTL: digit */ + Tcl_AppendToObj(rootElt, p, 1); + p++; + } +#endif } Tcl_ListObjAppendElement(NULL, result, rootElt); } -- cgit v0.12 From bec96305308d0c234215d25b194f1ff8417dc8b4 Mon Sep 17 00:00:00 2001 From: griffin Date: Thu, 29 Sep 2022 16:10:07 +0000 Subject: Fix bug-99e834bf33 --- generic/tclExecute.c | 2 +- tests/lseq.test | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 5f29bfa..fa0dfa2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4938,7 +4938,7 @@ TEBCresume( /* Decode end-offset index values. */ - index = TclIndexDecode(opnd, length); + index = TclIndexDecode(opnd, length-1); /* Compute value @ index */ if (index >= 0 && index < length) { diff --git a/tests/lseq.test b/tests/lseq.test index e05b32d..518a7bb 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -489,9 +489,19 @@ test lseq-4.4 {lseq corner case} -body { lappend res $s $e } eval $tcmd +} -cleanup { + unset res } -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638} +# Ticket 99e834bf33 - lseq, lindex end off by one + +test lseq-4.5 {lindex off by one} -body { + lappend res [eval {lindex [lseq 1 4] end}] + lappend res [eval {lindex [lseq 1 4] end-1}] +} -result {4 3} + + # cleanup ::tcltest::cleanupTests return -- cgit v0.12 From b01f9536cb1fe19d6b97c9a81b4dac4fb98dd5dd Mon Sep 17 00:00:00 2001 From: griffin Date: Fri, 30 Sep 2022 00:03:55 +0000 Subject: Fix various issues with refCounts. --- generic/tclArithSeries.c | 6 ++---- generic/tclCmdAH.c | 7 +++++++ generic/tclListObj.c | 2 -- tests/lseq.test | 14 ++++++++++++-- 4 files changed, 21 insertions(+), 8 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 61b4a9b..ee201fa 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -392,6 +392,7 @@ TclArithSeriesObjStep( } else { *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); } + Tcl_IncrRefCount(*stepObj); return TCL_OK; } @@ -436,6 +437,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele } else { *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); } + Tcl_IncrRefCount(*elementObj); return TCL_OK; } @@ -722,11 +724,8 @@ TclArithSeriesObjRange( } TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj); - Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj); - Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); - Tcl_IncrRefCount(stepObj); if (Tcl_IsShared(arithSeriesPtr) || ((arithSeriesPtr->refCount > 1))) { @@ -857,7 +856,6 @@ TclArithSeriesGetElements( } return TCL_ERROR; } - Tcl_IncrRefCount(objv[i]); } } } else { diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 07541bd..3048e82 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -3027,6 +3027,13 @@ ForeachAssignments( varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v], NULL, valuePtr, TCL_LEAVE_ERR_MSG); + if (isarithseries) { + /* arith values have implicit reference + ** Make sure value is cleaned up when var goes away + */ + Tcl_DecrRefCount(valuePtr); + } + if (varValuePtr == NULL) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", diff --git a/generic/tclListObj.c b/generic/tclListObj.c index d18ad59..598ff6f 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2641,7 +2641,6 @@ TclLindexFlat( } if (i==0) { TclArithSeriesObjIndex(listObj, index, &elemObj); - Tcl_IncrRefCount(elemObj); } else if (index > 0) { Tcl_DecrRefCount(elemObj); TclNewObj(elemObj); @@ -3304,7 +3303,6 @@ SetListFromAny( if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) { return TCL_ERROR; } - Tcl_IncrRefCount(elemPtrs[j]);/* Since list now holds ref to it. */ } } else { diff --git a/tests/lseq.test b/tests/lseq.test index 518a7bb..7daa59c 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -223,6 +223,8 @@ test lseq-3.1 {experiement} { if {$ans eq {}} { set ans OK } + unset factor + unset l set ans } {OK} @@ -376,13 +378,18 @@ test lseq-3.26 {lsort shimmer} arithSeriesShimmer { list ${rep-before} $lexical_sort ${rep-after} } {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries} -test lseq-3.27 {lreplace shimmer} arithSeriesShimmer { +test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body { set r [lseq 15 0] set rep-before [lindex [tcl::unsupported::representation $r] 3] set lexical_sort [lreplace $r 3 5 A B C] set rep-after [lindex [tcl::unsupported::representation $r] 3] list ${rep-before} $lexical_sort ${rep-after} -} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} +} -cleanup { + unset r + unset rep-before + unset lexical_sort + unset rep-after +} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} test lseq-3.28 {lreverse bug in ArithSeries} {} { set r [lseq -5 17 3] @@ -499,11 +506,14 @@ test lseq-4.4 {lseq corner case} -body { test lseq-4.5 {lindex off by one} -body { lappend res [eval {lindex [lseq 1 4] end}] lappend res [eval {lindex [lseq 1 4] end-1}] +} -cleanup { + unset res } -result {4 3} # cleanup ::tcltest::cleanupTests + return # Local Variables: -- cgit v0.12 From 3f371a5084c05daba396645abd9a25deb3d023d1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 4 Oct 2022 15:56:08 +0000 Subject: =?UTF-8?q?Fix=20g++=20warning:=20tclEvent.c:1519:10:=20warning:?= =?UTF-8?q?=20declaration=20of=20=E2=80=98enum=20Tcl=5FVwaitObjCmd(void*,?= =?UTF-8?q?=20Tcl=5FInterp*,=20int,=20Tcl=5FObj*=20const*)::options?= =?UTF-8?q?=E2=80=99=20shadows=20a=20previous=20local=20[-Wshadow]?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclEvent.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 183ac82..1e2e7bf 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1511,12 +1511,12 @@ Tcl_VwaitObjCmd( Tcl_Channel chan; Tcl_WideInt diff = -1; VwaitItem localItems[32], *vwaitItems = localItems; - static const char *const options[] = { + static const char *const vWaitOptionStrings[] = { "-all", "-extended", "-nofileevents", "-noidleevents", "-notimerevents", "-nowindowevents", "-readable", "-timeout", "-variable", "-writable", "--", NULL }; - enum options { + enum vWaitOptions { OPT_ALL, OPT_EXTD, OPT_NO_FEVTS, OPT_NO_IEVTS, OPT_NO_TEVTS, OPT_NO_WEVTS, OPT_READABLE, OPT_TIMEOUT, OPT_VARIABLE, OPT_WRITABLE, OPT_LAST @@ -1541,7 +1541,7 @@ Tcl_VwaitObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + if (Tcl_GetIndexFromObj(interp, objv[i], vWaitOptionStrings, "option", 0, &index) != TCL_OK) { result = TCL_ERROR; goto done; @@ -1570,7 +1570,7 @@ Tcl_VwaitObjCmd( needArg: Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "argument required for \"%s\"", options[index])); + "argument required for \"%s\"", vWaitOptionStrings[index])); Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", NULL); result = TCL_ERROR; goto done; -- cgit v0.12 From 00199ad335823ec6b18983d1188f70b0b065b25e Mon Sep 17 00:00:00 2001 From: griffin Date: Tue, 4 Oct 2022 20:15:38 +0000 Subject: Fix some bugs in lseq --- generic/tclArithSeries.c | 9 +++++++-- generic/tclCmdAH.c | 17 +++++------------ generic/tclExecute.c | 7 ++++++- generic/tclListObj.c | 8 ++++---- tests/lseq.test | 2 +- 5 files changed, 23 insertions(+), 20 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index ee201fa..6a02caa 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -392,7 +392,6 @@ TclArithSeriesObjStep( } else { *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); } - Tcl_IncrRefCount(*stepObj); return TCL_OK; } @@ -437,7 +436,6 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele } else { *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); } - Tcl_IncrRefCount(*elementObj); return TCL_OK; } @@ -724,8 +722,11 @@ TclArithSeriesObjRange( } TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj); + Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj); + Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + Tcl_IncrRefCount(stepObj); if (Tcl_IsShared(arithSeriesPtr) || ((arithSeriesPtr->refCount > 1))) { @@ -856,6 +857,7 @@ TclArithSeriesGetElements( } return TCL_ERROR; } + Tcl_IncrRefCount(objv[i]); } } } else { @@ -912,8 +914,11 @@ TclArithSeriesObjReverse( len = arithSeriesRepPtr->len; TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj); + Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj); + Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + Tcl_IncrRefCount(stepObj); if (isDouble) { Tcl_GetDoubleFromObj(NULL, startObj, &dstart); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 3048e82..a5c5330 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2866,13 +2866,13 @@ EachloopCmd( /* Values */ if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) { /* Special case for Arith Series */ - statePtr->vCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); - if (statePtr->vCopyList[i] == NULL) { + statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); + if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; } /* Don't compute values here, wait until the last momement */ - statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->vCopyList[i]); + statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]); } else { /* List values */ statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); @@ -3005,12 +3005,12 @@ ForeachAssignments( Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; inumLists ; i++) { - int isarithseries = TclHasInternalRep(statePtr->vCopyList[i],&tclArithSeriesType); + int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType); for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { if (isarithseries) { - if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &valuePtr) != TCL_OK) { + if (TclArithSeriesObjIndex(statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", (statePtr->resultList != NULL ? "lmap" : "foreach"), @@ -3027,13 +3027,6 @@ ForeachAssignments( varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v], NULL, valuePtr, TCL_LEAVE_ERR_MSG); - if (isarithseries) { - /* arith values have implicit reference - ** Make sure value is cleaned up when var goes away - */ - Tcl_DecrRefCount(valuePtr); - } - if (varValuePtr == NULL) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (setting %s loop variable \"%s\")", diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fa0dfa2..7c7bbfd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4883,6 +4883,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } + Tcl_IncrRefCount(objResultPtr); // reference held here goto lindexDone; } @@ -5187,7 +5188,11 @@ TEBCresume( */ do { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + if (isArithSeries) { + TclArithSeriesObjIndex(value2Ptr, i, &o); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } if (o != NULL) { s2 = TclGetStringFromObj(o, &s2len); } else { diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 598ff6f..62bc162 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1369,6 +1369,9 @@ TclListObjCopy( Tcl_Obj *copyObj; if (!TclHasInternalRep(listObj, &tclListType)) { + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + return TclArithSeriesObjCopy(interp, listObj); + } if (SetListFromAny(interp, listObj) != TCL_OK) { return NULL; } @@ -1943,10 +1946,6 @@ Tcl_ListObjIndex( Tcl_Obj **elemObjs; ListSizeT numElems; - if (TclHasInternalRep(listObj,&tclArithSeriesType)) { - return TclArithSeriesObjIndex(listObj, index, objPtrPtr); - } - /* * TODO * Unlike the original list code, this does not optimize for lindex'ing @@ -2642,6 +2641,7 @@ TclLindexFlat( if (i==0) { TclArithSeriesObjIndex(listObj, index, &elemObj); } else if (index > 0) { + /* ArithSeries cannot be a list of lists */ Tcl_DecrRefCount(elemObj); TclNewObj(elemObj); Tcl_IncrRefCount(elemObj); diff --git a/tests/lseq.test b/tests/lseq.test index 7daa59c..2e5d7e1 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { testConstraint arithSeriesDouble 1 testConstraint arithSeriesShimmer 1 -testConstraint arithSeriesShimmerOk 0 +testConstraint arithSeriesShimmerOk 1 ## Arg errors test lseq-1.1 {error cases} -body { -- cgit v0.12 From 3cb6c489a3c0515c7b3aade0aaa139e637400559 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Oct 2022 06:41:28 +0000 Subject: Missing error-check in Tcl_GetWideIntFromObj (backported from 9.0, was already fixed there) --- generic/tclArithSeries.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 6a02caa..11a4254 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -306,7 +306,9 @@ TclNewArithSeriesObj( assignNumber(useDoubles, &end, &dend, endObj); } if (lenObj) { - Tcl_GetWideIntFromObj(NULL, lenObj, &len); + if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) { + return TCL_ERROR; + } } if (startObj && endObj) { @@ -339,7 +341,7 @@ TclNewArithSeriesObj( } } - if (len > ListSizeT_MAX) { + if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); -- cgit v0.12 From 4721ffe64fe11287997ec892d58c375a73e3876d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Oct 2022 15:31:31 +0000 Subject: Fix [1599352cca] and related issues --- generic/tclDictObj.c | 51 ++++++++++++++++++++++++++------------------------- generic/tclInt.h | 2 +- generic/tclListObj.c | 7 ++++--- generic/tclUtil.c | 13 +++++++------ 4 files changed, 38 insertions(+), 35 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ba9ab98..3fe1800 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -265,7 +265,7 @@ DeleteChainTable( ChainEntry *cPtr; for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } @@ -312,7 +312,7 @@ DeleteChainEntry( if (cPtr == NULL) { return 0; } else { - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); TclDecrRefCount(valuePtr); } @@ -364,7 +364,7 @@ DupDictInternalRep( Tcl_Obj *copyPtr) { Dict *oldDict = DICT(srcPtr); - Dict *newDict = ckalloc(sizeof(Dict)); + Dict *newDict = (Dict *)ckalloc(sizeof(Dict)); ChainEntry *cPtr; /* @@ -373,8 +373,8 @@ DupDictInternalRep( InitChainTable(newDict); for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) { - Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry); - Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry); + Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); int n; Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n); @@ -492,7 +492,8 @@ UpdateStringOfDict( Dict *dict = DICT(dictPtr); ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - int i, length, bytesNeeded = 0; + int i, length; + unsigned int bytesNeeded = 0; const char *elem; char *dst; @@ -517,7 +518,7 @@ UpdateStringOfDict( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = ckalloc(numElems); + flagPtr = (char *)ckalloc(numElems); } for (i=0,cPtr=dict->entryChainHead; inextPtr) { /* @@ -526,22 +527,22 @@ UpdateStringOfDict( */ flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); - keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } flagPtr[i+1] = TCL_DONT_QUOTE_HASH; - valuePtr = Tcl_GetHashValue(&cPtr->entry); + valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } - if (bytesNeeded > INT_MAX - numElems + 1) { + if (bytesNeeded + numElems > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; @@ -555,13 +556,13 @@ UpdateStringOfDict( dst = dictPtr->bytes; for (i=0,cPtr=dict->entryChainHead; inextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); - keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; - valuePtr = Tcl_GetHashValue(&cPtr->entry); + valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); elem = TclGetStringFromObj(valuePtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; @@ -600,7 +601,7 @@ SetDictFromAny( { Tcl_HashEntry *hPtr; int isNew; - Dict *dict = ckalloc(sizeof(Dict)); + Dict *dict = (Dict *)ckalloc(sizeof(Dict)); InitChainTable(dict); @@ -625,7 +626,7 @@ SetDictFromAny( /* Store key and value in the hash table we're building. */ hPtr = CreateChainEntry(dict, objv[i], &isNew); if (!isNew) { - Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr); + Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr); /* * Not really a well-formed dictionary as there are duplicate @@ -690,7 +691,7 @@ SetDictFromAny( /* Store key and value in the hash table we're building. */ hPtr = CreateChainEntry(dict, keyPtr, &isNew); if (!isNew) { - Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr); + Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(keyPtr); TclDecrRefCount(discardedValue); @@ -809,7 +810,7 @@ TclTraceDictPath( Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); } else { - tmpObj = Tcl_GetHashValue(hPtr); + tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); if (tmpObj->typePtr != &tclDictType && SetDictFromAny(interp, tmpObj) != TCL_OK) { return NULL; @@ -919,7 +920,7 @@ Tcl_DictObjPut( hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { - Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); + Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); TclDecrRefCount(oldValuePtr); } @@ -969,7 +970,7 @@ Tcl_DictObjGet( if (hPtr == NULL) { *valuePtrPtr = NULL; } else { - *valuePtrPtr = Tcl_GetHashValue(hPtr); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr); } return TCL_OK; } @@ -1115,10 +1116,10 @@ Tcl_DictObjFirst( searchPtr->next = cPtr->nextPtr; dict->refCount++; if (keyPtrPtr != NULL) { - *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); + *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); } if (valuePtrPtr != NULL) { - *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } return TCL_OK; @@ -1181,7 +1182,7 @@ Tcl_DictObjNext( Tcl_Panic("concurrent dictionary modification and search"); } - cPtr = searchPtr->next; + cPtr = (ChainEntry *)searchPtr->next; if (cPtr == NULL) { Tcl_DictObjDone(searchPtr); *donePtr = 1; @@ -1191,11 +1192,11 @@ Tcl_DictObjNext( searchPtr->next = cPtr->nextPtr; *donePtr = 0; if (keyPtrPtr != NULL) { - *keyPtrPtr = Tcl_GetHashKey( + *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey( &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry); } if (valuePtrPtr != NULL) { - *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry); + *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); } } diff --git a/generic/tclInt.h b/generic/tclInt.h index 63fcf62..8c3efb5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3146,7 +3146,7 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE int TclScanElement(const char *string, int length, +MODULE_SCOPE unsigned int TclScanElement(const char *string, int length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 88a332f..a994fd7 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1945,7 +1945,8 @@ UpdateStringOfList( char localFlags[LOCAL_SIZE], *flagPtr = NULL; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; - int i, length, bytesNeeded = 0; + int i, length; + unsigned int bytesNeeded = 0; const char *elem; char *dst; Tcl_Obj **elemPtrs; @@ -1986,11 +1987,11 @@ UpdateStringOfList( flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } - if (bytesNeeded > INT_MAX - numElems + 1) { + if (bytesNeeded + numElems > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 8d2347b..cacd23e 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1010,7 +1010,7 @@ Tcl_ScanCountedElement( *---------------------------------------------------------------------- */ -int +unsigned int TclScanElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ @@ -1026,7 +1026,7 @@ TclScanElement( int extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - int bytesNeeded; /* Buffer length computed to complete the + unsigned int bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ @@ -1290,7 +1290,7 @@ TclScanElement( *flagPtr = CONVERT_NONE; overflowCheck: - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("TclScanElement: string length overflow"); } return bytesNeeded; @@ -1568,7 +1568,8 @@ Tcl_Merge( { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i, bytesNeeded = 0; + int i; + unsigned int bytesNeeded = 0; char *result, *dst; /* @@ -1594,11 +1595,11 @@ Tcl_Merge( for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]); - if (bytesNeeded < 0) { + if (bytesNeeded > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } } - if (bytesNeeded > INT_MAX - argc + 1) { + if (bytesNeeded + argc > INT_MAX + 1U) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; -- cgit v0.12 From 9dd5a63f35590c88db321bf5f70429c61ed5a3b5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 6 Oct 2022 13:12:11 +0000 Subject: TIP #640: Remove Tcl_SaveResult (in Tcl 8.7 it's only removed when compiled with -DTCL_NO_DEPRECATED) --- doc/SaveInterpState.3 | 85 ++++++++++++++++++++++++++++++++++++ doc/SaveResult.3 | 85 ------------------------------------ generic/tcl.h | 2 + generic/tclDecls.h | 29 +++--------- generic/tclTest.c | 8 ++++ macosx/Tcl.xcodeproj/project.pbxproj | 4 +- win/tcl.dsp | 2 +- 7 files changed, 105 insertions(+), 110 deletions(-) create mode 100644 doc/SaveInterpState.3 delete mode 100644 doc/SaveResult.3 diff --git a/doc/SaveInterpState.3 b/doc/SaveInterpState.3 new file mode 100644 index 0000000..804f9ec --- /dev/null +++ b/doc/SaveInterpState.3 @@ -0,0 +1,85 @@ +'\" +'\" Copyright (c) 1997 Sun Microsystems, Inc. +'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright) +'\" Copyright (c) 2018 Nathan Coulter. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, +Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the +state of an an interpreter. +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +Tcl_InterpState +\fBTcl_SaveInterpState\fR(\fIinterp, status\fR) +.sp +int +\fBTcl_RestoreInterpState\fR(\fIinterp, state\fR) +.sp +\fBTcl_DiscardInterpState\fR(\fIstate\fR) +.sp +\fBTcl_SaveResult\fR(\fIinterp, savedPtr\fR) +.sp +\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR) +.sp +\fBTcl_DiscardResult\fR(\fIsavedPtr\fR) +.SH ARGUMENTS +.AS Tcl_InterpState savedPtr +.AP Tcl_Interp *interp in +The interpreter for the operation. +.AP int status in +The return code for the state. +.AP Tcl_InterpState state in +A token for saved state. +.AP Tcl_SavedResult *savedPtr in +A pointer to storage for saved state. +.BE +.SH DESCRIPTION +.PP +These routines save the state of an interpreter before a call to a routine such +as \fBTcl_Eval\fR, and restore the state afterwards. +.PP +\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the +result of a script, including the resulting value, the return code passed as +\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR. +It returns a token for the saved state. The interpreter result is not reset +and no interpreter state is changed. +.PP +\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and +returns the \fIstatus\fR originally passed in the corresponding call to +\fBTcl_SaveInterpState\fR. +.PP +If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called +to release it. A token used to discard or restore state must not be used +again. +.PP +\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are +deprecated. Instead use \fBTcl_SaveInterpState\fR, +\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more +capable. +.PP +\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location +\fIstatePtr\fR points to and returns the interpreter result to its initial +state. It does not save options such as \fB\-errorcode\fR or +\fB\-errorinfo\fR. +.PP +\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and +moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is +then in an undefined state and must not be used until passed again to +\fBTcl_SaveResult\fR. +.PP +\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is +then in an undefined state and must not be used until passed again to +\fBTcl_SaveResult\fR. +.PP +If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to +release it. +.SH KEYWORDS +result, state, interp diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 deleted file mode 100644 index 804f9ec..0000000 --- a/doc/SaveResult.3 +++ /dev/null @@ -1,85 +0,0 @@ -'\" -'\" Copyright (c) 1997 Sun Microsystems, Inc. -'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright) -'\" Copyright (c) 2018 Nathan Coulter. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, -Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the -state of an an interpreter. -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -Tcl_InterpState -\fBTcl_SaveInterpState\fR(\fIinterp, status\fR) -.sp -int -\fBTcl_RestoreInterpState\fR(\fIinterp, state\fR) -.sp -\fBTcl_DiscardInterpState\fR(\fIstate\fR) -.sp -\fBTcl_SaveResult\fR(\fIinterp, savedPtr\fR) -.sp -\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR) -.sp -\fBTcl_DiscardResult\fR(\fIsavedPtr\fR) -.SH ARGUMENTS -.AS Tcl_InterpState savedPtr -.AP Tcl_Interp *interp in -The interpreter for the operation. -.AP int status in -The return code for the state. -.AP Tcl_InterpState state in -A token for saved state. -.AP Tcl_SavedResult *savedPtr in -A pointer to storage for saved state. -.BE -.SH DESCRIPTION -.PP -These routines save the state of an interpreter before a call to a routine such -as \fBTcl_Eval\fR, and restore the state afterwards. -.PP -\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the -result of a script, including the resulting value, the return code passed as -\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR. -It returns a token for the saved state. The interpreter result is not reset -and no interpreter state is changed. -.PP -\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and -returns the \fIstatus\fR originally passed in the corresponding call to -\fBTcl_SaveInterpState\fR. -.PP -If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called -to release it. A token used to discard or restore state must not be used -again. -.PP -\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are -deprecated. Instead use \fBTcl_SaveInterpState\fR, -\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more -capable. -.PP -\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location -\fIstatePtr\fR points to and returns the interpreter result to its initial -state. It does not save options such as \fB\-errorcode\fR or -\fB\-errorinfo\fR. -.PP -\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and -moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is -then in an undefined state and must not be used until passed again to -\fBTcl_SaveResult\fR. -.PP -\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is -then in an undefined state and must not be used until passed again to -\fBTcl_SaveResult\fR. -.PP -If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to -release it. -.SH KEYWORDS -result, state, interp diff --git a/generic/tcl.h b/generic/tcl.h index f17d43e..c8a76c5 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -817,6 +817,7 @@ typedef struct Tcl_Obj { * typically allocated on the stack. */ +#ifndef TCL_NO_DEPRECATED typedef struct Tcl_SavedResult { char *result; Tcl_FreeProc *freeProc; @@ -826,6 +827,7 @@ typedef struct Tcl_SavedResult { int appendUsed; char resultSpace[200+1]; } Tcl_SavedResult; +#endif /* *---------------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 25adc95..62b9604 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -14,6 +14,10 @@ #include /* for size_t */ +#ifdef TCL_NO_DEPRECATED +# define Tcl_SavedResult void +#endif /* TCL_NO_DEPRECATED */ + #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -4231,30 +4235,8 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL) #undef Tcl_SaveResult -static TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(void) {} -#define Tcl_SaveResult(interp, statePtr) \ - do { \ - Tcl_SaveResult_(); \ - (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \ - Tcl_IncrRefCount((statePtr)->objResultPtr); \ - Tcl_SetObjResult(interp, Tcl_NewObj()); \ - } while(0) #undef Tcl_RestoreResult -static TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreResult_(void) {} -#define Tcl_RestoreResult(interp, statePtr) \ - do { \ - Tcl_RestoreResult_(); \ - Tcl_ResetResult(interp); \ - Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \ - Tcl_DecrRefCount((statePtr)->objResultPtr); \ - } while(0) #undef Tcl_DiscardResult -static TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_(void) {} -#define Tcl_DiscardResult(statePtr) \ - do { \ - Tcl_DiscardResult_(); \ - Tcl_DecrRefCount((statePtr)->objResultPtr); \ - } while(0) #undef Tcl_SetResult #define Tcl_SetResult(interp, result, freeProc) \ do { \ @@ -4492,6 +4474,9 @@ static TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_( * Deprecated Tcl procedures: */ +#ifdef TCL_NO_DEPRECATED +# undef Tcl_SavedResult +#endif /* TCL_NO_DEPRECATED */ #undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) diff --git a/generic/tclTest.c b/generic/tclTest.c index 354ea9c..95f4d2f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -145,7 +145,9 @@ typedef struct { * was called for a result. */ +#ifndef TCL_NO_DEPRECATED static int freeCount; +#endif /* TCL_NO_DEPRECATED */ /* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. @@ -297,8 +299,10 @@ static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); +#ifndef TCL_NO_DEPRECATED static Tcl_ObjCmdProc TestsaveresultCmd; static void TestsaveresultFree(char *blockPtr); +#endif /* TCL_NO_DEPRECATED */ static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; @@ -690,8 +694,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); +#ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); +#endif Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, @@ -5522,6 +5528,7 @@ Testset2Cmd( *---------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd( TCL_UNUSED(void *), @@ -5635,6 +5642,7 @@ TestsaveresultFree( { freeCount++; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 90896e2..4143128 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -376,7 +376,7 @@ F96D3E9108F272A6004A47F5 /* rename.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = rename.n; sourceTree = ""; }; F96D3E9208F272A6004A47F5 /* return.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = return.n; sourceTree = ""; }; F96D3E9308F272A6004A47F5 /* safe.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = safe.n; sourceTree = ""; }; - F96D3E9408F272A6004A47F5 /* SaveResult.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveResult.3; sourceTree = ""; }; + F96D3E9408F272A6004A47F5 /* SaveInterpState.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SaveInterpState.3; sourceTree = ""; }; F96D3E9508F272A6004A47F5 /* scan.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = scan.n; sourceTree = ""; }; F96D3E9608F272A6004A47F5 /* seek.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = seek.n; sourceTree = ""; }; F96D3E9708F272A6004A47F5 /* set.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = set.n; sourceTree = ""; }; @@ -1123,7 +1123,7 @@ F96D3E9108F272A6004A47F5 /* rename.n */, F96D3E9208F272A6004A47F5 /* return.n */, F96D3E9308F272A6004A47F5 /* safe.n */, - F96D3E9408F272A6004A47F5 /* SaveResult.3 */, + F96D3E9408F272A6004A47F5 /* SaveInterpState.3 */, F96D3E9508F272A6004A47F5 /* scan.n */, F96D3E9608F272A6004A47F5 /* seek.n */, F93599D80DF1F98300E04F67 /* self.n */, diff --git a/win/tcl.dsp b/win/tcl.dsp index cc9d173..aff1000 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -760,7 +760,7 @@ SOURCE=..\doc\safe.n # End Source File # Begin Source File -SOURCE=..\doc\SaveResult.3 +SOURCE=..\doc\SaveInterpState.3 # End Source File # Begin Source File -- cgit v0.12