From 5645bb01ffdfc76dbf7e9a026cb146f3d7b5eafc Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:20:45 +0000 Subject: Test namespace-56.4 detects Bug 8b9854c3d8. Branch open to fix it. --- tests/namespace.test | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/namespace.test b/tests/namespace.test index 1d26512..58d6839 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3323,6 +3323,19 @@ namespace eval : { : p1 } 16fe1b5807 + +test namespace-56.4 {Bug 8b9854c3d8} -setup { + namespace eval namespace-56.4 { + proc cmd {} {string match ::* [lindex [info level 0] 0]} + namespace export * + namespace ensemble create + } +} -body { + namespace-56.4 cmd +} -cleanup { + namespace delete namespace-56.4 +} -result 1 + # cleanup catch {rename cmd1 {}} -- cgit v0.12 From 1cd98b93bd922cc624acf57f7547984606f4f565 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:37:46 +0000 Subject: Unique test name. --- tests/namespace.test | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/namespace.test b/tests/namespace.test index 58d6839..eef2eb7 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3324,16 +3324,16 @@ namespace eval : { : p1 } 16fe1b5807 -test namespace-56.4 {Bug 8b9854c3d8} -setup { - namespace eval namespace-56.4 { - proc cmd {} {string match ::* [lindex [info level 0] 0]} +test namespace-56.5 {Bug 8b9854c3d8} -setup { + namespace eval namespace-56.5 { + proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]} namespace export * namespace ensemble create } } -body { - namespace-56.4 cmd + namespace-56.5 cmd } -cleanup { - namespace delete namespace-56.4 + namespace delete namespace-56.5 } -result 1 -- cgit v0.12 From 1ebe878444abb6e6e9a919c99e6f1736353917ef Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 17:58:48 +0000 Subject: Fix Bug 8b9854c3d8. Now 4 test failures require examination. --- generic/tclEnsemble.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index dfffe12..3352d1f 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2694,7 +2694,11 @@ BuildEnsembleConfig( if (isNew) { Tcl_Obj *cmdObj, *cmdPrefixObj; - cmdObj = Tcl_NewStringObj(nsCmdName, -1); + TclNewObj(cmdObj); + Tcl_AppendStringsToObj(cmdObj, + ensemblePtr->nsPtr->fullName, + (ensemblePtr->nsPtr->parentPtr ? "::" : ""), + nsCmdName, NULL); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); -- cgit v0.12 From 526c432322c2df709ecad50d5450141e8c883fa8 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Jun 2019 20:43:04 +0000 Subject: Mark test namespace-54.6 as knownBug. The real bug here is Tcl's failure to forbid ":" as a namespace name. --- tests/namespace.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/namespace.test b/tests/namespace.test index eef2eb7..ad82abe 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1797,7 +1797,7 @@ test namespace-42.7 {ensembles: nested} -body { list [ns x0 z] [ns x1] [ns x2] [ns x3] } -cleanup { namespace delete ns -} -result {{1 z} 1 2 3} +} -result {{1 ::ns::x0::z} 1 2 3} test namespace-42.8 { ensembles: [Bug 1670091], panic due to pointer to a deallocated List struct. @@ -2128,7 +2128,7 @@ test namespace-47.1 {ensemble: unknown handler} { lappend result [catch {ns c d e} msg] $msg lappend result [catch {ns Magic foo bar spong wibble} msg] $msg list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] -} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}} +} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}} test namespace-47.2 {ensemble: unknown handler} { namespace eval ns { namespace export {[a-z]*} @@ -3227,7 +3227,7 @@ test namespace-53.10 {ensembles: nested rewrite} -setup { 1 {wrong # args: should be "ns z1 x a1"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ - 1 {wrong # args: should be "z0"}\ + 1 {wrong # args: should be "::ns::x::z0"}\ 0 {1 v}\ 1 {wrong # args: should be "ns v x z2 a2"}\ 0 {2 v v2}} @@ -3312,7 +3312,7 @@ test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { } } {::testing::abc::def ::testing::abc::ghi} -test namespace-56.4 {bug 16fe1b5807: names starting with ":"} { +test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug { namespace eval : { namespace ensemble create namespace export * -- cgit v0.12 From c1ee80eccf07579e1df09f808369df85013241db Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 15 Jun 2019 22:30:59 +0000 Subject: Use mp_init_set() in stead of mp_init_set_int() when the constant is sufficiently small. This is slightly better optimized. --- generic/tclStrToD.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 17d630b..a93c81b 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -3263,7 +3263,7 @@ ShorteningBignumConversionPowD(Double* dPtr, */ TclBNInitBignumFromWideUInt(&b, bw); - mp_init_set_int(&mminus, 1); + mp_init_set(&mminus, 1); MulPow5(&b, b5, &b); mp_mul_2d(&b, b2, &b); @@ -3666,7 +3666,7 @@ ShorteningBignumConversion(Double* dPtr, TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); - mp_init_set_int(&S, 1); + mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* @@ -3683,7 +3683,7 @@ ShorteningBignumConversion(Double* dPtr, /* mminus = 2**m2minus * 5**m5 */ - mp_init_set_int(&mminus, minit); + mp_init_set(&mminus, minit); mp_mul_2d(&mminus, m2minus, &mminus); if (m2plus > m2minus) { mp_init_copy(&mplus, &mminus); @@ -3879,7 +3879,7 @@ StrictBignumConversion(Double* dPtr, mp_init_multi(&temp, &dig, NULL); TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); - mp_init_set_int(&S, 1); + mp_init_set(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* -- cgit v0.12 From 2f8cb2ab854a2e311b49c8276bb59a76adaeafeb Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 20 Jun 2019 19:40:30 +0000 Subject: [6bdadfba7d] Stop crash with multi-lappend and failing writes --- generic/tclExecute.c | 21 +++++++++++++-------- tests/execute.test | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 8 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bf2d7bc..413c753 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3716,31 +3716,36 @@ TEBCresume( { int createdNewObj = 0; + Tcl_Obj *valueToAssign; if (!objResultPtr) { - objResultPtr = valuePtr; + valueToAssign = valuePtr; } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); + valueToAssign = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; + } else { + valueToAssign = objResultPtr; } - if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv) - != TCL_OK) { + if (Tcl_ListObjReplace(interp, valueToAssign, len, 0, + objc, objv) != TCL_OK) { + if (createdNewObj) { + TclDecrRefCount(valueToAssign); + } goto errorInLappendListPtr; } } DECACHE_STACK_INFO(); + Tcl_IncrRefCount(valueToAssign); objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, - part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd); + part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd); + TclDecrRefCount(valueToAssign); CACHE_STACK_INFO(); if (!objResultPtr) { errorInLappendListPtr: - if (createdNewObj) { - TclDecrRefCount(objResultPtr); - } TRACE_ERROR(interp); goto gotError; } diff --git a/tests/execute.test b/tests/execute.test index e1ed68b..e9668a9 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1066,6 +1066,45 @@ test execute-11.3 {Bug a0ece9d6d4} -setup { trace remove execution crash enterstep {apply {args {info frame -2}}} rename crash {} } -result 1 + +test execute-12.1 {failing multi-lappend to unshared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.2 {failing multi-lappend to shared} -setup { + unset -nocomplain x y +} -body { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 +} -cleanup { + unset -nocomplain x y +} -returnCodes error -result {can't set "x": boo} +test execute-12.3 {failing multi-lappend to unshared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} +test execute-12.4 {failing multi-lappend to shared: LVT} -body { + apply {{} { + set x 1 + lappend x 2 3 + set y $x + trace add variable x write {apply {args {error boo}}} + lappend x 4 5 + }} +} -returnCodes error -result {can't set "x": boo} # cleanup if {[info commands testobj] != {}} { -- cgit v0.12 From 8ab0ae062eb80ca8ab58df2ad8b08c8fe5503959 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 21 Jun 2019 19:22:07 +0000 Subject: closes [f8a33ce3db5d8cc2]: Tcl_Exit uses system exit as fallback if Tcl-subsystems are not (yet) initialized (or initialization fails). --- generic/tclEvent.c | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index b0b8188..b0bfc15 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -944,16 +944,20 @@ Tcl_Exit( currentAppExitPtr = appExitPtr; Tcl_MutexUnlock(&exitMutex); + /* + * Warning: this function SHOULD NOT return, as there is code that depends + * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone + * returns, so critical is this dependcy. + * + * If subsystems are not (yet) initialized, proper Tcl-finalization is + * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2]. + */ + if (currentAppExitPtr) { - /* - * Warning: this code SHOULD NOT return, as there is code that depends - * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone - * returns, so critical is this dependcy. - */ currentAppExitPtr(INT2PTR(status)); - Tcl_Panic("AppExitProc returned unexpectedly"); - } else { + + } else if (subsystemsInitialized) { if (TclFullFinalizationRequested()) { @@ -986,9 +990,10 @@ Tcl_Exit( FinalizeThread(/* quick */ 1); } - TclpExit(status); - Tcl_Panic("OS exit failed!"); } + + TclpExit(status); + Tcl_Panic("OS exit failed!"); } /* -- cgit v0.12 From 9489b8b506999d9ec543ed3e626cb32ea3a8394a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 06:56:26 +0000 Subject: Squelch C4244 warning on any MSVC compiler. --- win/tclWinPort.h | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 29b1447..20b2fe0 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -480,10 +480,12 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if defined(_MSC_VER) && (_MSC_VER >= 1400) +#if defined(_MSC_VER) # pragma warning(disable:4244) -# pragma warning(disable:4267) -# pragma warning(disable:4996) +# if _MSC_VER >= 1400 +# pragma warning(disable:4267) +# pragma warning(disable:4996) +# endif #endif /* -- cgit v0.12 From be26adf83b00a077251c7242792c50c23fa0baa7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 16:09:33 +0000 Subject: fixed build with MSVC 6.0 --- generic/tclCmdMZ.c | 14 +++++++------- generic/tclExecute.c | 9 +++------ generic/tclInt.h | 7 +++++++ win/tclWinFile.c | 1 - 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bc03d73..d36b0f0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3986,14 +3986,14 @@ Tcl_TimeRateObjCmd( register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideUInt count = 0; /* Holds repetition count */ + TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ - Tcl_WideUInt maxcnt = WIDE_MAX; + TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ - Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster + TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max + TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid @@ -4363,13 +4363,13 @@ Tcl_TimeRateObjCmd( { Tcl_Obj *objarr[8], **objs = objarr; - Tcl_WideUInt usec, val; + TclWideMUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ - usec = (Tcl_WideUInt)(middle - start); + usec = (TclWideMUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* @@ -4398,7 +4398,7 @@ Tcl_TimeRateObjCmd( * Estimate the time of overhead (microsecs). */ - Tcl_WideUInt curOverhead = overhead * count; + TclWideMUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 265b82f..0c2baab 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4938,7 +4938,7 @@ TclExecuteByteCode( } #endif { - mp_int big2; + mp_int big1, big2; Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); @@ -4956,8 +4956,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromLong(&big1, l1); mp_add(&big2, &big1, &big2); mp_clear(&big1); @@ -4994,7 +4992,8 @@ TclExecuteByteCode( NEXT_INST_F(1, 2, 1); } { - mp_int big2; + mp_int big1, big2; + Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); /* TODO: internals intrusion */ @@ -5011,8 +5010,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromWideInt(&big1, w1); mp_add(&big2, &big1, &big2); mp_clear(&big1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 8b4ccc5..974dd0d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2773,6 +2773,13 @@ MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclpFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +/* TclWideMUInt -- wide integer used for measurement calculations: */ +#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) +# define TclWideMUInt Tcl_WideUInt +#else +/* older MSVS may not allow conversions between unsigned __int64 and double) */ +# define TclWideMUInt Tcl_WideInt +#endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8ee4bce..d582664 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,7 +17,6 @@ #include #include #include /* For TclpGetUserHome(). */ -#include /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 -- cgit v0.12 From 334b8029eddb4e6df592c5f540ade0fd957a72c1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 17:45:23 +0000 Subject: nmakehlp: fixed const qualifier --- win/nmakehlp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 0439d1c..6532f8a 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -74,7 +74,7 @@ main( char msg[300]; DWORD dwWritten; int chars; - char *s; + const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. -- cgit v0.12 From 9392d9001aff32b293b587f531e08a54f534b2c2 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 18:59:09 +0000 Subject: restore userenv, used in 8.6 --- win/tclWinFile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 49f85cb..2f35d4a 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,6 +17,7 @@ #include #include #include /* For TclpGetUserHome(). */ +#include /* For TclpGetUserHome(). */ #include /* For GetNamedSecurityInfo */ #ifdef _MSC_VER -- cgit v0.12 From 5ef1c629dfce15837e4cb375f572a85c36a27773 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 22:27:43 +0000 Subject: Makef tclTomMath.h work with VC++ 6.0 --- generic/tclTomMath.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index bbcb4bc..9da642e 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -84,7 +84,11 @@ typedef unsigned int mp_digit; #define MP_DIGIT_DECLARED #endif #ifndef MP_WORD_DECLARED +#ifdef _WIN32 +typedef unsigned __int64 mp_word; +#else typedef unsigned long long mp_word; +#endif #define MP_WORD_DECLARED #endif -- cgit v0.12