summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclClock.c370
-rwxr-xr-xlibrary/clock.tcl75
-rw-r--r--library/init.tcl2
-rw-r--r--tests-perf/clock.perf.tcl59
4 files changed, 415 insertions, 91 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 24ed095..6d619e0 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -81,7 +81,7 @@ typedef enum ClockLiteral {
#endif
LIT__END
} ClockLiteral;
-static const char *const literals[] = {
+static const char *const Literals[] = {
"",
"%a %b %d %H:%M:%S %Z %Y",
"BCE", "C",
@@ -114,6 +114,14 @@ static const char *const literals[] = {
typedef struct ClockClientData {
size_t refCount; /* Number of live references. */
Tcl_Obj **literals; /* Pool of object literals. */
+ /* Cache for current clock parameters, imparted via "configure" */
+ unsigned int LastTZEpoch;
+ Tcl_Obj *LastSystemTimeZone;
+ Tcl_Obj *SystemSetupTZData;
+ Tcl_Obj *GMTSetupTimeZone;
+ Tcl_Obj *GMTSetupTZData;
+ Tcl_Obj *LastSetupTimeZone;
+ Tcl_Obj *LastSetupTZData;
} ClockClientData;
/*
@@ -171,6 +179,8 @@ static int ConvertLocalToUTCUsingTable(Tcl_Interp *,
TclDateFields *, int, Tcl_Obj *const[]);
static int ConvertLocalToUTCUsingC(Tcl_Interp *,
TclDateFields *, int);
+static int ClockConfigureObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
int, Tcl_Obj *const *);
static void GetYearWeekDay(TclDateFields *, int);
@@ -222,6 +232,7 @@ static int ClockFreeScan(
Tcl_Obj *strObj, Tcl_WideInt baseVal,
Tcl_Obj *timezoneObj, Tcl_Obj *locale);
static struct tm * ThreadSafeLocalTime(const time_t *);
+static unsigned int TzsetGetEpoch(void);
static void TzsetIfNecessary(void);
static void ClockDeleteCmdProc(ClientData);
@@ -245,6 +256,7 @@ static const struct ClockCommand clockCommands[] = {
{ "milliseconds", ClockMillisecondsObjCmd },
{ "seconds", ClockSecondsObjCmd },
{ "scan", ClockScanObjCmd },
+ { "configure", ClockConfigureObjCmd },
{ "Oldscan", TclClockOldscanObjCmd },
{ "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
{ "GetDateFields", ClockGetdatefieldsObjCmd },
@@ -302,9 +314,16 @@ TclClockInit(
data->refCount = 0;
data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < LIT__END; ++i) {
- data->literals[i] = Tcl_NewStringObj(literals[i], -1);
+ data->literals[i] = Tcl_NewStringObj(Literals[i], -1);
Tcl_IncrRefCount(data->literals[i]);
}
+ data->LastTZEpoch = 0;
+ data->LastSystemTimeZone = NULL;
+ data->SystemSetupTZData = NULL;
+ data->GMTSetupTimeZone = NULL;
+ data->GMTSetupTZData = NULL;
+ data->LastSetupTimeZone = NULL;
+ data->LastSetupTZData = NULL;
/*
* Install the commands.
@@ -322,6 +341,191 @@ TclClockInit(
/*
*----------------------------------------------------------------------
+ *
+ * ClockDeleteCmdProc --
+ *
+ * Remove a reference to the clock client data, and clean up memory
+ * when it's all gone.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockDeleteCmdProc(
+ ClientData clientData) /* Opaque pointer to the client data */
+{
+ ClockClientData *data = clientData;
+ int i;
+
+ if (data->refCount-- <= 1) {
+ for (i = 0; i < LIT__END; ++i) {
+ Tcl_DecrRefCount(data->literals[i]);
+ }
+
+ if (data->LastSystemTimeZone) {
+ Tcl_DecrRefCount(data->LastSystemTimeZone);
+ }
+ if (data->GMTSetupTimeZone) {
+ Tcl_DecrRefCount(data->GMTSetupTimeZone);
+ }
+ if (data->LastSetupTimeZone) {
+ Tcl_DecrRefCount(data->LastSetupTimeZone);
+ }
+
+ ckfree(data->literals);
+ ckfree(data);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ */
+inline Tcl_Obj *
+NormTimezoneObj(
+ ClockClientData *dataPtr, /* Client data containing literal pool */
+ Tcl_Obj * timezoneObj)
+{
+ const char * tz;
+ if ( timezoneObj == dataPtr->literals[LIT_GMT]
+ || timezoneObj == dataPtr->LastSystemTimeZone
+ || timezoneObj == dataPtr->LastSetupTimeZone
+ ) {
+ return timezoneObj;
+ }
+
+ tz = TclGetString(timezoneObj);
+ if (
+ strcmp(tz, Literals[LIT_GMT]) == 0
+ ) {
+ timezoneObj = dataPtr->literals[LIT_GMT];
+ }
+ else
+ if (dataPtr->LastSystemTimeZone != NULL &&
+ (timezoneObj == dataPtr->LastSystemTimeZone
+ || strcmp(tz, TclGetString(dataPtr->LastSystemTimeZone)) == 0
+ )
+ ) {
+ timezoneObj = dataPtr->LastSystemTimeZone;
+ }
+ else
+ if (dataPtr->LastSetupTimeZone != NULL &&
+ (timezoneObj == dataPtr->LastSetupTimeZone
+ || strcmp(tz, TclGetString(dataPtr->LastSetupTimeZone)) == 0
+ )
+ ) {
+ timezoneObj = dataPtr->LastSetupTimeZone;
+ }
+ return timezoneObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ */
+static int
+ClockConfigureObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter vector */
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj **litPtr = dataPtr->literals;
+
+ static const char *const options[] = {
+ "-system-tz", "-setup-tz", "-clear",
+ NULL
+ };
+ enum optionInd {
+ CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CLEAR_CACHE,
+ CLOCK_SETUP_GMT, CLOCK_SETUP_NOP
+ };
+ int optionIndex; /* Index of an option. */
+ int i;
+
+ for (i = 1; i < objc; i+=2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options,
+ "option", 0, &optionIndex) != TCL_OK) {
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
+ Tcl_GetString(objv[i]), NULL);
+ return TCL_ERROR;
+ }
+ if (optionIndex == CLOCK_SYSTEM_TZ || optionIndex == CLOCK_CLEAR_CACHE) {
+ if (dataPtr->LastSystemTimeZone) {
+ Tcl_DecrRefCount(dataPtr->LastSystemTimeZone);
+ dataPtr->LastSystemTimeZone = NULL;
+ dataPtr->SystemSetupTZData = NULL;
+ }
+ if (optionIndex != CLOCK_CLEAR_CACHE) {
+ /* validate current tz-epoch */
+ unsigned int lastTZEpoch = TzsetGetEpoch();
+ if (i+1 < objc) {
+ Tcl_IncrRefCount(
+ dataPtr->LastSystemTimeZone = objv[i+1]);
+ dataPtr->LastTZEpoch = lastTZEpoch;
+ } else if (dataPtr->LastSystemTimeZone
+ && dataPtr->LastTZEpoch == lastTZEpoch) {
+ Tcl_SetObjResult(interp, dataPtr->LastSystemTimeZone);
+ }
+ }
+ }
+ if (optionIndex == CLOCK_SETUP_TZ || optionIndex == CLOCK_CLEAR_CACHE) {
+ Tcl_Obj *timezoneObj = NULL;
+ /* differentiate GMT and system zones, because used often */
+ if (i+1 < objc) {
+ timezoneObj = NormTimezoneObj(dataPtr, objv[i+1]);
+ if (optionIndex == CLOCK_SETUP_TZ) {
+ if (timezoneObj == litPtr[LIT_GMT]) {
+ optionIndex = CLOCK_SETUP_GMT;
+ } else if (timezoneObj == dataPtr->LastSystemTimeZone) {
+ optionIndex = CLOCK_SETUP_NOP;
+ }
+ }
+ }
+
+ if (optionIndex == CLOCK_SETUP_GMT || optionIndex == CLOCK_CLEAR_CACHE) {
+ if (dataPtr->GMTSetupTimeZone) {
+ Tcl_DecrRefCount(dataPtr->GMTSetupTimeZone);
+ dataPtr->GMTSetupTimeZone = NULL;
+ dataPtr->GMTSetupTZData = NULL;
+ }
+ if (optionIndex != CLOCK_CLEAR_CACHE) {
+ if (i+1 < objc) {
+ Tcl_IncrRefCount(
+ dataPtr->GMTSetupTimeZone = timezoneObj);
+ } else if (dataPtr->GMTSetupTimeZone) {
+ Tcl_SetObjResult(interp, dataPtr->GMTSetupTimeZone);
+ }
+ }
+ }
+ if (optionIndex == CLOCK_SETUP_TZ || optionIndex == CLOCK_CLEAR_CACHE) {
+ if (dataPtr->LastSetupTimeZone) {
+ Tcl_DecrRefCount(dataPtr->LastSetupTimeZone);
+ dataPtr->LastSetupTimeZone = NULL;
+ dataPtr->LastSetupTZData = NULL;
+ }
+ if (optionIndex != CLOCK_CLEAR_CACHE) {
+ if (i+1 < objc) {
+ Tcl_IncrRefCount(
+ dataPtr->LastSetupTimeZone = timezoneObj);
+ } else if (dataPtr->LastSetupTimeZone) {
+ Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone);
+ }
+ }
+ }
+ }
+ if (optionIndex == CLOCK_CLEAR_CACHE) {
+ dataPtr->LastTZEpoch = 0;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
*/
inline Tcl_Obj*
ClockGetTZData(
@@ -331,9 +535,38 @@ ClockGetTZData(
{
ClockClientData *dataPtr = clientData;
Tcl_Obj **literals = dataPtr->literals;
+ Tcl_Obj *ret, **out = NULL;
+
+ /* differentiate GMT and system zones, because used often */
+ /* simple caching, because almost used the tz-data of last timezone, (unnecessary to
+ * touch the refCount of it, because it is always referenced in TZData array)
+ */
+ if (timezoneObj == dataPtr->LastSystemTimeZone) {
+ if (dataPtr->SystemSetupTZData != NULL)
+ return dataPtr->SystemSetupTZData;
+ out = &dataPtr->SystemSetupTZData;
+ }
+ else
+ if (timezoneObj == dataPtr->GMTSetupTimeZone) {
+ if (dataPtr->GMTSetupTZData != NULL)
+ return dataPtr->GMTSetupTZData;
+ out = &dataPtr->GMTSetupTZData;
+ }
+ else
+ if (timezoneObj == dataPtr->LastSetupTimeZone) {
+ if (dataPtr->LastSetupTZData != NULL) {
+ return dataPtr->LastSetupTZData;
+ }
+ out = &dataPtr->LastSetupTZData;
+ }
- return Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
+ ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
timezoneObj, TCL_LEAVE_ERR_MSG);
+
+ /* cache using corresponding slot */
+ if (ret != NULL && out != NULL)
+ *out = ret;
+ return ret;
}
/*
*----------------------------------------------------------------------
@@ -344,7 +577,15 @@ ClockGetSystemTimeZone(
Tcl_Interp *interp) /* Tcl interpreter */
{
ClockClientData *dataPtr = clientData;
- Tcl_Obj **literals = dataPtr->literals;
+ Tcl_Obj **literals;
+
+ /* if known (cached and same epoch) - return now */
+ if (dataPtr->LastSystemTimeZone != NULL
+ && dataPtr->LastTZEpoch == TzsetGetEpoch()) {
+ return dataPtr->LastSystemTimeZone;
+ }
+
+ literals = dataPtr->literals;
if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
return NULL;
@@ -354,7 +595,7 @@ ClockGetSystemTimeZone(
/*
*----------------------------------------------------------------------
*/
-static int
+static Tcl_Obj *
ClockSetupTimeZone(
ClientData clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
@@ -364,9 +605,22 @@ ClockSetupTimeZone(
Tcl_Obj **literals = dataPtr->literals;
Tcl_Obj *callargs[2];
+ /* differentiate GMT and system zones, because used often and already set */
+ timezoneObj = NormTimezoneObj(dataPtr, timezoneObj);
+ if ( timezoneObj == dataPtr->GMTSetupTimeZone
+ || timezoneObj == dataPtr->LastSystemTimeZone
+ || timezoneObj == dataPtr->LastSetupTimeZone
+ ) {
+ return timezoneObj;
+ }
+
callargs[0] = literals[LIT_SETUPTIMEZONE];
callargs[1] = timezoneObj;
- return Tcl_EvalObjv(interp, 2, callargs, 0);
+
+ if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
+ return NormTimezoneObj(dataPtr, timezoneObj);
+ }
+ return NULL;
}
/*
*----------------------------------------------------------------------
@@ -1752,12 +2006,10 @@ static int
IsGregorianLeapYear(
TclDateFields *fields) /* Date to test */
{
- int year;
+ int year = fields->year;
if (fields->era == BCE) {
- year = 1 - fields->year;
- } else {
- year = fields->year;
+ year = 1 - year;
}
if (year%4 != 0) {
return 0;
@@ -2313,13 +2565,15 @@ ClockFreeScan(
DateInfo yy; /* parse structure of TclClockFreeScan */
TclDateFields date; /* date fields used for converting from seconds */
+ TclDateFields date2; /* date fields used for in-between calculation */
Tcl_Obj *tzdata;
int secondOfDay; /* Seconds of day (time only calculation) */
Tcl_WideInt seconds;
int ret = TCL_ERROR;
- Tcl_Obj *cleanUpList = Tcl_NewObj();
+ // Tcl_Obj *cleanUpList = Tcl_NewObj();
date.tzName = NULL;
+ date2.tzName = NULL;
/* If time zone not specified use system time zone */
if (timezoneObj == NULL ||
@@ -2328,12 +2582,13 @@ ClockFreeScan(
if (timezoneObj == NULL) {
goto done;
}
- Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj);
+ // Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj);
}
/* Get the data for time changes in the given zone */
- if (ClockSetupTimeZone(clientData, interp, timezoneObj) != TCL_OK) {
+ timezoneObj = ClockSetupTimeZone(clientData, interp, timezoneObj);
+ if (timezoneObj == NULL) {
goto done;
}
@@ -2366,9 +2621,8 @@ ClockFreeScan(
if (TclClockFreeScan(interp, &yy) != TCL_OK) {
Tcl_Obj *msg = Tcl_NewObj();
- Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"",
- yy.dateInput, "\":",
- TclGetString(Tcl_GetObjResult(interp)));
+ Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s",
+ Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp)));
Tcl_SetObjResult(interp, msg);
goto done;
}
@@ -2405,8 +2659,9 @@ ClockFreeScan(
int dstFlag = 1 - yy.dateDSTmode;
timezoneObj = ClockFormatNumericTimeZone(
60 * minEast + 3600 * dstFlag);
- Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj);
- if (ClockSetupTimeZone(clientData, interp, timezoneObj) != TCL_OK) {
+ // Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj);
+ timezoneObj = ClockSetupTimeZone(clientData, interp, timezoneObj);
+ if (timezoneObj == NULL) {
goto done;
}
tzdata = ClockGetTZData(clientData, interp, timezoneObj);
@@ -2458,7 +2713,7 @@ ClockFreeScan(
if (yy.dateHaveRel) {
- /* [SB] TODO: rewrite it in C: * /
+ /*
seconds = [add $seconds \
yy.dateRelMonth months yy.dateRelDay days yy.dateRelMonthSecond seconds \
-timezone $timezone -locale $locale]
@@ -2470,17 +2725,21 @@ ClockFreeScan(
*/
if (yy.dateHaveDay && !yy.dateHaveDate) {
- TclDateFields date2;
- date2.tzName = NULL;
+ memcpy(&date2, &date, sizeof(date));
+ if (date2.tzName != NULL) {
+ Tcl_IncrRefCount(date2.tzName);
+ }
+ /*
SetDateFieldsTimeZone(&date2, timezoneObj);
date2.seconds = date.seconds;
if (ClockGetDateFields(interp, &date2, tzdata, GREGORIAN_CHANGE_DATE)
!= TCL_OK) {
- SetDateFieldsTimeZone(&date2, NULL);
goto done;
}
+ */
+
date2.era = CE;
date2.julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date2.julianDay + 6)
+ 7 * yy.dateDayOrdinal;
@@ -2493,13 +2752,12 @@ ClockFreeScan(
+ ( 86400 * (Tcl_WideInt)date2.julianDay )
+ secondOfDay;
- SetDateFieldsTimeZone(&date2, timezoneObj);
+ // check set time zone again may be really necessary here:
+ // SetDateFieldsTimeZone(&date2, timezoneObj);
if (ConvertLocalToUTC(interp, &date2, tzdata, GREGORIAN_CHANGE_DATE)
!= TCL_OK) {
- SetDateFieldsTimeZone(&date2, NULL);
goto done;
}
- SetDateFieldsTimeZone(&date2, NULL);
seconds = date2.seconds;
}
@@ -2536,7 +2794,10 @@ done:
if (date.tzName != NULL) {
Tcl_DecrRefCount(date.tzName);
}
- Tcl_DecrRefCount(cleanUpList);
+ if (date2.tzName != NULL) {
+ Tcl_DecrRefCount(date2.tzName);
+ }
+ // Tcl_DecrRefCount(cleanUpList);
if (ret != TCL_OK) {
return ret;
@@ -2599,15 +2860,30 @@ ClockSecondsObjCmd(
*----------------------------------------------------------------------
*/
-static void
-TzsetIfNecessary(void)
+static unsigned int
+TzsetGetEpoch(void)
{
static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
- * clockMutex. */
- const char *tzIsNow; /* Current value of TZ */
+ * clockMutex. */
+ static long tzNextRefresh = 0; /* Latence before next refresh */
+ static unsigned int tzWasEpoch = 1; /* Epoch, signals that TZ changed */
+
+ const char *tzIsNow; /* Current value of TZ */
+
+ /* fast check whether environment was changed (once per second) */
+ Tcl_Time now;
+ Tcl_GetTime(&now);
+ if (now.sec < tzNextRefresh) {
+ return tzWasEpoch;
+ }
+ tzNextRefresh = now.sec + 1;
+ /* check in lock */
Tcl_MutexLock(&clockMutex);
- tzIsNow = getenv("TZ");
+ tzIsNow = getenv("TCL_TZ");
+ if (tzIsNow == NULL) {
+ tzIsNow = getenv("TZ");
+ }
if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
|| strcmp(tzIsNow, tzWas) != 0)) {
tzset();
@@ -2616,42 +2892,22 @@ TzsetIfNecessary(void)
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
+ tzWasEpoch++;
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
if (tzWas != INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
+ tzWasEpoch++;
}
Tcl_MutexUnlock(&clockMutex);
+
+ return tzWasEpoch;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * ClockDeleteCmdProc --
- *
- * Remove a reference to the clock client data, and clean up memory
- * when it's all gone.
- *
- * Results:
- * None.
- *
- *----------------------------------------------------------------------
- */
static void
-ClockDeleteCmdProc(
- ClientData clientData) /* Opaque pointer to the client data */
+TzsetIfNecessary(void)
{
- ClockClientData *data = clientData;
- int i;
-
- if (data->refCount-- <= 1) {
- for (i = 0; i < LIT__END; ++i) {
- Tcl_DecrRefCount(data->literals[i]);
- }
- ckfree(data->literals);
- ckfree(data);
- }
+ TzsetGetEpoch();
}
/*
diff --git a/library/clock.tcl b/library/clock.tcl
index 9c3f95c..90b3c69 100755
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -633,10 +633,6 @@ proc ::tcl::clock::Initialize {} {
# in the given locales and dictionaries
# mapping the numerals to their numeric
# values.
- # variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists,
- # it contains the value of the
- # system time zone, as determined from
- # the environment.
variable TimeZoneBad {}; # Dictionary whose keys are time zone
# names and whose values are 1 if
# the time zone is unknown and 0
@@ -2984,13 +2980,12 @@ proc ::tcl::clock::InterpretHMS { date } {
# Returns the system time zone.
#
# Side effects:
-# Stores the sustem time zone in the 'CachedSystemTimeZone'
-# variable, since determining it may be an expensive process.
+# Stores the sustem time zone in engine configuration, since
+# determining it may be an expensive process.
#
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
- variable CachedSystemTimeZone
variable TimeZoneBad
if {[set result [getenv TCL_TZ]] ne {}} {
@@ -2999,29 +2994,33 @@ proc ::tcl::clock::GetSystemTimeZone {} {
set timezone $result
}
if {![info exists timezone]} {
- # Cache the time zone only if it was detected by one of the
- # expensive methods.
- if { [info exists CachedSystemTimeZone] } {
- set timezone $CachedSystemTimeZone
- } elseif { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
+ # ask engine for the cached timezone:
+ set timezone [configure -system-tz]
+ if { $timezone ne "" } {
+ return $timezone
}
- set CachedSystemTimeZone $timezone
+ if { $::tcl_platform(platform) eq {windows} } {
+ set timezone [GuessWindowsTimeZone]
+ } elseif { [file exists /etc/localtime]
+ && ![catch {ReadZoneinfoFile \
+ Tcl/Localtime /etc/localtime}] } {
+ set timezone :Tcl/Localtime
+ } else {
+ set timezone :localtime
+ }
}
if { ![dict exists $TimeZoneBad $timezone] } {
- dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
+ catch {SetupTimeZone $timezone}
}
- if { [dict get $TimeZoneBad $timezone] } {
- return :localtime
- } else {
- return $timezone
+
+ if { [dict exists $TimeZoneBad $timezone] } {
+ set timezone :localtime
}
+
+ # tell backend - current system timezone:
+ configure -system-tz $timezone
+
+ return $timezone
}
#----------------------------------------------------------------------
@@ -3077,6 +3076,13 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
variable TZData
if {! [info exists TZData($timezone)] } {
+
+ variable TimeZoneBad
+ if { [dict exists $TimeZoneBad $timezone] } {
+ return -code error \
+ -errorcode [list CLOCK badTimeZone $timezone] \
+ "time zone \"$timezone\" not found"
+ }
variable MINWIDE
if { $timezone eq {:localtime} } {
# Nothing to do, we'll convert using the localtime function
@@ -3114,6 +3120,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
LoadZoneinfoFile [string range $timezone 1 end]
}]
} then {
+ dict set TimeZoneBad $timezone 1
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
@@ -3125,6 +3132,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
+ dict set TimeZoneBad $timezone 1
return -options $opts $data
} else {
set TZData($timezone) $data
@@ -3137,13 +3145,15 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
if { [catch { LoadTimeZoneFile $timezone }]
&& [catch { LoadZoneinfoFile $timezone } - opts] } {
dict unset opts -errorinfo
+ dict set TimeZoneBad $timezone 1
return -options $opts "time zone $timezone not found"
}
set TZData($timezone) $TZData(:$timezone)
}
}
- return
+ # tell backend - timezone is initialized:
+ configure -setup-tz $timezone
}
#----------------------------------------------------------------------
@@ -3214,12 +3224,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
if { [dict exists $WinZoneInfo $data] } {
set tzname [dict get $WinZoneInfo $data]
if { ! [dict exists $TimeZoneBad $tzname] } {
- dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
+ catch {SetupTimeZone $tzname}
}
} else {
set tzname {}
}
- if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
+ if { $tzname eq {} || [dict exists $TimeZoneBad $tzname] } {
lassign $data \
bias stdBias dstBias \
stdYear stdMonth stdDayOfWeek stdDayOfMonth \
@@ -4556,8 +4566,6 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } {
proc ::tcl::clock::ChangeCurrentLocale {args} {
variable FormatProc
variable LocaleNumeralCache
- variable CachedSystemTimeZone
- variable TimeZoneBad
foreach p [info procs [namespace current]::scanproc'*'current] {
rename $p {}
@@ -4590,9 +4598,11 @@ proc ::tcl::clock::ChangeCurrentLocale {args} {
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
variable LocaleNumeralCache
- variable CachedSystemTimeZone
variable TimeZoneBad
+ # tell backend - should invalidate:
+ configure -clear
+
foreach p [info procs [namespace current]::scanproc'*] {
rename $p {}
}
@@ -4600,9 +4610,8 @@ proc ::tcl::clock::ClearCaches {} {
rename $p {}
}
- catch {unset FormatProc}
+ unset -nocomplain FormatProc
set LocaleNumeralCache {}
- catch {unset CachedSystemTimeZone}
set TimeZoneBad {}
InitTZData
}
diff --git a/library/init.tcl b/library/init.tcl
index 4bbce51..5e452b0 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -178,7 +178,7 @@ if {[interp issafe]} {
# Auto-loading stubs for 'clock.tcl'
- foreach cmd {add format} {
+ foreach cmd {add format SetupTimeZone} {
proc ::tcl::clock::$cmd args {
variable TclLibDir
source -encoding utf-8 [file join $TclLibDir clock.tcl]
diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl
new file mode 100644
index 0000000..2e77a26
--- /dev/null
+++ b/tests-perf/clock.perf.tcl
@@ -0,0 +1,59 @@
+#!/usr/bin/tclsh
+# ------------------------------------------------------------------------
+#
+# test-performance.tcl --
+#
+# This file provides common performance tests for comparison of tcl-speed
+# degradation by switching between branches.
+# (currently for clock ensemble only)
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2014 Serg G. Brester (aka sebres)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+
+proc test-scan {{rep 100000}} {
+ foreach {comment c} {
+ "# FreeScan : relative date"
+ {clock scan "5 years 18 months 385 days" -base 0 -gmt 1}
+ "# FreeScan : time only with base"
+ {clock scan "19:18:30" -base 148863600 -gmt 1}
+ "# FreeScan : time only without base"
+ {clock scan "19:18:30" -gmt 1}
+ "# FreeScan : date, system time zone"
+ {clock scan "05/08/2016 20:18:30"}
+ "# FreeScan : date, supplied time zone"
+ {clock scan "05/08/2016 20:18:30" -timezone :CET}
+ "# FreeScan : date, supplied gmt (equivalent -timezone :GMT)"
+ {clock scan "05/08/2016 20:18:30" -gmt 1}
+ "# FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500)"
+ {clock scan "20:18:30 -0500" -base 148863600 -gmt 1}
+ "# FreeScan : time only, zone in string (exchange zones between system / gmt)"
+ {clock scan "19:18:30 GMT" -base 148863600}
+ } {
+ puts "\n% $comment\n% $c"
+ puts [clock format [{*}$c]]
+ puts [time $c $rep]
+ }
+}
+
+proc test-other {{rep 100000}} {
+ foreach {comment c} {
+ "# Bad zone"
+ {catch {clock scan "1 day" -timezone BAD_ZONE}}
+ } {
+ puts "\n% $comment\n% $c"
+ puts [if 1 $c]
+ puts [time $c $rep]
+ }
+}
+
+if 1 {;#
+ test-scan 100000
+ test-other 50000
+
+ puts \n**OK**
+};# \ No newline at end of file
generated by cgit v0.12 at 2024-07-21 11:13:16 (GMT)