From 0e260c3cee3072b0b318b96c63a6242dec096972 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 21:59:59 +0000 Subject: [temp-commit]: ClockFreeScan almost ready, test-performance cases merged --- generic/tclClock.c | 370 +++++++++++++++++++++++++++++++++++++++------- library/clock.tcl | 75 +++++----- library/init.tcl | 2 +- tests-perf/clock.perf.tcl | 59 ++++++++ 4 files changed, 415 insertions(+), 91 deletions(-) create mode 100644 tests-perf/clock.perf.tcl 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 -- cgit v0.12