From 042e9a4f8ae09cf75efccd7697c9b1a53f83e70a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Feb 2021 18:48:47 +0000 Subject: Backport 3 additional test-cases from 8.6 for TCL_UTF_MAX>3 --- tests/utf.test | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/tests/utf.test b/tests/utf.test index c61082f..e65f352 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -783,9 +783,12 @@ test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring} { test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xA0] } 4 -test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { +test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF2\xA0\xA0\xA0] } 4 +test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF2\xA0\xA0\xA0] +} 1 test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A\u8820[testbytestring \xA0] } 4 @@ -846,9 +849,12 @@ test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} { testutfprev A[testbytestring \xE0\xA0\x80] 2 } 1 -test utf-7.39 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { +test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] } 4 +test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF0\x90\x80\x80] +} 1 test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF0\x90\x80\x80] 4 } 3 @@ -888,19 +894,22 @@ test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} { test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 4 -test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { +test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { + testutfprev A[testbytestring \xF4\x8F\xBF\xBF] +} 1 +test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 3 -test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { +test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4 } 1 -test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { +test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 2 -test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { +test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3 } 1 -test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { +test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2 } 1 test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { -- cgit v0.12 From f2c4a32d7fbff5e3b59d4d1594a55ea3dbf52837 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Feb 2021 07:55:08 +0000 Subject: Performance optimization in TzsetIfNecessary() function. Cherry-picked from sebres-8-6-clock-speedup-cr2 branch --- generic/tclClock.c | 19 ++++++++++++++++++- generic/tclEnv.c | 9 +++++++++ generic/tclInt.h | 7 +++++++ 3 files changed, 34 insertions(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 37883bb..2c5173a 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2029,10 +2029,27 @@ ClockSecondsObjCmd( static void TzsetIfNecessary(void) { - static char* tzWas = (char*)INT2PTR(-1); /* Previous value of TZ, protected by + static char *tzWas = (char *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ + static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, + that TZ changed via TCL */ const char *tzIsNow; /* Current value of TZ */ + /* + * Prevent performance regression on some platforms by resolving of system time zone: + * small latency for check whether environment was changed (once per second) + * no latency if environment was changed with tcl-env (compare both epoch values) + */ + Tcl_Time now; + Tcl_GetTime(&now); + if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { + return; + } + + tzEnvEpoch = TclEnvEpoch; + tzLastRefresh = now.sec; + Tcl_MutexLock(&clockMutex); tzIsNow = getenv("TZ"); if (tzIsNow != NULL && (tzWas == NULL || tzWas == (char*)INT2PTR(-1) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 15dd8b5..e4246a1 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -36,6 +36,11 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ # define techar char #endif + +/* MODULE_SCOPE */ +size_t TclEnvEpoch = 0; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + static struct { int cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment @@ -417,6 +422,7 @@ Tcl_PutEnv( value[0] = '\0'; TclSetEnv(name, value+1); } + TclEnvEpoch++; Tcl_DStringFree(&nameString); return 0; @@ -625,6 +631,7 @@ EnvTraceProc( if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); + TclEnvEpoch++; return NULL; } @@ -645,6 +652,7 @@ EnvTraceProc( value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); + TclEnvEpoch++; } /* @@ -668,6 +676,7 @@ EnvTraceProc( if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); + TclEnvEpoch++; } return NULL; } diff --git a/generic/tclInt.h b/generic/tclInt.h index df29da8..5da21b0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4977,6 +4977,13 @@ typedef struct NRE_callback { #define Tcl_Free(ptr) TclpFree(ptr) #endif +/* + * Other externals. + */ + +MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + #endif /* _TCLINT */ /* -- cgit v0.12 From 957890bf54197a9221fb3c3e65ef4cbc07490352 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Feb 2021 08:32:28 +0000 Subject: Two new testcases for abs() --- tests/expr.test | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/tests/expr.test b/tests/expr.test index b81c4a7..4fa6821 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -138,7 +138,7 @@ proc do_twelve_days {} { unset xxx return $result } - + # start of tests catch {unset a b i x} @@ -6722,6 +6722,12 @@ test expr-38.12 {abs and -0x0 [Bug 2954959]} { test expr-38.13 {abs and 0.0 [Bug 2954959]} { ::tcl::mathfunc::abs 1e-324 } 1e-324 +test expr-38.14 {abs and INT64_MIN special-case} { + ::tcl::mathfunc::abs -9223372036854775808 +} 9223372036854775808 +test expr-38.15 {abs and INT128_MIN special-case} { + ::tcl::mathfunc::abs -170141183460469231731687303715884105728 +} 170141183460469231731687303715884105728 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] -- cgit v0.12