diff options
| -rw-r--r-- | generic/tclClock.c | 19 | ||||
| -rw-r--r-- | generic/tclEnv.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | tests/expr.test | 5 |
4 files changed, 38 insertions, 2 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 810aeb2..f05a7a1 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2024,10 +2024,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 == INT2PTR(-1) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 76e45bb..7728439 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 { size_t 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; @@ -623,6 +629,7 @@ EnvTraceProc( if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); + TclEnvEpoch++; return NULL; } @@ -643,6 +650,7 @@ EnvTraceProc( value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); + TclEnvEpoch++; } /* @@ -666,6 +674,7 @@ EnvTraceProc( if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); + TclEnvEpoch++; } return NULL; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 3816eff..0c02f4c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -5093,6 +5093,13 @@ typedef struct NRE_callback { #define Tcl_Free TclpFree #endif +/* + * Other externals. + */ + +MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + #endif /* _TCLINT */ /* diff --git a/tests/expr.test b/tests/expr.test index 5171cde..982cd43 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -6698,9 +6698,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 WIDE_MIN special-case} { +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]] |