From d886a33b76f26c9aa0866cd569f4b15bc2a68402 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Jan 2017 19:09:49 +0000 Subject: New performance measurement routine "timerate" in opposition to "time" the execution limited by fixed time (in milliseconds) instead of repetition count (more precise results, to prevent very long execution time it is no more necessary to estimate repetition count) Syntax: timerate ?-direct? ?-calibrate? ?-overhead double? command ?time? --- generic/tclBasic.c | 1 + generic/tclCmdMZ.c | 333 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 333 insertions(+), 1 deletion(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 81b3513..dec26b4 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -286,6 +286,7 @@ static const CmdInfo builtInCmds[] = { {"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0}, {"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE}, {"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"unload", Tcl_UnloadObjCmd, NULL, NULL, 0}, {"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE}, {"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE}, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 23e6bd1..c660596 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -17,6 +17,7 @@ */ #include "tclInt.h" +#include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" @@ -3984,7 +3985,7 @@ Tcl_TimeObjCmd( start = TclpGetWideClicks(); #endif while (i-- > 0) { - result = Tcl_EvalObjEx(interp, objPtr, 0); + result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); if (result != TCL_OK) { return result; } @@ -4024,6 +4025,336 @@ Tcl_TimeObjCmd( /* *---------------------------------------------------------------------- * + * Tcl_TimeRateObjCmd -- + * + * This object-based procedure is invoked to process the "timerate" Tcl + * command. + * This is similar to command "time", except the execution limited by + * given time (in milliseconds) instead of repetition count. + * + * Example: + * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]` + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_TimeRateObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + static + double measureOverhead = 0; /* global measure-overhead */ + double overhead = -1; /* given measure-overhead */ + register Tcl_Obj *objPtr; + register int result, i; + Tcl_Obj *calibrate = NULL, *direct = NULL; + Tcl_WideInt count = 0; /* Holds repetition count */ + Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; + /* Maximal running time (in milliseconds) */ + Tcl_WideInt threshold = 1; /* Current threshold for check time (faster + * repeat count without time check) */ + Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold + * additionally avoid divide to zero (never < 1) */ + register Tcl_WideInt start, middle, stop; +#ifndef TCL_WIDE_CLICKS + Tcl_Time now; +#endif + + static const char *const options[] = { + "-direct", "-overhead", "-calibrate", "--", NULL + }; + enum options { + TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST + }; + + NRE_callback *rootPtr; + ByteCode *codePtr = NULL; + + for (i = 1; i < objc - 1; i++) { + int index; + if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, + &index) != TCL_OK) { + break; + } + if (index == TMRT_LAST) { + i++; + break; + } + switch ((enum options) index) { + case TMRT_EV_DIRECT: + direct = objv[i]; + break; + case TMRT_OVERHEAD: + if (++i >= objc - 1) { + goto usage; + } + if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) { + return TCL_ERROR; + } + break; + case TMRT_CALIBRATE: + calibrate = objv[i]; + break; + } + } + + if (i >= objc || i < objc-2) { +usage: + Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?"); + return TCL_ERROR; + } + objPtr = objv[i++]; + if (i < objc) { + result = TclGetWideIntFromObj(interp, objv[i], &maxms); + if (result != TCL_OK) { + return result; + } + } + + /* if calibrate */ + if (calibrate) { + + /* if no time specified for the calibration */ + if (maxms == -0x7FFFFFFFFFFFFFFFL) { + Tcl_Obj *clobjv[6]; + Tcl_WideInt maxCalTime = 5000; + double lastMeasureOverhead = measureOverhead; + + clobjv[0] = objv[0]; + i = 1; + if (direct) { + clobjv[i++] = direct; + } + clobjv[i++] = objPtr; + + /* reset last measurement overhead */ + measureOverhead = (double)0; + + /* self-call with 100 milliseconds to warm-up, + * before entering the calibration cycle */ + TclNewLongObj(clobjv[i], 100); + Tcl_IncrRefCount(clobjv[i]); + result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + Tcl_DecrRefCount(clobjv[i]); + if (result != TCL_OK) { + return result; + } + + i--; + clobjv[i++] = calibrate; + clobjv[i++] = objPtr; + + /* set last measurement overhead to max */ + measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + + /* calibration cycle until it'll be preciser */ + maxms = -1000; + do { + lastMeasureOverhead = measureOverhead; + TclNewLongObj(clobjv[i], (int)maxms); + Tcl_IncrRefCount(clobjv[i]); + result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv); + Tcl_DecrRefCount(clobjv[i]); + if (result != TCL_OK) { + return result; + } + maxCalTime += maxms; + /* increase maxms for preciser calibration */ + maxms -= (-maxms / 4); + /* as long as new value more as 0.05% better */ + } while ( (measureOverhead >= lastMeasureOverhead + || measureOverhead / lastMeasureOverhead <= 0.9995) + && maxCalTime > 0 + ); + + return result; + } + if (maxms == 0) { + /* reset last measurement overhead */ + measureOverhead = 0; + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + return TCL_OK; + } + + /* if time is negative - make current overhead more precise */ + if (maxms > 0) { + /* set last measurement overhead to max */ + measureOverhead = (double)0x7FFFFFFFFFFFFFFFL; + } else { + maxms = -maxms; + } + + } + + if (maxms == -0x7FFFFFFFFFFFFFFFL) { + maxms = 1000; + } + if (overhead == -1) { + overhead = measureOverhead; + } + + /* be sure that resetting of result will not smudge the further measurement */ + Tcl_ResetResult(interp); + + /* compile object */ + if (!direct) { + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } + codePtr = TclCompileObj(interp, objPtr, NULL, 0); + TclPreserveByteCode(codePtr); + } + + /* get start and stop time */ +#ifndef TCL_WIDE_CLICKS + Tcl_GetTime(&now); + start = now.sec; start *= 1000000; start += now.usec; +#else + start = TclpGetWideClicks(); +#endif + + /* start measurement */ + stop = start + maxms * 1000; + middle = start; + while (1) { + /* eval single iteration */ + count++; + + if (!direct) { + /* precompiled */ + rootPtr = TOP_CB(interp); + result = TclNRExecuteByteCode(interp, codePtr); + result = TclNRRunCallbacks(interp, result, rootPtr); + } else { + /* eval */ + result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); + } + if (result != TCL_OK) { + goto done; + } + + /* don't check time up to threshold */ + if (--threshold > 0) continue; + + /* check stop time reached, estimate new threshold */ + #ifndef TCL_WIDE_CLICKS + Tcl_GetTime(&now); + middle = now.sec; middle *= 1000000; middle += now.usec; + #else + middle = TclpGetWideClicks(); + #endif + if (middle >= stop) { + break; + } + /* average iteration time in microsecs */ + threshold = (middle - start) / count; + if (threshold > maxIterTm) { + maxIterTm = threshold; + } + /* as relation between remaining time and time since last check */ + threshold = ((stop - middle) / maxIterTm) / 4; + if (threshold > 100000) { /* fix for too large threshold */ + threshold = 100000; + } + } + + { + Tcl_Obj *objarr[8], **objs = objarr; + Tcl_WideInt val; + const char *fmt; + + middle -= start; /* execution time in microsecs */ + + /* if not calibrate */ + if (!calibrate) { + /* minimize influence of measurement overhead */ + if (overhead > 0) { + /* estimate the time of overhead (microsecs) */ + Tcl_WideInt curOverhead = overhead * count; + if (middle > curOverhead) { + middle -= curOverhead; + } else { + middle = 1; + } + } + } else { + /* calibration - obtaining new measurement overhead */ + if (measureOverhead > (double)middle / count) { + measureOverhead = (double)middle / count; + } + objs[0] = Tcl_NewDoubleObj(measureOverhead); + TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ + objs += 2; + } + + val = middle / count; /* microsecs per iteration */ + if (val >= 1000000) { + objs[0] = Tcl_NewWideIntObj(val); + } else { + if (val < 10) { fmt = "%.6f"; } else + if (val < 100) { fmt = "%.4f"; } else + if (val < 1000) { fmt = "%.3f"; } else + if (val < 10000) { fmt = "%.2f"; } else + { fmt = "%.1f"; }; + objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count); + } + + objs[2] = Tcl_NewWideIntObj(count); /* iterations */ + + /* calculate speed as rate (count) per sec */ + if (!middle) middle++; /* +1 ms, just to avoid divide by zero */ + if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) { + val = (count * 1000000) / middle; + if (val < 100000) { + if (val < 100) { fmt = "%.3f"; } else + if (val < 1000) { fmt = "%.2f"; } else + { fmt = "%.1f"; }; + objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle); + } else { + objs[4] = Tcl_NewWideIntObj(val); + } + } else { + objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); + } + + /* estimated net execution time (in millisecs) */ + if (!calibrate) { + objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); + TclNewLiteralStringObj(objs[7], "nett-ms"); + } + + /* + * Construct the result as a list because many programs have always parsed + * as such (extracting the first element, typically). + */ + + TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */ + TclNewLiteralStringObj(objs[3], "#"); + TclNewLiteralStringObj(objs[5], "#/sec"); + Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); + } + +done: + + if (codePtr != NULL) { + TclReleaseByteCode(codePtr); + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_TryObjCmd, TclNRTryObjCmd -- * * This procedure is invoked to process the "try" Tcl command. See the -- cgit v0.12 From d05b600d32d4e5a5bf8c06244a5fc1a0368ff87c Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Jan 2017 19:31:08 +0000 Subject: missing entry of tclInt.h added --- generic/tclInt.h | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclInt.h b/generic/tclInt.h index dd0c11a..1b37d84 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3461,6 +3461,9 @@ MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -- cgit v0.12 From de7fe4dd0fea3795e66e91109721ce68c5d7005b Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Jan 2017 19:33:23 +0000 Subject: [win] load win-registry library also in development environment (uninstalled) --- library/reg/pkgIndex.tcl | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index b1fe234..ab022ab 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,9 +1,19 @@ if {([info commands ::tcl::pkgconfig] eq "") - || ([info sharedlibextension] ne ".dll")} return + || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { + if {[info exists [file join $dir tclreg13g.dll]]} { package ifneeded registry 1.3.2 \ [list load [file join $dir tclreg13g.dll] registry] + } else { + package ifneeded registry 1.3.2 \ + [list load tclreg13g registry] + } } else { + if {[info exists [file join $dir tclreg13.dll]]} { package ifneeded registry 1.3.2 \ [list load [file join $dir tclreg13.dll] registry] + } else { + package ifneeded registry 1.3.2 \ + [list load tclreg13 registry] + } } -- cgit v0.12 -- cgit v0.12 From 4cc1178952c2e7eef686282007f5046adceb1ec1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 21:57:06 +0000 Subject: 1st try to rewrite clock in C --- generic/tclClock.c | 253 ++++++++++++++++++++++++++++++++++++++++------------- library/clock.tcl | 6 +- library/init.tcl | 28 +++--- 3 files changed, 212 insertions(+), 75 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 27009fd..e9a59f3 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -69,6 +69,7 @@ typedef enum ClockLiteral { LIT_MONTH, LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, LIT_YEAR, + LIT_FREESCAN, LIT__END } ClockLiteral; static const char *const literals[] = { @@ -84,7 +85,8 @@ static const char *const literals[] = { "julianDay", "localSeconds", "month", "seconds", "tzName", "tzOffset", - "year" + "year", + "::tcl::clock::FreeScan" }; /* @@ -190,6 +192,9 @@ static int ClockParseformatargsObjCmd( static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockScanObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static struct tm * ThreadSafeLocalTime(const time_t *); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); @@ -202,7 +207,7 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ }; @@ -213,6 +218,7 @@ static const struct ClockCommand clockCommands[] = { { "microseconds", ClockMicrosecondsObjCmd }, { "milliseconds", ClockMillisecondsObjCmd }, { "seconds", ClockSecondsObjCmd }, + { "scan", ClockScanObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, { "GetDateFields", ClockGetdatefieldsObjCmd }, @@ -466,6 +472,9 @@ ClockGetdatefieldsObjCmd( GetMonthDay(&fields); GetYearWeekDay(&fields, changeover); + +/************* split to use structured version from here ************/ + dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS], Tcl_NewWideIntObj(fields.localSeconds)); @@ -1507,9 +1516,9 @@ GetJulianDayFromEraYearMonthDay( * See above bug for details. The casts are necessary. */ if (ym1 >= 0) - ym1o4 = ym1 / 4; + ym1o4 = ym1 / 4; else { - ym1o4 = - (int) (((unsigned int) -ym1) / 4); + ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif if (ym1 % 4 < 0) { @@ -1843,6 +1852,96 @@ ClockMicrosecondsObjCmd( return TCL_OK; } + +typedef struct _ClockFmtScnArgs { + Tcl_Obj *formatObj; /* Format */ + Tcl_Obj *localeObj; /* Locale */ + Tcl_Obj *timezoneObj; /* Timezone */ + Tcl_Obj *baseObj; /* Base (scan only) */ +} _ClockFmtScnArgs; + +static int +_ClockParseFmtScnArgs( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[], /* Parameter vector */ + _ClockFmtScnArgs *resOpts, /* Result vector: format, locale, timezone... */ + int forScan /* Flag to differentiate between format and scan */ +) { + ClockClientData *dataPtr = clientData; + Tcl_Obj **litPtr = dataPtr->literals; + int gmtFlag = 0; + static const char *const options[2][6] = { + { /* Format command line options */ + "-format", "-gmt", "-locale", + "-timezone", NULL }, + { /* Scan command line options */ + "-format", "-gmt", "-locale", + "-timezone", "-base", NULL } + }; + enum optionInd { + CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, + CLOCK_FORMAT_TIMEZONE, CLOCK_FORMAT_BASE + }; + int optionIndex; /* Index of an option. */ + int saw = 0; /* Flag == 1 if option was seen already. */ + int i; + + /* + * Extract values for the keywords. + */ + + resOpts->formatObj = NULL; + resOpts->localeObj = NULL; + resOpts->timezoneObj = NULL; + resOpts->baseObj = NULL; + for (i = 2; i < objc; i+=2) { + if (Tcl_GetIndexFromObj(interp, objv[i], options[forScan], + "option", 0, &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[i]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case CLOCK_FORMAT_FORMAT: + resOpts->formatObj = objv[i+1]; + break; + case CLOCK_FORMAT_GMT: + if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ + return TCL_ERROR; + } + break; + case CLOCK_FORMAT_LOCALE: + resOpts->localeObj = objv[i+1]; + break; + case CLOCK_FORMAT_TIMEZONE: + resOpts->timezoneObj = objv[i+1]; + break; + case CLOCK_FORMAT_BASE: + resOpts->baseObj = objv[i+1]; + break; + } + saw |= 1 << optionIndex; + } + + /* + * Check options. + */ + + if ((saw & (1 << CLOCK_FORMAT_GMT)) + && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { + Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); + return TCL_ERROR; + } + if (gmtFlag) { + resOpts->timezoneObj = litPtr[LIT_GMT]; + } + + return TCL_OK; +} + /* *----------------------------------------------------------------------------- * @@ -1870,22 +1969,9 @@ ClockParseformatargsObjCmd( { ClockClientData *dataPtr = clientData; Tcl_Obj **litPtr = dataPtr->literals; - Tcl_Obj *results[3]; /* Format, locale and timezone */ -#define formatObj results[0] -#define localeObj results[1] -#define timezoneObj results[2] - int gmtFlag = 0; - static const char *const options[] = { /* Command line options expected */ - "-format", "-gmt", "-locale", - "-timezone", NULL }; - enum optionInd { - CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, - CLOCK_FORMAT_TIMEZONE - }; - int optionIndex; /* Index of an option. */ - int saw = 0; /* Flag == 1 if option was seen already. */ + _ClockFmtScnArgs resOpts; /* Format, locale and timezone */ Tcl_WideInt clockVal; /* Clock value - just used to parse. */ - int i; + int ret; /* * Args consist of a time followed by keyword-value pairs. @@ -1903,33 +1989,10 @@ ClockParseformatargsObjCmd( * Extract values for the keywords. */ - formatObj = litPtr[LIT__DEFAULT_FORMAT]; - localeObj = litPtr[LIT_C]; - timezoneObj = litPtr[LIT__NIL]; - for (i = 2; 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; - } - switch (optionIndex) { - case CLOCK_FORMAT_FORMAT: - formatObj = objv[i+1]; - break; - case CLOCK_FORMAT_GMT: - if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ - return TCL_ERROR; - } - break; - case CLOCK_FORMAT_LOCALE: - localeObj = objv[i+1]; - break; - case CLOCK_FORMAT_TIMEZONE: - timezoneObj = objv[i+1]; - break; - } - saw |= 1 << optionIndex; + ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, + &resOpts, 0); + if (ret != TCL_OK) { + return ret; } /* @@ -1939,26 +2002,98 @@ ClockParseformatargsObjCmd( if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { return TCL_ERROR; } - if ((saw & (1 << CLOCK_FORMAT_GMT)) - && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { - Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); - return TCL_ERROR; - } - if (gmtFlag) { - timezoneObj = litPtr[LIT_GMT]; - } + if (resOpts.formatObj == NULL) + resOpts.formatObj = litPtr[LIT__DEFAULT_FORMAT]; + if (resOpts.localeObj == NULL) + resOpts.localeObj = litPtr[LIT_C]; + if (resOpts.timezoneObj == NULL) + resOpts.timezoneObj = litPtr[LIT__NIL]; /* * Return options as a list. */ - Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&resOpts)); return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockScanObjCmd - + * + *---------------------------------------------------------------------- + */ + +int +ClockScanObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **litPtr = dataPtr->literals; + + Tcl_Time retClock; + char *string, *format = NULL; + int gmt, ret = 0; + char *locale; + _ClockFmtScnArgs opts; /* Format, locale, timezone and base */ + Tcl_WideInt baseVal; /* Base value */ + + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, "string " + "?-base seconds? " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + /* + * Extract values for the keywords. + */ + + ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, + &opts, 1); + if (ret != TCL_OK) { + return ret; + } + + if (opts.baseObj != NULL) { + if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_Time now; + Tcl_GetTime(&now); + baseVal = (Tcl_WideInt) now.sec; + } + + /* if free scan */ + if (opts.formatObj == NULL) { + Tcl_Obj *callargs[5]; + /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ + if (opts.localeObj != NULL) { + Tcl_SetResult(interp, + "legacy [clock scan] does not support -locale", TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); + return TCL_ERROR; + } + callargs[0] = litPtr[LIT_FREESCAN]; + callargs[1] = objv[1]; + callargs[2] = opts.baseObj != NULL ? opts.baseObj : Tcl_NewWideIntObj(baseVal); + callargs[3] = opts.timezoneObj != NULL ? opts.timezoneObj : litPtr[LIT__NIL]; + callargs[4] = opts.localeObj != NULL ? opts.localeObj : litPtr[LIT_C]; + return Tcl_EvalObjv(interp, 5, callargs, 0); + } -#undef timezoneObj -#undef localeObj -#undef formatObj + // **** + string = TclGetString(objv[1]); + // **** timezone = GetSystemTimeZone() + + return TCL_OK; } /*---------------------------------------------------------------------- diff --git a/library/clock.tcl b/library/clock.tcl index 535a67d..5b48eb3 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -1178,7 +1178,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { # #---------------------------------------------------------------------- -proc ::tcl::clock::scan { args } { +proc ::tcl::clock::__org_scan { args } { set format {} @@ -1300,7 +1300,9 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { variable TZData # Get the data for time changes in the given zone - + if {$timezone eq {}} { + set timezone [GetSystemTimeZone] + } try { SetupTimeZone $timezone } on error {retval opts} { diff --git a/library/init.tcl b/library/init.tcl index 544ea77..e6df12b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -66,12 +66,12 @@ namespace eval tcl { } if {![interp issafe]} { - variable Path [encoding dirs] - set Dir [file join $::tcl_library encoding] - if {$Dir ni $Path} { + variable Path [encoding dirs] + set Dir [file join $::tcl_library encoding] + if {$Dir ni $Path} { lappend Path $Dir encoding dirs $Path - } + } } # TIP #255 min and max functions @@ -171,14 +171,14 @@ if {[interp issafe]} { proc clock args { namespace eval ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ - -subcommands { - add clicks format microseconds milliseconds scan seconds - }] + [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ + -subcommands { + add clicks format microseconds milliseconds scan seconds + }] # Auto-loading stubs for 'clock.tcl' - foreach cmd {add format scan} { + foreach cmd {add format FreeScan} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] @@ -600,12 +600,12 @@ proc auto_import {pattern} { auto_load_index foreach pattern $patternList { - foreach name [array names auto_index $pattern] { - if {([namespace which -command $name] eq "") + foreach name [array names auto_index $pattern] { + if {([namespace which -command $name] eq "") && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { - namespace eval :: $auto_index($name) - } - } + namespace eval :: $auto_index($name) + } + } } } -- cgit v0.12 From 58f947e48be58a2371a0d24f957244796306d2ba Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 21:58:33 +0000 Subject: [temp-commit]: clock scan with several optimization porting, still not-ready --- generic/tclClock.c | 520 +++++++++++++++++++++++++++++++++++++++++++++++---- generic/tclDate.c | 497 +++++++++++++++++++++++------------------------- generic/tclDate.h | 77 ++++++++ generic/tclGetDate.y | 134 ++++++------- library/clock.tcl | 19 +- library/init.tcl | 2 +- win/makefile.vc | 4 +- 7 files changed, 870 insertions(+), 383 deletions(-) create mode 100644 generic/tclDate.h diff --git a/generic/tclClock.c b/generic/tclClock.c index e9a59f3..24ed095 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -14,6 +14,7 @@ */ #include "tclInt.h" +#include "tclDate.h" /* * Windows has mktime. The configurators do not check. @@ -28,6 +29,7 @@ */ #define JULIAN_DAY_POSIX_EPOCH 2440588 +#define GREGORIAN_CHANGE_DATE 2361222 #define SECONDS_PER_DAY 86400 #define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ * SECONDS_PER_DAY) @@ -69,7 +71,14 @@ typedef enum ClockLiteral { LIT_MONTH, LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, LIT_YEAR, + LIT_CURRENTYEARCENTURY, + LIT_YEAROFCENTURYSWITCH, + LIT_TZDATA, + LIT_GETSYSTEMTIMEZONE, + LIT_SETUPTIMEZONE, +#if 0 LIT_FREESCAN, +#endif LIT__END } ClockLiteral; static const char *const literals[] = { @@ -86,9 +95,18 @@ static const char *const literals[] = { "month", "seconds", "tzName", "tzOffset", "year", + "::tcl::clock::CurrentYearCentury", + "::tcl::clock::YearOfCenturySwitch", + "::tcl::clock::TZData", + "::tcl::clock::GetSystemTimeZone", + "::tcl::clock::SetupTimeZone", +#if 0 "::tcl::clock::FreeScan" +#endif }; +#define CurrentYearCentury 2000 + /* * Structure containing the client data for [clock] */ @@ -168,6 +186,10 @@ static int ClockClicksObjCmd( static int ClockConvertlocaltoutcObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); + +static int ClockGetDateFields(Tcl_Interp *interp, + TclDateFields *fields, Tcl_Obj *tzdata, + int changeover); static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -195,6 +217,10 @@ static int ClockSecondsObjCmd( static int ClockScanObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockFreeScan( + ClientData clientData, Tcl_Interp *interp, + Tcl_Obj *strObj, Tcl_WideInt baseVal, + Tcl_Obj *timezoneObj, Tcl_Obj *locale); static struct tm * ThreadSafeLocalTime(const time_t *); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); @@ -296,6 +322,123 @@ TclClockInit( /* *---------------------------------------------------------------------- + */ +inline Tcl_Obj* +ClockGetTZData( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *timezoneObj) /* Name of the timezone */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + + return Tcl_ObjGetVar2(interp, literals[LIT_TZDATA], + timezoneObj, TCL_LEAVE_ERR_MSG); +} +/* + *---------------------------------------------------------------------- + */ +static Tcl_Obj * +ClockGetSystemTimeZone( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + + if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { + return NULL; + } + return Tcl_GetObjResult(interp); +} +/* + *---------------------------------------------------------------------- + */ +static int +ClockSetupTimeZone( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *timezoneObj) +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + Tcl_Obj *callargs[2]; + + callargs[0] = literals[LIT_SETUPTIMEZONE]; + callargs[1] = timezoneObj; + return Tcl_EvalObjv(interp, 2, callargs, 0); +} +/* + *---------------------------------------------------------------------- + * ClockFormatNumericTimeZone - + * + * Formats a time zone as +hhmmss + * + * Parameters: + * z - Time zone in seconds east of Greenwich + * + * Results: + * Returns the time zone object (formatted in a numeric form) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +ClockFormatNumericTimeZone(int z) { + char sign = '+'; + int h, m; + if ( z < 0 ) { + z = -z; + sign = '-'; + } + h = z / 3600; + z %= 3600; + m = z / 60; + z %= 60; + if (z != 0) { + return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z); + } + return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); +} + +/* + *---------------------------------------------------------------------- + * [SB] TODO: make constans cacheable (once per second, etc.) ... + */ +inline int +ClockCurrentYearCentury( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + int year = 2000; + + Tcl_Obj * yearObj = Tcl_ObjGetVar2(interp, + literals[LIT_CURRENTYEARCENTURY], NULL, TCL_LEAVE_ERR_MSG); + Tcl_GetIntFromObj(NULL, yearObj, &year); + return year; +} +inline int +ClockGetYearOfCenturySwitch( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + int year = 37; + + Tcl_Obj * yearObj = Tcl_ObjGetVar2(interp, + literals[LIT_YEAROFCENTURYSWITCH], NULL, TCL_LEAVE_ERR_MSG); + Tcl_GetIntFromObj(NULL, yearObj, &year); + return year; +} + +/* + *---------------------------------------------------------------------- * * ClockConvertlocaltoutcObjCmd -- * @@ -426,6 +569,8 @@ ClockGetdatefieldsObjCmd( Tcl_Obj *const *literals = data->literals; int changeover; + fields.tzName = NULL; + /* * Check params. */ @@ -449,31 +594,14 @@ ClockGetdatefieldsObjCmd( return TCL_ERROR; } - /* - * Convert UTC time to local. - */ + /* Extract fields */ - if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { + if (ClockGetDateFields(interp, &fields, objv[2], changeover) + != TCL_OK) { return TCL_ERROR; } - /* - * Extract Julian day. - */ - - fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH) - / SECONDS_PER_DAY); - - /* - * Convert to Julian or Gregorian calendar. - */ - - GetGregorianEraYearDay(&fields, changeover); - GetMonthDay(&fields); - GetYearWeekDay(&fields, changeover); - - -/************* split to use structured version from here ************/ + /* Make dict of fields */ dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS], @@ -511,6 +639,59 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- + */ +int +ClockGetDateFields( + Tcl_Interp *interp, /* Tcl interpreter */ + TclDateFields *fields, /* Pointer to result fields, where + * fields->seconds contains date to extract */ + Tcl_Obj *tzdata, /* Time zone data object or NULL for gmt */ + int changeover) /* Julian Day Number */ +{ + /* + * Convert UTC time to local. + */ + + if (ConvertUTCToLocal(interp, fields, tzdata, changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Extract Julian day. + */ + + fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH) + / SECONDS_PER_DAY); + + /* + * Convert to Julian or Gregorian calendar. + */ + + GetGregorianEraYearDay(fields, changeover); + GetMonthDay(fields); + GetYearWeekDay(fields, changeover); + + return TCL_OK; +} + +inline +SetDateFieldsTimeZone( + TclDateFields *fields, + Tcl_Obj *timezoneObj) +{ + if (fields->tzName != timezoneObj) { + if (timezoneObj) { + Tcl_IncrRefCount(timezoneObj); + } + if (fields->tzName != NULL) { + Tcl_DecrRefCount(fields->tzName); + } + fields->tzName = timezoneObj; + } +} + +/* + *---------------------------------------------------------------------- * * ClockGetjuliandayfromerayearmonthdayObjCmd -- * @@ -1013,8 +1194,7 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - fields->tzName = cellv[3]; - Tcl_IncrRefCount(fields->tzName); + SetDateFieldsTimeZone(fields, cellv[3]); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -1107,8 +1287,7 @@ ConvertUTCToLocalUsingC( if (diff > 0) { sprintf(buffer+5, "%02d", diff); } - fields->tzName = Tcl_NewStringObj(buffer, -1); - Tcl_IncrRefCount(fields->tzName); + SetDateFieldsTimeZone(fields, Tcl_NewStringObj(buffer, -1)); return TCL_OK; } @@ -1968,7 +2147,7 @@ ClockParseformatargsObjCmd( Tcl_Obj *const objv[]) /* Parameter vector */ { ClockClientData *dataPtr = clientData; - Tcl_Obj **litPtr = dataPtr->literals; + Tcl_Obj **literals = dataPtr->literals; _ClockFmtScnArgs resOpts; /* Format, locale and timezone */ Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int ret; @@ -2003,11 +2182,11 @@ ClockParseformatargsObjCmd( return TCL_ERROR; } if (resOpts.formatObj == NULL) - resOpts.formatObj = litPtr[LIT__DEFAULT_FORMAT]; + resOpts.formatObj = literals[LIT__DEFAULT_FORMAT]; if (resOpts.localeObj == NULL) - resOpts.localeObj = litPtr[LIT_C]; + resOpts.localeObj = literals[LIT_C]; if (resOpts.timezoneObj == NULL) - resOpts.timezoneObj = litPtr[LIT__NIL]; + resOpts.timezoneObj = literals[LIT__NIL]; /* * Return options as a list. @@ -2032,7 +2211,7 @@ ClockScanObjCmd( Tcl_Obj *const objv[]) /* Parameter values */ { ClockClientData *dataPtr = clientData; - Tcl_Obj **litPtr = dataPtr->literals; + Tcl_Obj **literals = dataPtr->literals; Tcl_Time retClock; char *string, *format = NULL; @@ -2071,8 +2250,10 @@ ClockScanObjCmd( baseVal = (Tcl_WideInt) now.sec; } - /* if free scan */ + /* If free scan */ if (opts.formatObj == NULL) { +#if 0 + /* Tcled FreeScan proc - */ Tcl_Obj *callargs[5]; /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ if (opts.localeObj != NULL) { @@ -2081,18 +2262,287 @@ ClockScanObjCmd( Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); return TCL_ERROR; } - callargs[0] = litPtr[LIT_FREESCAN]; + callargs[0] = literals[LIT_FREESCAN]; callargs[1] = objv[1]; callargs[2] = opts.baseObj != NULL ? opts.baseObj : Tcl_NewWideIntObj(baseVal); - callargs[3] = opts.timezoneObj != NULL ? opts.timezoneObj : litPtr[LIT__NIL]; - callargs[4] = opts.localeObj != NULL ? opts.localeObj : litPtr[LIT_C]; + callargs[3] = opts.timezoneObj != NULL ? opts.timezoneObj : literals[LIT__NIL]; + callargs[4] = opts.localeObj != NULL ? opts.localeObj : literals[LIT_C]; return Tcl_EvalObjv(interp, 5, callargs, 0); +#else + /* Use compiled version of FreeScan - */ + + + /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ + if (opts.localeObj != NULL) { + Tcl_SetResult(interp, + "legacy [clock scan] does not support -locale", TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); + return TCL_ERROR; + } + return ClockFreeScan(clientData, interp, objv[1], baseVal, + opts.timezoneObj, opts.localeObj); +#endif } + // **** string = TclGetString(objv[1]); - // **** timezone = GetSystemTimeZone() + // **** timezone = ClockGetSystemTimeZone(clientData, interp) + /* + if (timezoneObj == NULL) { + goto done; + } + */ + + return TCL_OK; +} + +/*---------------------------------------------------------------------- + */ +int +ClockFreeScan( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *strObj, /* String containing the time to scan */ + Tcl_WideInt baseVal, /* Base time, expressed in seconds from the Epoch */ + Tcl_Obj *timezoneObj, /* Default time zone in which the time will be expressed */ + Tcl_Obj *locale) /* (Unused) Name of the locale where the time will be scanned. */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + + DateInfo yy; /* parse structure of TclClockFreeScan */ + TclDateFields date; /* date fields used for converting from seconds */ + Tcl_Obj *tzdata; + int secondOfDay; /* Seconds of day (time only calculation) */ + Tcl_WideInt seconds; + int ret = TCL_ERROR; + Tcl_Obj *cleanUpList = Tcl_NewObj(); + + date.tzName = NULL; + + /* If time zone not specified use system time zone */ + if (timezoneObj == NULL || + TclGetString(timezoneObj) == NULL || timezoneObj->length == 0) { + timezoneObj = ClockGetSystemTimeZone(clientData, interp); + if (timezoneObj == NULL) { + goto done; + } + Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj); + } + + /* Get the data for time changes in the given zone */ + + if (ClockSetupTimeZone(clientData, interp, timezoneObj) != TCL_OK) { + goto done; + } + + /* + * Extract year, month and day from the base time for the parser to use as + * defaults + */ + + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + goto done; + } + date.seconds = baseVal; + if (ClockGetDateFields(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; + } + + secondOfDay = date.localSeconds % 86400; + + /* + * Parse the date. The parser will fill a structure "yy" with date, time, + * time zone, relative month/day/seconds, relative weekday, ordinal month. + */ + yy.dateInput = Tcl_GetString(strObj); + + yy.dateYear = date.year; + yy.dateMonth = date.month; + yy.dateDay = date.dayOfMonth; + + 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_SetObjResult(interp, msg); + goto done; + } + + /* + * If the caller supplied a date in the string, update the date with + * the value. If the caller didn't specify a time with the date, default to + * midnight. + */ + + if (yy.dateHaveDate) { + if (yy.dateYear < 100) { + yy.dateYear += ClockCurrentYearCentury(clientData, interp); + if (yy.dateYear > ClockGetYearOfCenturySwitch(clientData, interp)) { + yy.dateYear -= 100; + } + } + date.era = CE; + date.year = yy.dateYear; + date.month = yy.dateMonth; + date.dayOfMonth = yy.dateDay; + if (yy.dateHaveTime == 0) { + yy.dateHaveTime = -1; + } + } + + /* + * If the caller supplied a time zone in the string, make it into a time + * zone indicator of +-hhmm and setup this time zone. + */ + + if (yy.dateHaveZone) { + int minEast = -yy.dateTimezone; + int dstFlag = 1 - yy.dateDSTmode; + timezoneObj = ClockFormatNumericTimeZone( + 60 * minEast + 3600 * dstFlag); + Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj); + if (ClockSetupTimeZone(clientData, interp, timezoneObj) != TCL_OK) { + goto done; + } + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + goto done; + } + } + + SetDateFieldsTimeZone(&date, timezoneObj); + + /* Assemble date, time, zone into seconds-from-epoch */ + + GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + + if (yy.dateHaveTime == -1) { + secondOfDay = 0; + } + else + if (yy.dateHaveTime) { + secondOfDay = ToSeconds(yy.dateHour, yy.dateMinutes, + yy.dateSeconds, yy.dateMeridian); + } + else + if ( (yy.dateHaveDay && !yy.dateHaveDate) + || yy.dateHaveOrdinalMonth + || ( yy.dateHaveRel + && ( yy.dateRelMonth != 0 + || yy.dateRelDay != 0 ) ) + ) { + secondOfDay = 0; + } + + date.localSeconds = + -210866803200L + + ( 86400 * (Tcl_WideInt)date.julianDay ) + + secondOfDay; + + SetDateFieldsTimeZone(&date, timezoneObj); + if (ConvertLocalToUTC(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; + } + + seconds = date.seconds; + + /* + * Do relative times + */ + + 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] + */ + } + + /* + * Do relative weekday + */ + + if (yy.dateHaveDay && !yy.dateHaveDate) { + TclDateFields date2; + date2.tzName = NULL; + + 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; + if (yy.dateDayOrdinal > 0) { + date2.julianDay -= 7; + } + secondOfDay = date2.localSeconds % 86400; + date2.localSeconds = + -210866803200 + + ( 86400 * (Tcl_WideInt)date2.julianDay ) + + secondOfDay; + + SetDateFieldsTimeZone(&date2, timezoneObj); + if (ConvertLocalToUTC(interp, &date2, tzdata, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + SetDateFieldsTimeZone(&date2, NULL); + goto done; + } + SetDateFieldsTimeZone(&date2, NULL); + + seconds = date2.seconds; + } + + /* + * Do relative month + */ + + if (yy.dateHaveOrdinalMonth) { + int monthDiff; + if (yy.dateMonthOrdinal > 0) { + monthDiff = yy.dateMonth - date.month; + if (monthDiff <= 0) { + monthDiff += 12; + } + yy.dateMonthOrdinal--; + } else { + monthDiff = date.month - yy.dateMonth; + if (monthDiff >= 0) { + monthDiff -= 12; + } + yy.dateMonthOrdinal++; + } + /* [SB] TODO: rewrite it in C: * / + seconds = [add $seconds $yy.dateMonthOrdinal years $monthDiff months \ + -timezone $timezone -locale $locale] + */ + } + + ret = TCL_OK; + +done: + + if (date.tzName != NULL) { + Tcl_DecrRefCount(date.tzName); + } + Tcl_DecrRefCount(cleanUpList); + + if (ret != TCL_OK) { + return ret; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(seconds)); return TCL_OK; } diff --git a/generic/tclDate.c b/generic/tclDate.c index e4dd000..a31e0fc 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1,24 +1,22 @@ -/* A Bison parser, made by GNU Bison 2.3. */ +/* A Bison parser, made by GNU Bison 2.4.2. */ /* Skeleton implementation for Bison's Yacc-like parsers in C - - Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 - Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or modify + + Copyright (C) 1984, 1989-1990, 2000-2006, 2009-2010 Free Software + Foundation, Inc. + + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - + You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. */ + along with this program. If not, see . */ /* As a special exception, you may create a larger work that contains part or all of the Bison parser skeleton and distribute that work @@ -29,7 +27,7 @@ special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. - + This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ @@ -47,7 +45,7 @@ #define YYBISON 1 /* Bison version. */ -#define YYBISON_VERSION "2.3" +#define YYBISON_VERSION "2.4.2" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" @@ -55,65 +53,24 @@ /* Pure parsers. */ #define YYPURE 1 +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + /* Using locations. */ #define YYLSP_NEEDED 1 /* Substitute the variable and function names. */ -#define yyparse TclDateparse -#define yylex TclDatelex -#define yyerror TclDateerror -#define yylval TclDatelval -#define yychar TclDatechar -#define yydebug TclDatedebug -#define yynerrs TclDatenerrs -#define yylloc TclDatelloc - -/* Tokens. */ -#ifndef YYTOKENTYPE -# define YYTOKENTYPE - /* Put the tokens into the symbol table, so that GDB and other debuggers - know about them. */ - enum yytokentype { - tAGO = 258, - tDAY = 259, - tDAYZONE = 260, - tID = 261, - tMERIDIAN = 262, - tMONTH = 263, - tMONTH_UNIT = 264, - tSTARDATE = 265, - tSEC_UNIT = 266, - tSNUMBER = 267, - tUNUMBER = 268, - tZONE = 269, - tEPOCH = 270, - tDST = 271, - tISOBASE = 272, - tDAY_UNIT = 273, - tNEXT = 274 - }; -#endif -/* Tokens. */ -#define tAGO 258 -#define tDAY 259 -#define tDAYZONE 260 -#define tID 261 -#define tMERIDIAN 262 -#define tMONTH 263 -#define tMONTH_UNIT 264 -#define tSTARDATE 265 -#define tSEC_UNIT 266 -#define tSNUMBER 267 -#define tUNUMBER 268 -#define tZONE 269 -#define tEPOCH 270 -#define tDST 271 -#define tISOBASE 272 -#define tDAY_UNIT 273 -#define tNEXT 274 - - - +#define yyparse TclDateparse +#define yylex TclDatelex +#define yyerror TclDateerror +#define yylval TclDatelval +#define yychar TclDatechar +#define yydebug TclDatedebug +#define yynerrs TclDatenerrs +#define yylloc TclDatelloc /* Copy the first part of user declarations. */ @@ -129,6 +86,7 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * */ #include "tclInt.h" @@ -146,44 +104,7 @@ * parsed fields will be returned. */ -typedef struct DateInfo { - - Tcl_Obj* messages; /* Error messages */ - const char* separatrix; /* String separating messages */ - - time_t dateYear; - time_t dateMonth; - time_t dateDay; - int dateHaveDate; - - time_t dateHour; - time_t dateMinutes; - time_t dateSeconds; - int dateMeridian; - int dateHaveTime; - - time_t dateTimezone; - int dateDSTmode; - int dateHaveZone; - - time_t dateRelMonth; - time_t dateRelDay; - time_t dateRelSeconds; - int dateHaveRel; - - time_t dateMonthOrdinal; - int dateHaveOrdinalMonth; - - time_t dateDayOrdinal; - time_t dateDayNumber; - int dateHaveDay; - - const char *dateStart; - const char *dateInput; - time_t *dateRelPointer; - - int dateDigitCount; -} DateInfo; +#include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) @@ -246,13 +167,6 @@ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; @@ -274,19 +188,49 @@ typedef enum _MERIDIAN { # define YYTOKEN_TABLE 0 #endif + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + tAGO = 258, + tDAY = 259, + tDAYZONE = 260, + tID = 261, + tMERIDIAN = 262, + tMONTH = 263, + tMONTH_UNIT = 264, + tSTARDATE = 265, + tSEC_UNIT = 266, + tSNUMBER = 267, + tUNUMBER = 268, + tZONE = 269, + tEPOCH = 270, + tDST = 271, + tISOBASE = 272, + tDAY_UNIT = 273, + tNEXT = 274 + }; +#endif + + + #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED typedef union YYSTYPE - { + + time_t Number; enum _MERIDIAN Meridian; -} -/* Line 187 of yacc.c. */ - YYSTYPE; + + +} YYSTYPE; +# define YYSTYPE_IS_TRIVIAL 1 # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 -# define YYSTYPE_IS_TRIVIAL 1 #endif #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED @@ -316,14 +260,10 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); -static time_t ToSeconds(time_t Hours, time_t Minutes, - time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); -/* Line 216 of yacc.c. */ - #ifdef short # undef short @@ -359,15 +299,21 @@ typedef short int yytype_int16; #ifndef YYSIZE_T # ifdef __SIZE_TYPE__ # define YYSIZE_T __SIZE_TYPE__ -# else +# elif defined size_t # define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int # endif #endif #define YYSIZE_MAXIMUM ((YYSIZE_T) -1) #ifndef YY_ -# if YYENABLE_NLS +# if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ # define YY_(msgid) dgettext ("bison-runtime", msgid) @@ -392,14 +338,14 @@ typedef short int yytype_int16; #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static int -YYID (int i) +YYID (int yyi) #else static int -YYID (i) - int i; +YYID (yyi) + int yyi; #endif { - return i; + return yyi; } #endif @@ -481,9 +427,9 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */ /* A type that is properly aligned for any stack member. */ union yyalloc { - yytype_int16 yyss; - YYSTYPE yyvs; - YYLTYPE yyls; + yytype_int16 yyss_alloc; + YYSTYPE yyvs_alloc; + YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ @@ -518,12 +464,12 @@ union yyalloc elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ -# define YYSTACK_RELOCATE(Stack) \ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ YYSIZE_T yynewbytes; \ - YYCOPY (&yyptr->Stack, Stack, yysize); \ - Stack = &yyptr->Stack; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ @@ -624,12 +570,12 @@ static const yytype_int8 yyrhs[] = /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 225, 225, 226, 229, 232, 235, 238, 241, 244, - 247, 251, 256, 259, 265, 271, 279, 285, 296, 300, - 304, 310, 314, 318, 322, 326, 332, 336, 341, 346, - 351, 356, 360, 365, 369, 374, 381, 385, 391, 400, - 409, 419, 433, 438, 441, 444, 447, 450, 453, 458, - 461, 466, 470, 474, 480, 498, 501 + 0, 176, 176, 177, 180, 183, 186, 189, 192, 195, + 198, 202, 207, 210, 216, 222, 230, 236, 247, 251, + 255, 261, 265, 269, 273, 277, 283, 287, 292, 297, + 302, 307, 311, 316, 320, 325, 332, 336, 342, 351, + 360, 370, 384, 389, 392, 395, 398, 401, 404, 409, + 412, 417, 421, 425, 431, 449, 452 }; #endif @@ -783,9 +729,18 @@ static const yytype_uint8 yystos[] = /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. - Once GCC version 2 has supplanted version 1, this can go. */ + Once GCC version 2 has supplanted version 1, this can go. However, + YYFAIL appears to be in use. Nevertheless, it is formally deprecated + in Bison 2.4.2's NEWS entry, where a plan to phase it out is + discussed. */ #define YYFAIL goto yyerrlab +#if defined YYFAIL + /* This is here to suppress warnings from the GCC cpp's + -Wunused-macros. Normally we don't worry about that warning, but + some users do, and we want to make it easy for users to remove + YYFAIL uses, which will produce warnings from Bison 2.5. */ +#endif #define YYRECOVERING() (!!yyerrstatus) @@ -842,7 +797,7 @@ while (YYID (0)) we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT -# if YYLTYPE_IS_TRIVIAL +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL # define YY_LOCATION_PRINT(File, Loc) \ fprintf (File, "%d.%d-%d.%d", \ (Loc).first_line, (Loc).first_column, \ @@ -961,17 +916,20 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info) #if (defined __STDC__ || defined __C99__FUNC__ \ || defined __cplusplus || defined _MSC_VER) static void -yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) +yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) #else static void -yy_stack_print (bottom, top) - yytype_int16 *bottom; - yytype_int16 *top; +yy_stack_print (yybottom, yytop) + yytype_int16 *yybottom; + yytype_int16 *yytop; #endif { YYFPRINTF (stderr, "Stack now"); - for (; bottom <= top; ++bottom) - YYFPRINTF (stderr, " %d", *bottom); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } YYFPRINTF (stderr, "\n"); } @@ -1007,11 +965,11 @@ yy_reduce_print (yyvsp, yylsp, yyrule, info) /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { - fprintf (stderr, " $%d = ", yyi + 1); + YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], &(yyvsp[(yyi + 1) - (yynrhs)]) , &(yylsp[(yyi + 1) - (yynrhs)]) , info); - fprintf (stderr, "\n"); + YYFPRINTF (stderr, "\n"); } } @@ -1295,10 +1253,8 @@ yydestruct (yymsg, yytype, yyvaluep, yylocationp, info) break; } } - /* Prevent warnings from -Wmissing-prototypes. */ - #ifdef YYPARSE_PARAM #if defined __STDC__ || defined __cplusplus int yyparse (void *YYPARSE_PARAM); @@ -1317,10 +1273,9 @@ int yyparse (); - -/*----------. -| yyparse. | -`----------*/ +/*-------------------------. +| yyparse or yypush_parse. | +`-------------------------*/ #ifdef YYPARSE_PARAM #if (defined __STDC__ || defined __C99__FUNC__ \ @@ -1344,88 +1299,97 @@ yyparse (info) #endif #endif { - /* The look-ahead symbol. */ +/* The lookahead symbol. */ int yychar; -/* The semantic value of the look-ahead symbol. */ +/* The semantic value of the lookahead symbol. */ YYSTYPE yylval; -/* Number of syntax errors so far. */ -int yynerrs; -/* Location data for the look-ahead symbol. */ +/* Location data for the lookahead symbol. */ YYLTYPE yylloc; - int yystate; - int yyn; - int yyresult; - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; - /* Look-ahead token as an internal (translated) token number. */ - int yytoken = 0; -#if YYERROR_VERBOSE - /* Buffer for error messages, and its allocated size. */ - char yymsgbuf[128]; - char *yymsg = yymsgbuf; - YYSIZE_T yymsg_alloc = sizeof yymsgbuf; -#endif + /* Number of syntax errors so far. */ + int yynerrs; + + int yystate; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; - /* Three stacks and their tools: - `yyss': related to states, - `yyvs': related to semantic values, - `yyls': related to locations. + /* The stacks and their tools: + `yyss': related to states. + `yyvs': related to semantic values. + `yyls': related to locations. - Refer to the stacks thru separate pointers, to allow yyoverflow - to reallocate them elsewhere. */ + Refer to the stacks thru separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ - /* The state stack. */ - yytype_int16 yyssa[YYINITDEPTH]; - yytype_int16 *yyss = yyssa; - yytype_int16 *yyssp; + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss; + yytype_int16 *yyssp; - /* The semantic value stack. */ - YYSTYPE yyvsa[YYINITDEPTH]; - YYSTYPE *yyvs = yyvsa; - YYSTYPE *yyvsp; + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs; + YYSTYPE *yyvsp; - /* The location stack. */ - YYLTYPE yylsa[YYINITDEPTH]; - YYLTYPE *yyls = yylsa; - YYLTYPE *yylsp; - /* The locations where the error started and ended. */ - YYLTYPE yyerror_range[2]; + /* The location stack. */ + YYLTYPE yylsa[YYINITDEPTH]; + YYLTYPE *yyls; + YYLTYPE *yylsp; -#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) + /* The locations where the error started and ended. */ + YYLTYPE yyerror_range[2]; - YYSIZE_T yystacksize = YYINITDEPTH; + YYSIZE_T yystacksize; + int yyn; + int yyresult; + /* Lookahead token as an internal (translated) token number. */ + int yytoken; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; YYLTYPE yyloc; +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) + /* The number of symbols on the RHS of the reduced rule. Keep to zero when no symbol should be popped. */ int yylen = 0; + yytoken = 0; + yyss = yyssa; + yyvs = yyvsa; + yyls = yylsa; + yystacksize = YYINITDEPTH; + YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ + yychar = YYEMPTY; /* Cause a token to be read. */ /* Initialize stack pointers. Waste one element of value and location stack so that they stay on the same level as the state stack. The wasted elements are never initialized. */ - yyssp = yyss; yyvsp = yyvs; yylsp = yyls; -#if YYLTYPE_IS_TRIVIAL + +#if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL /* Initialize the default location before parsing starts. */ yylloc.first_line = yylloc.last_line = 1; - yylloc.first_column = yylloc.last_column = 0; + yylloc.first_column = yylloc.last_column = 1; #endif goto yysetstate; @@ -1464,6 +1428,7 @@ YYLTYPE yylloc; &yyvs1, yysize * sizeof (*yyvsp), &yyls1, yysize * sizeof (*yylsp), &yystacksize); + yyls = yyls1; yyss = yyss1; yyvs = yyvs1; @@ -1485,9 +1450,9 @@ YYLTYPE yylloc; (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyexhaustedlab; - YYSTACK_RELOCATE (yyss); - YYSTACK_RELOCATE (yyvs); - YYSTACK_RELOCATE (yyls); + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); + YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); @@ -1508,6 +1473,9 @@ YYLTYPE yylloc; YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + if (yystate == YYFINAL) + YYACCEPT; + goto yybackup; /*-----------. @@ -1516,16 +1484,16 @@ YYLTYPE yylloc; yybackup: /* Do appropriate processing given the current state. Read a - look-ahead token if we need one and don't already have one. */ + lookahead token if we need one and don't already have one. */ - /* First try to decide what to do without reference to look-ahead token. */ + /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; if (yyn == YYPACT_NINF) goto yydefault; - /* Not known => get a look-ahead token if don't already have one. */ + /* Not known => get a lookahead token if don't already have one. */ - /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */ + /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); @@ -1557,20 +1525,16 @@ yybackup: goto yyreduce; } - if (yyn == YYFINAL) - YYACCEPT; - /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; - /* Shift the look-ahead token. */ + /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - /* Discard the shifted token unless it is eof. */ - if (yychar != YYEOF) - yychar = YYEMPTY; + /* Discard the shifted token. */ + yychar = YYEMPTY; yystate = yyn; *++yyvsp = yylval; @@ -2062,7 +2026,6 @@ yyreduce: break; -/* Line 1267 of yacc.c. */ default: break; } @@ -2139,7 +2102,7 @@ yyerrlab: if (yyerrstatus == 3) { - /* If just tried and failed to reuse look-ahead token after an + /* If just tried and failed to reuse lookahead token after an error, discard it. */ if (yychar <= YYEOF) @@ -2156,7 +2119,7 @@ yyerrlab: } } - /* Else will try to reuse look-ahead token after shifting the error + /* Else will try to reuse lookahead token after shifting the error token. */ goto yyerrlab1; @@ -2214,14 +2177,11 @@ yyerrlab1: YY_STACK_PRINT (yyss, yyssp); } - if (yyn == YYFINAL) - YYACCEPT; - *++yyvsp = yylval; yyerror_range[1] = yylloc; /* Using YYLLOC is tempting, but would change the location of - the look-ahead. YYLOC is available though. */ + the lookahead. YYLOC is available though. */ YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2); *++yylsp = yyloc; @@ -2246,7 +2206,7 @@ yyabortlab: yyresult = 1; goto yyreturn; -#ifndef yyoverflow +#if !defined(yyoverflow) || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ @@ -2257,7 +2217,7 @@ yyexhaustedlab: #endif yyreturn: - if (yychar != YYEOF && yychar != YYEMPTY) + if (yychar != YYEMPTY) yydestruct ("Cleanup: discarding lookahead", yytoken, &yylval, &yylloc, info); /* Do not reclaim the symbols of the rule which action triggered @@ -2513,7 +2473,7 @@ TclDateerror( infoPtr->separatrix = "\n"; } -static time_t +time_t ToSeconds( time_t Hours, time_t Minutes, @@ -2680,7 +2640,7 @@ TclDatelex( location->first_column = yyInput - info->dateStart; for ( ; ; ) { - while (TclIsSpaceProc(*yyInput)) { + while (isspace(UCHAR(*yyInput))) { yyInput++; } @@ -2740,36 +2700,20 @@ TclDatelex( } while (Count > 0); } } - + int -TclClockOldscanObjCmd( - ClientData clientData, /* Unused */ +TclClockFreeScan( Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Count of paraneters */ - Tcl_Obj *const *objv) /* Parameters */ + DateInfo *info) /* Input and result parameters */ { - Tcl_Obj *result, *resultElement; - int yr, mo, da; - DateInfo dateInfo; - DateInfo* info = &dateInfo; int status; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "stringToParse baseYear baseMonth baseDay" ); - return TCL_ERROR; - } - - yyInput = Tcl_GetString( objv[1] ); - dateInfo.dateStart = yyInput; + /* + * yyInput = stringToParse; + * yyYear = baseYear; yyMonth = baseMonth; yyDay = baseDay; + */ yyHaveDate = 0; - if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { - return TCL_ERROR; - } - yyYear = yr; yyMonth = mo; yyDay = da; yyHaveTime = 0; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; @@ -2786,19 +2730,20 @@ TclClockOldscanObjCmd( yyHaveRel = 0; yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; - dateInfo.messages = Tcl_NewObj(); - dateInfo.separatrix = ""; - Tcl_IncrRefCount(dateInfo.messages); + info->messages = Tcl_NewObj(); + info->separatrix = ""; + Tcl_IncrRefCount(info->messages); - status = yyparse(&dateInfo); + info->dateStart = yyInput; + status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, dateInfo.messages); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_SetObjResult(interp, info->messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { @@ -2806,11 +2751,11 @@ TclClockOldscanObjCmd( "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, @@ -2843,6 +2788,40 @@ TclClockOldscanObjCmd( return TCL_ERROR; } + return TCL_OK; +} + +int +TclClockOldscanObjCmd( + ClientData clientData, /* Unused */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Count of paraneters */ + Tcl_Obj *const *objv) /* Parameters */ +{ + Tcl_Obj *result, *resultElement; + int yr, mo, da; + DateInfo dateInfo; + DateInfo* info = &dateInfo; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "stringToParse baseYear baseMonth baseDay" ); + return TCL_ERROR; + } + + yyInput = Tcl_GetString( objv[1] ); + + if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { + return TCL_ERROR; + } + yyYear = yr; yyMonth = mo; yyDay = da; + + if (TclClockFreeScan(interp, info) != TCL_OK) { + return TCL_ERROR; + } + result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { diff --git a/generic/tclDate.h b/generic/tclDate.h new file mode 100644 index 0000000..91e677f --- /dev/null +++ b/generic/tclDate.h @@ -0,0 +1,77 @@ +/* + * tclDate.h -- + * + * This header file handles common usage of clock primitives + * between tclDate.c (yacc) and tclClock.c. + * + * Copyright (c) 2014 Serg G. Brester (aka sebres) + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLCLOCK_H +#define _TCLCLOCK_H + +/* + * Structure contains return parsed fields. + */ + +typedef struct DateInfo { + + Tcl_Obj* messages; /* Error messages */ + const char* separatrix; /* String separating messages */ + + time_t dateYear; + time_t dateMonth; + time_t dateDay; + int dateHaveDate; + + time_t dateHour; + time_t dateMinutes; + time_t dateSeconds; + int dateMeridian; + int dateHaveTime; + + time_t dateTimezone; + int dateDSTmode; + int dateHaveZone; + + time_t dateRelMonth; + time_t dateRelDay; + time_t dateRelSeconds; + int dateHaveRel; + + time_t dateMonthOrdinal; + int dateHaveOrdinalMonth; + + time_t dateDayOrdinal; + time_t dateDayNumber; + int dateHaveDay; + + const char *dateStart; + const char *dateInput; + time_t *dateRelPointer; + + int dateDigitCount; +} DateInfo; + + +/* + * Meridian: am, pm, or 24-hour style. + */ + +typedef enum _MERIDIAN { + MERam, MERpm, MER24 +} MERIDIAN; + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, + time_t Seconds, MERIDIAN Meridian); + +MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); + +#endif /* _TCLCLOCK_H */ diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index da4c3fd..ac781ad 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -50,44 +50,7 @@ * parsed fields will be returned. */ -typedef struct DateInfo { - - Tcl_Obj* messages; /* Error messages */ - const char* separatrix; /* String separating messages */ - - time_t dateYear; - time_t dateMonth; - time_t dateDay; - int dateHaveDate; - - time_t dateHour; - time_t dateMinutes; - time_t dateSeconds; - int dateMeridian; - int dateHaveTime; - - time_t dateTimezone; - int dateDSTmode; - int dateHaveZone; - - time_t dateRelMonth; - time_t dateRelDay; - time_t dateRelSeconds; - int dateHaveRel; - - time_t dateMonthOrdinal; - int dateHaveOrdinalMonth; - - time_t dateDayOrdinal; - time_t dateDayNumber; - int dateHaveDay; - - const char *dateStart; - const char *dateInput; - time_t *dateRelPointer; - - int dateDigitCount; -} DateInfo; +#include "tclDate.h" #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) @@ -150,14 +113,6 @@ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; -/* - * Meridian: am, pm, or 24-hour style. - */ - -typedef enum _MERIDIAN { - MERam, MERpm, MER24 -} MERIDIAN; - %} %union { @@ -176,8 +131,6 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); DateInfo* info, const char *s); static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); -static time_t ToSeconds(time_t Hours, time_t Minutes, - time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int yyparse(DateInfo*); %} @@ -730,7 +683,7 @@ TclDateerror( infoPtr->separatrix = "\n"; } -static time_t +time_t ToSeconds( time_t Hours, time_t Minutes, @@ -957,36 +910,20 @@ TclDatelex( } while (Count > 0); } } - + int -TclClockOldscanObjCmd( - ClientData clientData, /* Unused */ +TclClockFreeScan( Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Count of paraneters */ - Tcl_Obj *const *objv) /* Parameters */ + DateInfo *info) /* Input and result parameters */ { - Tcl_Obj *result, *resultElement; - int yr, mo, da; - DateInfo dateInfo; - DateInfo* info = &dateInfo; int status; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "stringToParse baseYear baseMonth baseDay" ); - return TCL_ERROR; - } - - yyInput = Tcl_GetString( objv[1] ); - dateInfo.dateStart = yyInput; + /* + * yyInput = stringToParse; + * yyYear = baseYear; yyMonth = baseMonth; yyDay = baseDay; + */ yyHaveDate = 0; - if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK - || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { - return TCL_ERROR; - } - yyYear = yr; yyMonth = mo; yyDay = da; yyHaveTime = 0; yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; @@ -1003,19 +940,20 @@ TclClockOldscanObjCmd( yyHaveRel = 0; yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; - dateInfo.messages = Tcl_NewObj(); - dateInfo.separatrix = ""; - Tcl_IncrRefCount(dateInfo.messages); + info->messages = Tcl_NewObj(); + info->separatrix = ""; + Tcl_IncrRefCount(info->messages); - status = yyparse(&dateInfo); + info->dateStart = yyInput; + status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, dateInfo.messages); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_SetObjResult(interp, info->messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); return TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else if (status != 0) { @@ -1023,11 +961,11 @@ TclClockOldscanObjCmd( "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); return TCL_ERROR; } - Tcl_DecrRefCount(dateInfo.messages); + Tcl_DecrRefCount(info->messages); if (yyHaveDate > 1) { Tcl_SetObjResult(interp, @@ -1060,6 +998,40 @@ TclClockOldscanObjCmd( return TCL_ERROR; } + return TCL_OK; +} + +int +TclClockOldscanObjCmd( + ClientData clientData, /* Unused */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Count of paraneters */ + Tcl_Obj *const *objv) /* Parameters */ +{ + Tcl_Obj *result, *resultElement; + int yr, mo, da; + DateInfo dateInfo; + DateInfo* info = &dateInfo; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "stringToParse baseYear baseMonth baseDay" ); + return TCL_ERROR; + } + + yyInput = Tcl_GetString( objv[1] ); + + if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) { + return TCL_ERROR; + } + yyYear = yr; yyMonth = mo; yyDay = da; + + if (TclClockFreeScan(interp, info) != TCL_OK) { + return TCL_ERROR; + } + result = Tcl_NewObj(); resultElement = Tcl_NewObj(); if (yyHaveDate) { diff --git a/library/clock.tcl b/library/clock.tcl index 5b48eb3..9c3f95c 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -287,6 +287,10 @@ proc ::tcl::clock::Initialize {} { variable FEB_28 58 + # Current year century and year of century switch + variable CurrentYearCentury 2000 + variable YearOfCenturySwitch 37 + # Translation table to map Windows TZI onto cities, so that the Olson # rules can apply. In some cases the mapping is ambiguous, so it's wise # to specify $::env(TCL_TZ) rather than simply depending on the system @@ -1295,7 +1299,7 @@ proc ::tcl::clock::__org_scan { args } { # #---------------------------------------------------------------------- -proc ::tcl::clock::FreeScan { string base timezone locale } { +proc ::tcl::clock::__org_FreeScan { string base timezone locale } { variable TZData @@ -1341,7 +1345,8 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseDate] > 0 } { lassign $parseDate y m d if { $y < 100 } { - if { $y >= 39 } { + variable YearOfCenturySwitch + if { $y > $YearOfCenturySwitch } { incr y 1900 } else { incr y 2000 @@ -2719,12 +2724,14 @@ proc ::tcl::clock::ScanWide { str } { proc ::tcl::clock::InterpretTwoDigitYear { date baseTime { twoDigitField yearOfCentury } { fourDigitField year } } { + variable CurrentYearCentury + variable YearOfCenturySwitch set yr [dict get $date $twoDigitField] - if { $yr <= 37 } { - dict set date $fourDigitField [expr { $yr + 2000 }] - } else { - dict set date $fourDigitField [expr { $yr + 1900 }] + incr yr $CurrentYearCentury + if { $yr <= $YearOfCenturySwitch } { + incr yr -100 } + dict set date $fourDigitField $yr return $date } diff --git a/library/init.tcl b/library/init.tcl index e6df12b..4bbce51 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 FreeScan} { + foreach cmd {add format} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] diff --git a/win/makefile.vc b/win/makefile.vc index d6de5e1..26ee669 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -482,7 +482,9 @@ cdebug = $(cdebug) -Zi ### Warnings are too many, can't support warnings into errors. cdebug = -Zi -Od $(DEBUGFLAGS) !else -cdebug = -Zi -WX $(DEBUGFLAGS) +# no -WX option here (error C2220: warning treated as error): +#cdebug = -Zi -WX $(DEBUGFLAGS) +cdebug = -Zi $(DEBUGFLAGS) !endif ### Declarations common to all compiler options -- cgit v0.12 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 From 980f0e3d6b56fbddec0b97988c695f912caa5082 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:01:13 +0000 Subject: [temp-commit]: ClockFreeScan seems to be ready, test case should be checked --- generic/tclClock.c | 171 ++++++++++++++++++++++++++++------------------ tests-perf/clock.perf.tcl | 21 +++++- 2 files changed, 124 insertions(+), 68 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 6d619e0..5710d6d 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2560,12 +2560,13 @@ ClockFreeScan( Tcl_Obj *timezoneObj, /* Default time zone in which the time will be expressed */ Tcl_Obj *locale) /* (Unused) Name of the locale where the time will be scanned. */ { + enum Flags {CL_INVALIDATE = (signed int)0x80000000}; + ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; 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; @@ -2573,7 +2574,6 @@ ClockFreeScan( // Tcl_Obj *cleanUpList = Tcl_NewObj(); date.tzName = NULL; - date2.tzName = NULL; /* If time zone not specified use system time zone */ if (timezoneObj == NULL || @@ -2670,11 +2670,14 @@ ClockFreeScan( } } - SetDateFieldsTimeZone(&date, timezoneObj); + /* on demand (lazy) assemble julianDay using new year, month, etc. */ + date.julianDay = CL_INVALIDATE; - /* Assemble date, time, zone into seconds-from-epoch */ + /* + * Assemble date, time, zone into seconds-from-epoch + */ - GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + SetDateFieldsTimeZone(&date, timezoneObj); if (yy.dateHaveTime == -1) { secondOfDay = 0; @@ -2694,80 +2697,79 @@ ClockFreeScan( secondOfDay = 0; } - date.localSeconds = - -210866803200L - + ( 86400 * (Tcl_WideInt)date.julianDay ) - + secondOfDay; - - SetDateFieldsTimeZone(&date, timezoneObj); - if (ConvertLocalToUTC(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; - } - - seconds = date.seconds; - /* * Do relative times */ +repeat_rel: + if (yy.dateHaveRel) { - /* - seconds = [add $seconds \ - yy.dateRelMonth months yy.dateRelDay days yy.dateRelMonthSecond seconds \ - -timezone $timezone -locale $locale] - */ - } + /* add months (or years in months) */ - /* - * Do relative weekday - */ + if (yy.dateRelMonth != 0) { + int m, h; - if (yy.dateHaveDay && !yy.dateHaveDate) { + /* if needed extract year, month, etc. again */ + if (date.month == CL_INVALIDATE) { + GetGregorianEraYearDay(&date, GREGORIAN_CHANGE_DATE); + GetMonthDay(&date); + GetYearWeekDay(&date, GREGORIAN_CHANGE_DATE); + } - memcpy(&date2, &date, sizeof(date)); - if (date2.tzName != NULL) { - Tcl_IncrRefCount(date2.tzName); - } - /* - SetDateFieldsTimeZone(&date2, timezoneObj); + /* add the requisite number of months */ + date.month += yy.dateRelMonth - 1; + date.year += date.month / 12; + m = date.month % 12; + date.month = m + 1; - date2.seconds = date.seconds; - if (ClockGetDateFields(interp, &date2, tzdata, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; - } - */ + /* if the day doesn't exist in the current month, repair it */ + h = hath[IsGregorianLeapYear(&date)][m]; + if (date.dayOfMonth > h) { + date.dayOfMonth = h; + } - date2.era = CE; - date2.julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date2.julianDay + 6) - + 7 * yy.dateDayOrdinal; - if (yy.dateDayOrdinal > 0) { - date2.julianDay -= 7; + /* on demand (lazy) assemble julianDay using new year, month, etc. */ + date.julianDay = CL_INVALIDATE; + + yy.dateRelMonth = 0; } - secondOfDay = date2.localSeconds % 86400; - date2.localSeconds = - -210866803200 - + ( 86400 * (Tcl_WideInt)date2.julianDay ) - + secondOfDay; - - // check set time zone again may be really necessary here: - // SetDateFieldsTimeZone(&date2, timezoneObj); - if (ConvertLocalToUTC(interp, &date2, tzdata, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; + + /* add days (or other parts aligned to days) */ + if (yy.dateRelDay) { + + /* assemble julianDay using new year, month, etc. */ + if (date.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + } + date.julianDay += yy.dateRelDay; + + /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ + date.month = CL_INVALIDATE; + + yy.dateRelDay = 0; } - seconds = date2.seconds; + /* relative time (seconds) */ + secondOfDay += yy.dateRelSeconds; + yy.dateRelSeconds = 0; + } /* - * Do relative month + * Do relative (ordinal) month */ if (yy.dateHaveOrdinalMonth) { int monthDiff; + + /* if needed extract year, month, etc. again */ + if (date.month == CL_INVALIDATE) { + GetGregorianEraYearDay(&date, GREGORIAN_CHANGE_DATE); + GetMonthDay(&date); + GetYearWeekDay(&date, GREGORIAN_CHANGE_DATE); + } + if (yy.dateMonthOrdinal > 0) { monthDiff = yy.dateMonth - date.month; if (monthDiff <= 0) { @@ -2781,12 +2783,54 @@ ClockFreeScan( } yy.dateMonthOrdinal++; } - /* [SB] TODO: rewrite it in C: * / - seconds = [add $seconds $yy.dateMonthOrdinal years $monthDiff months \ - -timezone $timezone -locale $locale] - */ + + /* process it further via relative times */ + yy.dateHaveRel++; + date.year += yy.dateMonthOrdinal; + yy.dateRelMonth += monthDiff; + yy.dateHaveOrdinalMonth = 0; + + goto repeat_rel; + } + + /* + * Do relative weekday + */ + + if (yy.dateHaveDay && !yy.dateHaveDate) { + + /* if needed assemble julianDay now */ + if (date.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + } + + date.era = CE; + date.julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date.julianDay + 6) + + 7 * yy.dateDayOrdinal; + if (yy.dateDayOrdinal > 0) { + date.julianDay -= 7; + } + } + + /* If needed assemble julianDay using new year, month, etc. */ + if (date.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + } + + /* Local seconds to UTC */ + + date.localSeconds = + -210866803200L + + ( 86400 * (Tcl_WideInt)date.julianDay ) + + ( secondOfDay % 86400 ); + + if (ConvertLocalToUTC(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; } + seconds = date.seconds; + ret = TCL_OK; done: @@ -2794,9 +2838,6 @@ done: if (date.tzName != NULL) { Tcl_DecrRefCount(date.tzName); } - if (date2.tzName != NULL) { - Tcl_DecrRefCount(date2.tzName); - } // Tcl_DecrRefCount(cleanUpList); if (ret != TCL_OK) { diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 2e77a26..52bc91f 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -19,6 +19,18 @@ proc test-scan {{rep 100000}} { foreach {comment c} { "# FreeScan : relative date" {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} + "# FreeScan : relative date with relative weekday" + {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} + "# FreeScan : relative date with ordinal month" + {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} + "# FreeScan : relative date with ordinal month and relative weekday" + {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1} + "# FreeScan : ordinal month" + {clock scan "next January" -base 0 -gmt 1} + "# FreeScan : relative week" + {clock scan "next Fri" -base 0 -gmt 1} + "# FreeScan : relative weekday and week offset " + {clock scan "next January + 2 week" -base 0 -gmt 1} "# FreeScan : time only with base" {clock scan "19:18:30" -base 148863600 -gmt 1} "# FreeScan : time only without base" @@ -34,8 +46,9 @@ proc test-scan {{rep 100000}} { "# FreeScan : time only, zone in string (exchange zones between system / gmt)" {clock scan "19:18:30 GMT" -base 148863600} } { + if {[string first "**STOP**" $comment] != -1} { return -code error "**STOP**" } puts "\n% $comment\n% $c" - puts [clock format [{*}$c]] + puts [clock format [{*}$c] -locale en] puts [time $c $rep] } } @@ -45,15 +58,17 @@ proc test-other {{rep 100000}} { "# Bad zone" {catch {clock scan "1 day" -timezone BAD_ZONE}} } { + if {[string first "**STOP**" $comment] != -1} { return -code error "**STOP**" } puts "\n% $comment\n% $c" puts [if 1 $c] puts [time $c $rep] } } +set factor 10; # 50 if 1 {;# - test-scan 100000 - test-other 50000 + test-scan [expr 10000 * $factor] + test-other [expr 5000 * $factor] puts \n**OK** };# \ No newline at end of file -- cgit v0.12 From f70ebac8b8c9c01999150364b4155b0d50911cbc Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:02:10 +0000 Subject: [temp-commit]: ClockFreeScan ready, test case passed (2 failure because of wrong :localtime zone by TZ-switch, to be fixed) --- generic/tclClock.c | 26 +++++-- library/clock.tcl | 198 ++--------------------------------------------------- library/init.tcl | 2 +- tests/clock.test | 12 +++- 4 files changed, 37 insertions(+), 201 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 5710d6d..7256320 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -122,6 +122,7 @@ typedef struct ClockClientData { Tcl_Obj *GMTSetupTZData; Tcl_Obj *LastSetupTimeZone; Tcl_Obj *LastSetupTZData; + Tcl_Obj *LastUsedSetupTimeZone; } ClockClientData; /* @@ -324,6 +325,7 @@ TclClockInit( data->GMTSetupTZData = NULL; data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; + data->LastUsedSetupTimeZone = NULL; /* * Install the commands. @@ -477,6 +479,7 @@ ClockConfigureObjCmd( if (i+1 < objc) { timezoneObj = NormTimezoneObj(dataPtr, objv[i+1]); if (optionIndex == CLOCK_SETUP_TZ) { + dataPtr->LastUsedSetupTimeZone = timezoneObj; if (timezoneObj == litPtr[LIT_GMT]) { optionIndex = CLOCK_SETUP_GMT; } else if (timezoneObj == dataPtr->LastSystemTimeZone) { @@ -510,14 +513,15 @@ ClockConfigureObjCmd( if (i+1 < objc) { Tcl_IncrRefCount( dataPtr->LastSetupTimeZone = timezoneObj); - } else if (dataPtr->LastSetupTimeZone) { - Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone); + } else if (dataPtr->LastUsedSetupTimeZone) { + Tcl_SetObjResult(interp, dataPtr->LastUsedSetupTimeZone); } } } } if (optionIndex == CLOCK_CLEAR_CACHE) { dataPtr->LastTZEpoch = 0; + dataPtr->LastUsedSetupTimeZone = NULL; } } @@ -605,6 +609,11 @@ ClockSetupTimeZone( Tcl_Obj **literals = dataPtr->literals; Tcl_Obj *callargs[2]; + /* if cached (if already setup this one) */ + if (timezoneObj == dataPtr->LastUsedSetupTimeZone) { + return timezoneObj; + } + /* differentiate GMT and system zones, because used often and already set */ timezoneObj = NormTimezoneObj(dataPtr, timezoneObj); if ( timezoneObj == dataPtr->GMTSetupTimeZone @@ -2546,6 +2555,15 @@ ClockScanObjCmd( } */ + if (1) { + /* TODO: Tcled Scan proc - */ + Tcl_Obj *callargs[10]; + memcpy(callargs, objv, objc * sizeof(*objv)); + callargs[0] = Tcl_NewStringObj("::tcl::clock::__org_scan", -1); + return Tcl_EvalObjv(interp, objc, callargs, 0); + } + // Tcl_SetObjResult(interp, Tcl_NewWideIntObj(10000000)); + return TCL_OK; } @@ -2635,10 +2653,10 @@ ClockFreeScan( if (yy.dateHaveDate) { if (yy.dateYear < 100) { - yy.dateYear += ClockCurrentYearCentury(clientData, interp); - if (yy.dateYear > ClockGetYearOfCenturySwitch(clientData, interp)) { + if (yy.dateYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { yy.dateYear -= 100; } + yy.dateYear += ClockCurrentYearCentury(clientData, interp); } date.era = CE; date.year = yy.dateYear; diff --git a/library/clock.tcl b/library/clock.tcl index 90b3c69..b4a7639 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -289,7 +289,7 @@ proc ::tcl::clock::Initialize {} { # Current year century and year of century switch variable CurrentYearCentury 2000 - variable YearOfCenturySwitch 37 + variable YearOfCenturySwitch 38 # Translation table to map Windows TZI onto cities, so that the Olson # rules can apply. In some cases the mapping is ambiguous, so it's wise @@ -1249,18 +1249,6 @@ proc ::tcl::clock::__org_scan { args } { set timezone :GMT } - if { ![info exists saw(-format)] } { - # Perhaps someday we'll localize the legacy code. Right now, it's not - # localized. - if { [info exists saw(-locale)] } { - return -code error \ - -errorcode [list CLOCK flagWithLegacyFormat] \ - "legacy \[clock scan\] does not support -locale" - - } - return [FreeScan $string $base $timezone $locale] - } - # Change locale if a fresh locale has been given on the command line. EnterLocale $locale @@ -1279,184 +1267,6 @@ proc ::tcl::clock::__org_scan { args } { #---------------------------------------------------------------------- # -# FreeScan -- -# -# Scans a time in free format -# -# Parameters: -# string - String containing the time to scan -# base - Base time, expressed in seconds from the Epoch -# timezone - Default time zone in which the time will be expressed -# locale - (Unused) Name of the locale where the time will be scanned. -# -# Results: -# Returns the date and time extracted from the string in seconds from -# the epoch -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::__org_FreeScan { string base timezone locale } { - - variable TZData - - # Get the data for time changes in the given zone - if {$timezone eq {}} { - set timezone [GetSystemTimeZone] - } - try { - SetupTimeZone $timezone - } on error {retval opts} { - dict unset opts -errorinfo - return -options $opts $retval - } - - # Extract year, month and day from the base time for the parser to use as - # defaults - - set date [GetDateFields $base $TZData($timezone) 2361222] - dict set date secondOfDay [expr { - [dict get $date localSeconds] % 86400 - }] - - # Parse the date. The parser will return a list comprising date, time, - # time zone, relative month/day/seconds, relative weekday, ordinal month. - - try { - set scanned [Oldscan $string \ - [dict get $date year] \ - [dict get $date month] \ - [dict get $date dayOfMonth]] - lassign $scanned \ - parseDate parseTime parseZone parseRel \ - parseWeekday parseOrdinalMonth - } on error message { - return -code error \ - "unable to convert date-time string \"$string\": $message" - } - - # If the caller supplied a date in the string, update the 'date' dict with - # the value. If the caller didn't specify a time with the date, default to - # midnight. - - if { [llength $parseDate] > 0 } { - lassign $parseDate y m d - if { $y < 100 } { - variable YearOfCenturySwitch - if { $y > $YearOfCenturySwitch } { - incr y 1900 - } else { - incr y 2000 - } - } - dict set date era CE - dict set date year $y - dict set date month $m - dict set date dayOfMonth $d - if { $parseTime eq {} } { - set parseTime 0 - } - } - - # If the caller supplied a time zone in the string, it comes back as a - # two-element list; the first element is the number of minutes east of - # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes, - # 0 == no, -1 == unknown). We make it into a time zone indicator of - # +-hhmm. - - if { [llength $parseZone] > 0 } { - lassign $parseZone minEast dstFlag - set timezone [FormatNumericTimeZone \ - [expr { 60 * $minEast + 3600 * $dstFlag }]] - SetupTimeZone $timezone - } - dict set date tzName $timezone - - # Assemble date, time, zone into seconds-from-epoch - - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222] - if { $parseTime ne {} } { - dict set date secondOfDay $parseTime - } elseif { [llength $parseWeekday] != 0 - || [llength $parseOrdinalMonth] != 0 - || ( [llength $parseRel] != 0 - && ( [lindex $parseRel 0] != 0 - || [lindex $parseRel 1] != 0 ) ) } { - dict set date secondOfDay 0 - } - - dict set date localSeconds [expr { - -210866803200 - + ( 86400 * wide([dict get $date julianDay]) ) - + [dict get $date secondOfDay] - }] - dict set date tzName $timezone - set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222] - set seconds [dict get $date seconds] - - # Do relative times - - if { [llength $parseRel] > 0 } { - lassign $parseRel relMonth relDay relSecond - set seconds [add $seconds \ - $relMonth months $relDay days $relSecond seconds \ - -timezone $timezone -locale $locale] - } - - # Do relative weekday - - if { [llength $parseWeekday] > 0 } { - lassign $parseWeekday dayOrdinal dayOfWeek - set date2 [GetDateFields $seconds $TZData($timezone) 2361222] - dict set date2 era CE - set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr { - [dict get $date2 julianDay] + 6 - }]] - incr jdwkday [expr { 7 * $dayOrdinal }] - if { $dayOrdinal > 0 } { - incr jdwkday -7 - } - dict set date2 secondOfDay \ - [expr { [dict get $date2 localSeconds] % 86400 }] - dict set date2 julianDay $jdwkday - dict set date2 localSeconds [expr { - -210866803200 - + ( 86400 * wide([dict get $date2 julianDay]) ) - + [dict get $date secondOfDay] - }] - dict set date2 tzName $timezone - set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \ - 2361222] - set seconds [dict get $date2 seconds] - - } - - # Do relative month - - if { [llength $parseOrdinalMonth] > 0 } { - lassign $parseOrdinalMonth monthOrdinal monthNumber - if { $monthOrdinal > 0 } { - set monthDiff [expr { $monthNumber - [dict get $date month] }] - if { $monthDiff <= 0 } { - incr monthDiff 12 - } - incr monthOrdinal -1 - } else { - set monthDiff [expr { [dict get $date month] - $monthNumber }] - if { $monthDiff >= 0 } { - incr monthDiff -12 - } - incr monthOrdinal - } - set seconds [add $seconds $monthOrdinal years $monthDiff months \ - -timezone $timezone -locale $locale] - } - - return $seconds -} - - -#---------------------------------------------------------------------- -# # ParseClockScanFormat -- # # Parses a format string given to [clock scan -format] @@ -2723,10 +2533,10 @@ proc ::tcl::clock::InterpretTwoDigitYear { date baseTime variable CurrentYearCentury variable YearOfCenturySwitch set yr [dict get $date $twoDigitField] - incr yr $CurrentYearCentury - if { $yr <= $YearOfCenturySwitch } { + if { $yr >= $YearOfCenturySwitch } { incr yr -100 } + incr yr $CurrentYearCentury dict set date $fourDigitField $yr return $date } @@ -3120,7 +2930,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } { LoadZoneinfoFile [string range $timezone 1 end] }] } then { - dict set TimeZoneBad $timezone 1 + dict set TimeZoneBad $timezone 1 return -code error \ -errorcode [list CLOCK badTimeZone $timezone] \ "time zone \"$timezone\" not found" diff --git a/library/init.tcl b/library/init.tcl index 5e452b0..06a9459 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 SetupTimeZone} { + foreach cmd {add format SetupTimeZone GetSystemTimeZone __org_scan} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] diff --git a/tests/clock.test b/tests/clock.test index 6a0fecd..ecc6f5f 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35662,7 +35662,7 @@ test clock-34.8 {clock scan tests} { } {Oct 23,1992 15:00 GMT} test clock-34.9 {clock scan tests} { list [catch {clock scan "Jan 12" -bad arg} msg] $msg -} {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}} +} {1 {bad option "-bad": must be -format, -gmt, -locale, -timezone, or -base}} # The following two two tests test the two year date policy test clock-34.10 {clock scan tests} { set time [clock scan "1/1/71" -gmt true] @@ -35672,7 +35672,15 @@ test clock-34.11 {clock scan tests} { set time [clock scan "1/1/37" -gmt true] clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true } {Jan 01,2037 00:00 GMT} - +test clock-34.11.1 {clock scan tests: same century switch} { + set times [clock scan "1/1/37" -gmt true] +} [clock scan "1/1/37" -format "%m/%d/%y" -gmt true] +test clock-34.11.2 {clock scan tests: same century switch} { + set times [clock scan "1/1/38" -gmt true] +} [clock scan "1/1/38" -format "%m/%d/%y" -gmt true] +test clock-34.11.3 {clock scan tests: same century switch} { + set times [clock scan "1/1/39" -gmt true] +} [clock scan "1/1/39" -format "%m/%d/%y" -gmt true] test clock-34.12 {clock scan, relative times} { set time [clock scan "Oct 23, 1992 -1 day"] clock format $time -format {%b %d, %Y} -- cgit v0.12 From c093e76184fc3101487abf86878fcc8e85a77cd9 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:04:49 +0000 Subject: [temp-commit]: ClockFreeScan back-ported (cherry picked), all tests case passed + several new test-cases for bug fixing implemented here; environment epoch ported, several fixes for the time zone / tzdata caching ported; mem-leak fix + memory leak test cases passed --- generic/tclClock.c | 342 +++++++++++++++++++++++++++------------------- generic/tclDate.h | 13 +- generic/tclEnv.c | 8 ++ library/clock.tcl | 12 +- tests-perf/clock.perf.tcl | 78 +++++++---- tests/clock.test | 21 +++ 6 files changed, 296 insertions(+), 178 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 7256320..e39e032 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -115,14 +115,24 @@ 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; + unsigned long LastTZEpoch; + Tcl_Obj *SystemTimeZone; Tcl_Obj *SystemSetupTZData; Tcl_Obj *GMTSetupTimeZone; Tcl_Obj *GMTSetupTZData; + Tcl_Obj *AnySetupTimeZone; + Tcl_Obj *AnySetupTZData; + Tcl_Obj *LastUnnormSetupTimeZone; Tcl_Obj *LastSetupTimeZone; Tcl_Obj *LastSetupTZData; - Tcl_Obj *LastUsedSetupTimeZone; + /* + /* [SB] TODO: back-port (from tclSE) the same date caching ... + * Cache for last date (fast convert if date parsed was the same) * / + struct { + DateInfo yy; + TclDateFields date; + } lastDate; + */ } ClockClientData; /* @@ -233,11 +243,29 @@ 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 unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); /* + * Primitives to safe set, reset and free references. + */ + +#define Tcl_UnsetObjRef(obj) \ + if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } +#define Tcl_InitObjRef(obj, val) \ + obj = val; if (obj) { Tcl_IncrRefCount(obj); } +#define Tcl_SetObjRef(obj, val) \ +if (1) { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + Tcl_InitObjRef(obj, nval); \ + if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ + } \ +} + +/* * Structure containing description of "native" clock commands to create. */ @@ -319,13 +347,15 @@ TclClockInit( Tcl_IncrRefCount(data->literals[i]); } data->LastTZEpoch = 0; - data->LastSystemTimeZone = NULL; + data->SystemTimeZone = NULL; data->SystemSetupTZData = NULL; data->GMTSetupTimeZone = NULL; data->GMTSetupTZData = NULL; + data->AnySetupTimeZone = NULL; + data->AnySetupTZData = NULL; + data->LastUnnormSetupTimeZone = NULL; data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; - data->LastUsedSetupTimeZone = NULL; /* * Install the commands. @@ -356,6 +386,22 @@ TclClockInit( */ static void +ClockConfigureClear( + ClockClientData *data) +{ + data->LastTZEpoch = 0; + Tcl_UnsetObjRef(data->SystemTimeZone); + Tcl_UnsetObjRef(data->SystemSetupTZData); + Tcl_UnsetObjRef(data->GMTSetupTimeZone); + Tcl_UnsetObjRef(data->GMTSetupTZData); + Tcl_UnsetObjRef(data->AnySetupTimeZone); + Tcl_UnsetObjRef(data->AnySetupTZData); + Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone); + Tcl_UnsetObjRef(data->LastSetupTimeZone); + Tcl_UnsetObjRef(data->LastSetupTZData); +} + +static void ClockDeleteCmdProc( ClientData clientData) /* Opaque pointer to the client data */ { @@ -367,15 +413,7 @@ ClockDeleteCmdProc( 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); - } + ClockConfigureClear(data); ckfree(data->literals); ckfree(data); @@ -391,34 +429,40 @@ NormTimezoneObj( Tcl_Obj * timezoneObj) { const char * tz; - if ( timezoneObj == dataPtr->literals[LIT_GMT] - || timezoneObj == dataPtr->LastSystemTimeZone - || timezoneObj == dataPtr->LastSetupTimeZone + if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone + && dataPtr->LastSetupTimeZone != NULL + ) { + return dataPtr->LastSetupTimeZone; + } + if ( timezoneObj == dataPtr->LastSetupTimeZone + || timezoneObj == dataPtr->literals[LIT_GMT] + || timezoneObj == dataPtr->SystemTimeZone + || timezoneObj == dataPtr->AnySetupTimeZone ) { return timezoneObj; } tz = TclGetString(timezoneObj); - if ( - strcmp(tz, Literals[LIT_GMT]) == 0 + if (dataPtr->AnySetupTimeZone != NULL && + (timezoneObj == dataPtr->AnySetupTimeZone + || strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0 + ) ) { - timezoneObj = dataPtr->literals[LIT_GMT]; + timezoneObj = dataPtr->AnySetupTimeZone; } else - if (dataPtr->LastSystemTimeZone != NULL && - (timezoneObj == dataPtr->LastSystemTimeZone - || strcmp(tz, TclGetString(dataPtr->LastSystemTimeZone)) == 0 + if (dataPtr->SystemTimeZone != NULL && + (timezoneObj == dataPtr->SystemTimeZone + || strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0 ) ) { - timezoneObj = dataPtr->LastSystemTimeZone; + timezoneObj = dataPtr->SystemTimeZone; } else - if (dataPtr->LastSetupTimeZone != NULL && - (timezoneObj == dataPtr->LastSetupTimeZone - || strcmp(tz, TclGetString(dataPtr->LastSetupTimeZone)) == 0 - ) + if ( + strcmp(tz, Literals[LIT_GMT]) == 0 ) { - timezoneObj = dataPtr->LastSetupTimeZone; + timezoneObj = dataPtr->literals[LIT_GMT]; } return timezoneObj; } @@ -454,74 +498,64 @@ ClockConfigureObjCmd( 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); + switch (optionIndex) { + case CLOCK_SYSTEM_TZ: + if (1) { + /* validate current tz-epoch */ + unsigned long lastTZEpoch = TzsetGetEpoch(); + if (i+1 < objc) { + if (dataPtr->SystemTimeZone != objv[i+1]) { + Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i+1]); + Tcl_UnsetObjRef(dataPtr->SystemSetupTZData); } + dataPtr->LastTZEpoch = lastTZEpoch; + } + if (dataPtr->SystemTimeZone != NULL + && dataPtr->LastTZEpoch == lastTZEpoch) { + Tcl_SetObjResult(interp, dataPtr->SystemTimeZone); } } - if (optionIndex == CLOCK_SETUP_TZ || optionIndex == CLOCK_CLEAR_CACHE) { - Tcl_Obj *timezoneObj = NULL; - /* differentiate GMT and system zones, because used often */ + break; + case CLOCK_SETUP_TZ: if (i+1 < objc) { - timezoneObj = NormTimezoneObj(dataPtr, objv[i+1]); - if (optionIndex == CLOCK_SETUP_TZ) { - dataPtr->LastUsedSetupTimeZone = timezoneObj; - if (timezoneObj == litPtr[LIT_GMT]) { - optionIndex = CLOCK_SETUP_GMT; - } else if (timezoneObj == dataPtr->LastSystemTimeZone) { - optionIndex = CLOCK_SETUP_NOP; - } + /* differentiate GMT and system zones, because used often */ + Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i+1]); + Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i+1]); + if (dataPtr->LastSetupTimeZone != timezoneObj) { + Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->LastSetupTZData); } - } - - if (optionIndex == CLOCK_SETUP_GMT || optionIndex == CLOCK_CLEAR_CACHE) { - if (dataPtr->GMTSetupTimeZone) { - Tcl_DecrRefCount(dataPtr->GMTSetupTimeZone); - dataPtr->GMTSetupTimeZone = NULL; - dataPtr->GMTSetupTZData = NULL; + if (timezoneObj == litPtr[LIT_GMT]) { + optionIndex = CLOCK_SETUP_GMT; + } else if (timezoneObj == dataPtr->SystemTimeZone) { + optionIndex = CLOCK_SETUP_NOP; } - if (optionIndex != CLOCK_CLEAR_CACHE) { + switch (optionIndex) { + case CLOCK_SETUP_GMT: if (i+1 < objc) { - Tcl_IncrRefCount( - dataPtr->GMTSetupTimeZone = timezoneObj); - } else if (dataPtr->GMTSetupTimeZone) { - Tcl_SetObjResult(interp, dataPtr->GMTSetupTimeZone); + if (dataPtr->GMTSetupTimeZone != timezoneObj) { + Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->GMTSetupTZData); + } } - } - } - 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) { + break; + case CLOCK_SETUP_TZ: if (i+1 < objc) { - Tcl_IncrRefCount( - dataPtr->LastSetupTimeZone = timezoneObj); - } else if (dataPtr->LastUsedSetupTimeZone) { - Tcl_SetObjResult(interp, dataPtr->LastUsedSetupTimeZone); - } + if (dataPtr->AnySetupTimeZone != timezoneObj) { + Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->AnySetupTZData); + } + } + break; } } - } - if (optionIndex == CLOCK_CLEAR_CACHE) { - dataPtr->LastTZEpoch = 0; - dataPtr->LastUsedSetupTimeZone = NULL; + if (dataPtr->LastSetupTimeZone != NULL) { + Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone); + } + break; + case CLOCK_CLEAR_CACHE: + ClockConfigureClear(dataPtr); + break; } } @@ -541,11 +575,19 @@ ClockGetTZData( Tcl_Obj **literals = dataPtr->literals; Tcl_Obj *ret, **out = NULL; + /* if cached (if already setup this one) */ + if ( dataPtr->LastSetupTZData != NULL + && ( timezoneObj == dataPtr->LastSetupTimeZone + || timezoneObj == dataPtr->LastUnnormSetupTimeZone + ) + ) { + return dataPtr->LastSetupTZData; + } + /* 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) + /* simple caching, because almost used the tz-data of last timezone */ - if (timezoneObj == dataPtr->LastSystemTimeZone) { + if (timezoneObj == dataPtr->SystemTimeZone) { if (dataPtr->SystemSetupTZData != NULL) return dataPtr->SystemSetupTZData; out = &dataPtr->SystemSetupTZData; @@ -557,19 +599,25 @@ ClockGetTZData( out = &dataPtr->GMTSetupTZData; } else - if (timezoneObj == dataPtr->LastSetupTimeZone) { - if (dataPtr->LastSetupTZData != NULL) { - return dataPtr->LastSetupTZData; + if (timezoneObj == dataPtr->AnySetupTimeZone) { + if (dataPtr->AnySetupTZData != NULL) { + return dataPtr->AnySetupTZData; } - out = &dataPtr->LastSetupTZData; + out = &dataPtr->AnySetupTZData; } ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA], timezoneObj, TCL_LEAVE_ERR_MSG); - /* cache using corresponding slot */ - if (ret != NULL && out != NULL) - *out = ret; + /* cache using corresponding slot and as last used */ + if (out != NULL) { + Tcl_SetObjRef(*out, ret); + } + Tcl_SetObjRef(dataPtr->LastSetupTZData, ret); + if (dataPtr->LastSetupTimeZone != timezoneObj) { + Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone); + } return ret; } /* @@ -584,9 +632,9 @@ ClockGetSystemTimeZone( Tcl_Obj **literals; /* if known (cached and same epoch) - return now */ - if (dataPtr->LastSystemTimeZone != NULL + if (dataPtr->SystemTimeZone != NULL && dataPtr->LastTZEpoch == TzsetGetEpoch()) { - return dataPtr->LastSystemTimeZone; + return dataPtr->SystemTimeZone; } literals = dataPtr->literals; @@ -610,15 +658,19 @@ ClockSetupTimeZone( Tcl_Obj *callargs[2]; /* if cached (if already setup this one) */ - if (timezoneObj == dataPtr->LastUsedSetupTimeZone) { - return timezoneObj; + if ( dataPtr->LastSetupTimeZone != NULL + && ( timezoneObj == dataPtr->LastSetupTimeZone + || timezoneObj == dataPtr->LastUnnormSetupTimeZone + ) + ) { + return dataPtr->LastSetupTimeZone; } /* 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 + || timezoneObj == dataPtr->SystemTimeZone + || timezoneObj == dataPtr->AnySetupTimeZone ) { return timezoneObj; } @@ -627,7 +679,7 @@ ClockSetupTimeZone( callargs[1] = timezoneObj; if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { - return NormTimezoneObj(dataPtr, timezoneObj); + return dataPtr->LastSetupTimeZone; } return NULL; } @@ -743,6 +795,7 @@ ClockConvertlocaltoutcObjCmd( int created = 0; int status; + fields.tzName = NULL; /* * Check params and convert time. */ @@ -936,22 +989,6 @@ ClockGetDateFields( return TCL_OK; } - -inline -SetDateFieldsTimeZone( - TclDateFields *fields, - Tcl_Obj *timezoneObj) -{ - if (fields->tzName != timezoneObj) { - if (timezoneObj) { - Tcl_IncrRefCount(timezoneObj); - } - if (fields->tzName != NULL) { - Tcl_DecrRefCount(fields->tzName); - } - fields->tzName = timezoneObj; - } -} /* *---------------------------------------------------------------------- @@ -1030,6 +1067,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( int status; int era = 0; + fields.tzName = NULL; + /* * Check params. */ @@ -1114,6 +1153,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd( int status; int era = 0; + fields.tzName = NULL; + /* * Check params. */ @@ -1457,7 +1498,7 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - SetDateFieldsTimeZone(fields, cellv[3]); + Tcl_SetObjRef(fields->tzName, cellv[3]); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -1550,7 +1591,7 @@ ConvertUTCToLocalUsingC( if (diff > 0) { sprintf(buffer+5, "%02d", diff); } - SetDateFieldsTimeZone(fields, Tcl_NewStringObj(buffer, -1)); + Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); return TCL_OK; } @@ -1647,6 +1688,8 @@ GetYearWeekDay( TclDateFields temp; int dayOfFiscalYear; + temp.tzName = NULL; + /* * Find the given date, minus three days, plus one year. That date's * iso8601 year is an upper bound on the ISO8601 year of the given date. @@ -1863,6 +1906,8 @@ GetJulianDayFromEraYearWeekDay( * given year */ TclDateFields firstWeek; + firstWeek.tzName = NULL; + /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ @@ -2557,13 +2602,16 @@ ClockScanObjCmd( if (1) { /* TODO: Tcled Scan proc - */ + int ret; Tcl_Obj *callargs[10]; memcpy(callargs, objv, objc * sizeof(*objv)); callargs[0] = Tcl_NewStringObj("::tcl::clock::__org_scan", -1); - return Tcl_EvalObjv(interp, objc, callargs, 0); + Tcl_IncrRefCount(callargs[0]); + ret = Tcl_EvalObjv(interp, objc, callargs, 0); + Tcl_DecrRefCount(callargs[0]); + return ret; } - // Tcl_SetObjResult(interp, Tcl_NewWideIntObj(10000000)); - + return TCL_OK; } @@ -2589,7 +2637,6 @@ ClockFreeScan( int secondOfDay; /* Seconds of day (time only calculation) */ Tcl_WideInt seconds; int ret = TCL_ERROR; - // Tcl_Obj *cleanUpList = Tcl_NewObj(); date.tzName = NULL; @@ -2600,7 +2647,6 @@ ClockFreeScan( if (timezoneObj == NULL) { goto done; } - // Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj); } /* Get the data for time changes in the given zone */ @@ -2673,12 +2719,16 @@ ClockFreeScan( */ if (yy.dateHaveZone) { + Tcl_Obj *tzObjStor = NULL; int minEast = -yy.dateTimezone; int dstFlag = 1 - yy.dateDSTmode; - timezoneObj = ClockFormatNumericTimeZone( + tzObjStor = ClockFormatNumericTimeZone( 60 * minEast + 3600 * dstFlag); - // Tcl_ListObjAppendElement(NULL, cleanUpList, timezoneObj); - timezoneObj = ClockSetupTimeZone(clientData, interp, timezoneObj); + + timezoneObj = ClockSetupTimeZone(clientData, interp, tzObjStor); + if (tzObjStor != timezoneObj) { + Tcl_DecrRefCount(tzObjStor); + } if (timezoneObj == NULL) { goto done; } @@ -2695,7 +2745,7 @@ ClockFreeScan( * Assemble date, time, zone into seconds-from-epoch */ - SetDateFieldsTimeZone(&date, timezoneObj); + Tcl_SetObjRef(date.tzName, timezoneObj); if (yy.dateHaveTime == -1) { secondOfDay = 0; @@ -2853,10 +2903,7 @@ repeat_rel: done: - if (date.tzName != NULL) { - Tcl_DecrRefCount(date.tzName); - } - // Tcl_DecrRefCount(cleanUpList); + Tcl_UnsetObjRef(date.tzName); if (ret != TCL_OK) { return ret; @@ -2919,23 +2966,30 @@ ClockSecondsObjCmd( *---------------------------------------------------------------------- */ -static unsigned int +static unsigned long TzsetGetEpoch(void) { - static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by - * clockMutex. */ - static long tzNextRefresh = 0; /* Latence before next refresh */ - static unsigned int tzWasEpoch = 1; /* Epoch, signals that TZ changed */ + static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by + * clockMutex. */ + static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */ + static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling, + that TZ changed via TCL */ - const char *tzIsNow; /* Current value of TZ */ + const char *tzIsNow; /* Current value of TZ */ - /* fast check whether environment was changed (once per second) */ + /* + * 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 chaned with tcl-env (compare both epoch values) + */ Tcl_Time now; Tcl_GetTime(&now); - if (now.sec < tzNextRefresh) { + if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { return tzWasEpoch; } - tzNextRefresh = now.sec + 1; + tzEnvEpoch = TclEnvEpoch; + tzLastRefresh = now.sec; /* check in lock */ Tcl_MutexLock(&clockMutex); diff --git a/generic/tclDate.h b/generic/tclDate.h index 91e677f..6ba9620 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -19,9 +19,6 @@ typedef struct DateInfo { - Tcl_Obj* messages; /* Error messages */ - const char* separatrix; /* String separating messages */ - time_t dateYear; time_t dateMonth; time_t dateDay; @@ -54,6 +51,9 @@ typedef struct DateInfo { time_t *dateRelPointer; int dateDigitCount; + + Tcl_Obj* messages; /* Error messages */ + const char* separatrix; /* String separating messages */ } DateInfo; @@ -74,4 +74,11 @@ MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); +/* + * Other externals. + */ + +MODULE_SCOPE unsigned long TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + #endif /* _TCLCLOCK_H */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 66ddb57..fd0a8ce 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -17,6 +17,10 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ + +MODULE_SCOPE unsigned long 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 @@ -371,6 +375,7 @@ Tcl_PutEnv( value[0] = '\0'; TclSetEnv(name, value+1); } + TclEnvEpoch++; Tcl_DStringFree(&nameString); return 0; @@ -579,6 +584,7 @@ EnvTraceProc( if (flags & TCL_TRACE_ARRAY) { TclSetupEnv(interp); + TclEnvEpoch++; return NULL; } @@ -599,6 +605,7 @@ EnvTraceProc( value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); + TclEnvEpoch++; } /* @@ -622,6 +629,7 @@ EnvTraceProc( if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); + TclEnvEpoch++; } return NULL; } diff --git a/library/clock.tcl b/library/clock.tcl index b4a7639..ace4176 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -671,7 +671,9 @@ proc ::tcl::clock::format { args } { # Get the data for time changes in the given zone if {$timezone eq ""} { - set timezone [GetSystemTimeZone] + if {[set timezone [configure -system-tz]] eq ""} { + set timezone [GetSystemTimeZone] + } } if {![info exists TZData($timezone)]} { if {[catch {SetupTimeZone $timezone} retval opts]} { @@ -1202,7 +1204,9 @@ proc ::tcl::clock::__org_scan { args } { set format {} set gmt 0 set locale c - set timezone [GetSystemTimeZone] + if {[set timezone [configure -system-tz]] eq ""} { + set timezone [GetSystemTimeZone] + } # Pick up command line options. @@ -4083,7 +4087,9 @@ proc ::tcl::clock::add { clockval args } { set offsets {} set gmt 0 set locale c - set timezone [GetSystemTimeZone] + if {[set timezone [configure -system-tz]] eq ""} { + set timezone [GetSystemTimeZone] + } foreach { a b } $args { if { [string is integer -strict $a] } { diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 52bc91f..7ef70ce 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -15,60 +15,82 @@ # of this file. # +set ::env(TCL_TZ) :CET + +proc {**STOP**} {args} { + return -code error -level 2 "**STOP** in [info level [expr {[info level]-1}]] [join $args { }]" +} + +proc _test_get_commands {lst} { + regsub -all {(?:^|\n)[ \t]*(\#[^\n]*)(?=\n\s*[\{\#])} $lst "\n{\\1}" +} + proc test-scan {{rep 100000}} { - foreach {comment c} { - "# FreeScan : relative date" + foreach c [_test_get_commands { + # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} - "# FreeScan : relative date with relative weekday" + # FreeScan : relative date with relative weekday {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} - "# FreeScan : relative date with ordinal month" + # FreeScan : relative date with ordinal month {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} - "# FreeScan : relative date with ordinal month and relative weekday" + # FreeScan : relative date with ordinal month and relative weekday {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1} - "# FreeScan : ordinal month" + # FreeScan : ordinal month {clock scan "next January" -base 0 -gmt 1} - "# FreeScan : relative week" + # FreeScan : relative week {clock scan "next Fri" -base 0 -gmt 1} - "# FreeScan : relative weekday and week offset " + # FreeScan : relative weekday and week offset {clock scan "next January + 2 week" -base 0 -gmt 1} - "# FreeScan : time only with base" + # FreeScan : time only with base {clock scan "19:18:30" -base 148863600 -gmt 1} - "# FreeScan : time only without base" + # FreeScan : time only without base, gmt {clock scan "19:18:30" -gmt 1} - "# FreeScan : date, system time zone" + # FreeScan : time only without base, system + {clock scan "19:18:30"} + # FreeScan : date, system time zone {clock scan "05/08/2016 20:18:30"} - "# FreeScan : date, supplied time zone" + # FreeScan : date, supplied time zone {clock scan "05/08/2016 20:18:30" -timezone :CET} - "# FreeScan : date, supplied gmt (equivalent -timezone :GMT)" + # 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)" + # FreeScan : date, supplied time zone gmt + {clock scan "05/08/2016 20:18:30" -timezone :GMT} + # 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)" + # FreeScan : time only, zone in string (exchange zones between system / gmt) {clock scan "19:18:30 GMT" -base 148863600} - } { - if {[string first "**STOP**" $comment] != -1} { return -code error "**STOP**" } - puts "\n% $comment\n% $c" - puts [clock format [{*}$c] -locale en] + # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST + {clock scan "19:18:30 MST" -base 148863600 -gmt 1 + clock scan "19:18:30 EST" -base 148863600 + } + }] { + puts "% [regsub -all {\n[ \t]*} $c {; }]" + if {[regexp {\s*\#} $c]} continue + puts [clock format [if 1 $c] -locale en] puts [time $c $rep] + puts "" } } proc test-other {{rep 100000}} { - foreach {comment c} { - "# Bad zone" - {catch {clock scan "1 day" -timezone BAD_ZONE}} - } { - if {[string first "**STOP**" $comment] != -1} { return -code error "**STOP**" } - puts "\n% $comment\n% $c" + foreach c [_test_get_commands { + # Bad zone + {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + }] { + puts "% [regsub -all {\n[ \t]*} $c {; }]" + if {[regexp {\s*\#} $c]} continue puts [if 1 $c] puts [time $c $rep] + puts "" } } -set factor 10; # 50 -if 1 {;# +proc test {factor} { + puts "" test-scan [expr 10000 * $factor] test-other [expr 5000 * $factor] puts \n**OK** -};# \ No newline at end of file +} + +test 20; # 50 diff --git a/tests/clock.test b/tests/clock.test index ecc6f5f..477f142 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35803,6 +35803,27 @@ test clock-34.40 {clock scan, next day of week} { clock format [clock scan "next thursday" -base [clock scan 20000112]] \ -format {%b %d, %Y} } "Jan 20, 2000" +test clock-34.40.1 {clock scan, ordinal month after relative date} { + # This will fail without the bug fix (clock.tcl), as still missing + # month/julian day conversion before ordinal month increment + clock format [ \ + clock scan "5 years 18 months 387 days" -base 0 -gmt 1 + ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman +} "Sat, Jul 23, 1977" +test clock-34.40.2 {clock scan, ordinal month after relative date} { + # This will fail without the bug fix (clock.tcl), as still missing + # month/julian day conversion before ordinal month increment + clock format [ \ + clock scan "5 years 18 months 387 days next Jan" -base 0 -gmt 1 + ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman +} "Mon, Jan 23, 1978" +test clock-34.40.3 {clock scan, day of week after ordinal date} { + # This will fail without the bug fix (clock.tcl), because the relative + # week day should be applied after whole date conversion + clock format [ \ + clock scan "5 years 18 months 387 days next January Fri" -base 0 -gmt 1 + ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman +} "Fri, Jan 27, 1978" # weekday specification and base. test clock-34.41 {2nd monday in november} { -- cgit v0.12 From efcfa2b368fa979b75f62e91ae673b260f2ba0c9 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:07:37 +0000 Subject: [temp-commit]: tclClockFmt.c - 1st try using "timerate" instead "time" by performance measurement tests (more precise and fixed time, so no switch of factor expected) --- generic/tclClock.c | 17 +- generic/tclClockFmt.c | 417 ++++++++++++++++++++++++++++++++++++++++++++++ generic/tclDate.c | 12 +- generic/tclDate.h | 44 ++++- generic/tclGetDate.y | 1 + tests-perf/clock.perf.tcl | 40 +++-- unix/Makefile.in | 4 + win/Makefile.in | 1 + win/makefile.vc | 1 + 9 files changed, 512 insertions(+), 25 deletions(-) create mode 100644 generic/tclClockFmt.c diff --git a/generic/tclClock.c b/generic/tclClock.c index e39e032..c869cf4 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -8,6 +8,7 @@ * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -2600,9 +2601,9 @@ ClockScanObjCmd( } */ - if (1) { + if (0) { /* TODO: Tcled Scan proc - */ - int ret; + int ret; Tcl_Obj *callargs[10]; memcpy(callargs, objv, objc * sizeof(*objv)); callargs[0] = Tcl_NewStringObj("::tcl::clock::__org_scan", -1); @@ -2611,6 +2612,18 @@ ClockScanObjCmd( Tcl_DecrRefCount(callargs[0]); return ret; } + + if (1) { + + ClockFmtScnStorage * fss; + + if ((fss = Tcl_GetClockFrmScnFromObj(interp, opts.formatObj)) == NULL) { + return TCL_ERROR; + }; + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)fss)); + + } return TCL_OK; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c new file mode 100644 index 0000000..fa89dde --- /dev/null +++ b/generic/tclClockFmt.c @@ -0,0 +1,417 @@ +/* + * tclClockFmt.c -- + * + * Contains the date format (and scan) routines. This code is back-ported + * from the time and date facilities of tclSE engine, by Serg G. Brester. + * + * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclDate.h" + +/* + * Miscellaneous forward declarations and functions used within this file + */ + +static void +ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr); +static int +ClockFmtObj_SetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void +ClockFmtObj_UpdateString(Tcl_Obj *objPtr); + + +TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ + +static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); + +/* + * Clock scan and format facilities. + */ + +#define TOK_CHAIN_BLOCK_SIZE 8 + +/* + *---------------------------------------------------------------------- + */ + +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + +static struct { + ClockFmtScnStorage *stackPtr; + ClockFmtScnStorage *stackBound; + unsigned int count; +} ClockFmtScnStorage_GC = {NULL, NULL, 0}; + +inline void +ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) +{ + /* add new entry */ + TclSpliceIn(entry, ClockFmtScnStorage_GC.stackPtr); + if (ClockFmtScnStorage_GC.stackBound == NULL) { + ClockFmtScnStorage_GC.stackBound = entry; + } + ClockFmtScnStorage_GC.count++; + + /* if GC ist full */ + if (ClockFmtScnStorage_GC.count > CLOCK_FMT_SCN_STORAGE_GC_SIZE) { + + /* GC stack is LIFO: delete first inserted entry */ + ClockFmtScnStorage *delEnt = ClockFmtScnStorage_GC.stackBound; + ClockFmtScnStorage_GC.stackBound = delEnt->prevPtr; + TclSpliceOut(delEnt, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + delEnt->prevPtr = delEnt->nextPtr = NULL; + /* remove it now */ + ClockFmtScnStorageDelete(delEnt); + } +} +inline void +ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) +{ + TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + if (ClockFmtScnStorage_GC.stackBound == entry) { + ClockFmtScnStorage_GC.stackBound = entry->prevPtr; + } + entry->prevPtr = entry->nextPtr = NULL; +} + +#endif + +/* + *---------------------------------------------------------------------- + */ + +static Tcl_HashTable FmtScnHashTable; +static int initFmtScnHashTable = 0; + +inline Tcl_HashEntry * +HashEntry4FmtScn(ClockFmtScnStorage *fss) { + return (Tcl_HashEntry*)(fss + 1); +}; +inline ClockFmtScnStorage * +FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) { + return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage)); +}; + +/* + * Format storage hash (list of formats shared across all threads). + */ + +static Tcl_HashEntry * +ClockFmtScnStorageAllocProc( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ +{ + ClockFmtScnStorage *fss; + + const char *string = (const char *) keyPtr; + Tcl_HashEntry *hPtr; + unsigned int size, + allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry); + + allocsize += (size = strlen(string) + 1); + if (size > sizeof(hPtr->key)) { + allocsize -= sizeof(hPtr->key); + } + + fss = ckalloc(allocsize); + + /* initialize */ + memset(fss, 0, sizeof(*fss)); + + hPtr = HashEntry4FmtScn(fss); + memcpy(&hPtr->key.string, string, size); + hPtr->clientData = 0; /* currently unused */ + + return hPtr; +} + +static void +ClockFmtScnStorageFreeProc( + Tcl_HashEntry *hPtr) +{ + ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr); + ClockScanToken *tok; + + tok = fss->firstScnTok; + while (tok != NULL) { + if (tok->nextTok == tok + 1) { + tok++; + /*****************************/ + } else { + tok = tok->nextTok; + } + } + + ckfree(fss); +} + +static void +ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + /* + * This will delete a hash entry and call "ckfree" for storage self, if + * some additionally handling required, freeEntryProc can be used instead + */ + Tcl_DeleteHashEntry(hPtr); +} + + +/* + * Derivation of tclStringHashKeyType with another allocEntryProc + */ + +static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; + + +/* + *---------------------------------------------------------------------- + */ + +static ClockFmtScnStorage * +FindOrCreateFmtScnStorage( + Tcl_Interp *interp, + const char *strFmt) +{ + ClockFmtScnStorage *fss = NULL; + int new; + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&ClockFmtMutex); + + /* if not yet initialized */ + if (!initFmtScnHashTable) { + /* initialize type */ + memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); + ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; + ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; + initFmtScnHashTable = 1; + + /* initialize hash table */ + Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, + &ClockFmtScnStorageHashKeyType); + } + + /* get or create entry (and alocate storage) */ + hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); + if (hPtr != NULL) { + + fss = FmtScn4HashEntry(hPtr); + + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* unlink if it is currently in GC */ + if (new == 0 && fss->objRefCount == 0) { + ClockFmtScnStorage_GC_Out(fss); + } + #endif + + /* new reference, so increment in lock right now */ + fss->objRefCount++; + } + + Tcl_MutexUnlock(&ClockFmtMutex); + + if (fss == NULL && interp != NULL) { + Tcl_AppendResult(interp, "retrieve clock format failed \"", + strFmt ? strFmt : "", "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + } + + return fss; +} + + +/* + * Type definition. + */ + +Tcl_ObjType ClockFmtObjType = { + "clock-format", /* name */ + ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ + ClockFmtObj_DupInternalRep, /* dupIntRepProc */ + ClockFmtObj_UpdateString, /* updateStringProc */ + ClockFmtObj_SetFromAny /* setFromAnyProc */ +}; + +#define SetObjClockFmtScn(objPtr, fss) \ + objPtr->internalRep.twoPtrValue.ptr1 = fss +#define ObjClockFmtScn(objPtr) \ + (ClockFmtScnStorage *)objPtr->internalRep.twoPtrValue.ptr1; + +#define SetObjLitStorage(objPtr, lit) \ + objPtr->internalRep.twoPtrValue.ptr2 = lit +#define ObjLitStorage(objPtr) \ + (ClockLitStorage *)objPtr->internalRep.twoPtrValue.ptr2; + +#define ClockFmtObj_SetObjIntRep(objPtr, fss, lit) \ + objPtr->internalRep.twoPtrValue.ptr1 = fss, \ + objPtr->internalRep.twoPtrValue.ptr2 = lit, \ + objPtr->typePtr = &ClockFmtObjType; + +/* + *---------------------------------------------------------------------- + */ +static void +ClockFmtObj_DupInternalRep(srcPtr, copyPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *copyPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr); + // ClockLitStorage *lit = ObjLitStorage(srcPtr); + + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + fss->objRefCount++; + Tcl_MutexUnlock(&ClockFmtMutex); + } + + ClockFmtObj_SetObjIntRep(copyPtr, fss, NULL); + + /* if no format representation, dup string representation */ + if (fss == NULL) { + copyPtr->bytes = ckalloc(srcPtr->length + 1); + memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1); + copyPtr->length = srcPtr->length; + } +} +/* + *---------------------------------------------------------------------- + */ +static void +ClockFmtObj_FreeInternalRep(objPtr) + Tcl_Obj *objPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + // ClockLitStorage *lit = ObjLitStorage(objPtr); + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + /* decrement object reference count of format/scan storage */ + if (--fss->objRefCount <= 0) { + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* don't remove it right now (may be reusable), just add to GC */ + ClockFmtScnStorageGC_In(fss); + #else + /* remove storage (format representation) */ + ClockFmtScnStorageDelete(fss); + #endif + } + Tcl_MutexUnlock(&ClockFmtMutex); + } + SetObjClockFmtScn(objPtr, NULL); + SetObjLitStorage(objPtr, NULL); + objPtr->typePtr = NULL; +}; +/* + *---------------------------------------------------------------------- + */ +static int +ClockFmtObj_SetFromAny(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + ClockFmtScnStorage *fss; + const char *strFmt = TclGetString(objPtr); + + if (!strFmt || (fss = FindOrCreateFmtScnStorage(interp, strFmt)) == NULL) { + return TCL_ERROR; + } + + if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) + objPtr->typePtr->freeIntRepProc(objPtr); + ClockFmtObj_SetObjIntRep(objPtr, fss, NULL); + return TCL_OK; +}; +/* + *---------------------------------------------------------------------- + */ +static void +ClockFmtObj_UpdateString(objPtr) + Tcl_Obj *objPtr; +{ + char *name = "UNKNOWN"; + int len; + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + + if (fss != NULL) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + name = hPtr->key.string; + } + len = strlen(name); + objPtr->length = len, + objPtr->bytes = ckalloc((size_t)++len); + if (objPtr->bytes) + memcpy(objPtr->bytes, name, len); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetClockFrmScnFromObj -- + * + * Returns a clock format/scan representation of (*objPtr), if possible. + * If something goes wrong, NULL is returned, and if interp is non-NULL, + * an error message is written there. + * + * Results: + * Valid representation of type ClockFmtScnStorage. + * + * Side effects: + * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr) + * and in global hash table, shared across all threads. + * + *---------------------------------------------------------------------- + */ + +ClockFmtScnStorage * +Tcl_GetClockFrmScnFromObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + ClockFmtScnStorage *fss; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + fss = ObjClockFmtScn(objPtr); + + if (fss == NULL) { + const char *strFmt = TclGetString(objPtr); + fss = FindOrCreateFmtScnStorage(interp, strFmt); + } + + return fss; +} + + +static void +Tcl_GetClockFrmScnFinalize() +{ +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* clear GC */ + ClockFmtScnStorage_GC.stackPtr = NULL; + ClockFmtScnStorage_GC.stackBound = NULL; + ClockFmtScnStorage_GC.count = 0; +#endif + if (initFmtScnHashTable) { + Tcl_DeleteHashTable(&FmtScnHashTable); + } + Tcl_MutexFinalize(&ClockFmtMutex); +} +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclDate.c b/generic/tclDate.c index a31e0fc..389b245 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -570,12 +570,12 @@ static const yytype_int8 yyrhs[] = /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 176, 176, 177, 180, 183, 186, 189, 192, 195, - 198, 202, 207, 210, 216, 222, 230, 236, 247, 251, - 255, 261, 265, 269, 273, 277, 283, 287, 292, 297, - 302, 307, 311, 316, 320, 325, 332, 336, 342, 351, - 360, 370, 384, 389, 392, 395, 398, 401, 404, 409, - 412, 417, 421, 425, 431, 449, 452 + 0, 177, 177, 178, 181, 184, 187, 190, 193, 196, + 199, 203, 208, 211, 217, 223, 231, 237, 248, 252, + 256, 262, 266, 270, 274, 278, 284, 288, 293, 298, + 303, 308, 312, 317, 321, 326, 333, 337, 343, 352, + 361, 371, 385, 390, 393, 396, 399, 402, 405, 410, + 413, 418, 422, 426, 432, 450, 453 }; #endif diff --git a/generic/tclDate.h b/generic/tclDate.h index 6ba9620..c3c362a 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -66,13 +66,55 @@ typedef enum _MERIDIAN { } MERIDIAN; /* + * Clock scan and format facilities. + */ + +#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 + + +typedef struct ClockFormatToken ClockFormatToken; +typedef struct ClockScanToken ClockScanToken; +typedef struct ClockFmtScnStorage ClockFmtScnStorage; + +typedef struct ClockFormatToken { + ClockFormatToken *nextTok; +} ClockFormatToken; + +typedef struct ClockScanToken { + ClockScanToken *nextTok; +} ClockScanToken; + +typedef struct ClockFmtScnStorage { + int objRefCount; /* Reference count shared across threads */ + ClockScanToken *firstScnTok; + ClockFormatToken *firstFmtTok; +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + ClockFmtScnStorage *nextPtr; + ClockFmtScnStorage *prevPtr; +#endif +/* +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, + * stored by offset +sizeof(self) */ +} ClockFmtScnStorage; + +typedef struct ClockLitStorage { + int dummy; +} ClockLitStorage; + +/* * Prototypes of module functions. */ MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); -MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); +MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); + +/* tclClockFmt.c module declarations */ + +MODULE_SCOPE ClockFmtScnStorage * + Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); + /* * Other externals. diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index ac781ad..d500d6b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -9,6 +9,7 @@ * * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 2015 Sergey G. Brester aka sebres. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 7ef70ce..59469fd 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -25,8 +25,12 @@ proc _test_get_commands {lst} { regsub -all {(?:^|\n)[ \t]*(\#[^\n]*)(?=\n\s*[\{\#])} $lst "\n{\\1}" } -proc test-scan {{rep 100000}} { - foreach c [_test_get_commands { +proc test-scan {{reptime 1000}} { + foreach _(c) [_test_get_commands { + # Scan : date + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} + #return + #{**STOP** : Wed Nov 25 01:00:00 CET 2015} # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday @@ -64,33 +68,37 @@ proc test-scan {{rep 100000}} { clock scan "19:18:30 EST" -base 148863600 } }] { - puts "% [regsub -all {\n[ \t]*} $c {; }]" - if {[regexp {\s*\#} $c]} continue - puts [clock format [if 1 $c] -locale en] - puts [time $c $rep] + puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" + if {[regexp {\s*\#} $_(c)]} continue + puts [clock format [if 1 $_(c)] -locale en] + puts [timerate $_(c) $reptime] puts "" } } -proc test-other {{rep 100000}} { - foreach c [_test_get_commands { +proc test-other {{reptime 1000}} { + foreach _(c) [_test_get_commands { # Bad zone {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} }] { - puts "% [regsub -all {\n[ \t]*} $c {; }]" - if {[regexp {\s*\#} $c]} continue - puts [if 1 $c] - puts [time $c $rep] + puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" + if {[regexp {\s*\#} $_(c)]} continue + puts [if 1 $_(c)] + puts [timerate $_(c) $reptime] puts "" } } -proc test {factor} { +proc test {{reptime 1000}} { puts "" - test-scan [expr 10000 * $factor] - test-other [expr 5000 * $factor] + test-scan $reptime + test-other $reptime puts \n**OK** } -test 20; # 50 +test 250; # 250 ms diff --git a/unix/Makefile.in b/unix/Makefile.in index c4f6136..b220139 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -396,6 +396,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclBinary.c \ $(GENERIC_DIR)/tclCkalloc.c \ $(GENERIC_DIR)/tclClock.c \ + $(GENERIC_DIR)/tclClockFmt.c \ $(GENERIC_DIR)/tclCmdAH.c \ $(GENERIC_DIR)/tclCmdIL.c \ $(GENERIC_DIR)/tclCmdMZ.c \ @@ -1073,6 +1074,9 @@ tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c tclClock.o: $(GENERIC_DIR)/tclClock.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c +tclClockFmt.o: $(GENERIC_DIR)/tclClockFmt.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClockFmt.c + tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c diff --git a/win/Makefile.in b/win/Makefile.in index e967ef3..82e5516 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -228,6 +228,7 @@ GENERIC_OBJS = \ tclBinary.$(OBJEXT) \ tclCkalloc.$(OBJEXT) \ tclClock.$(OBJEXT) \ + tclClockFmt.$(OBJEXT) \ tclCmdAH.$(OBJEXT) \ tclCmdIL.$(OBJEXT) \ tclCmdMZ.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 26ee669..d6dbf85 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -270,6 +270,7 @@ COREOBJS = \ $(TMP_DIR)\tclBinary.obj \ $(TMP_DIR)\tclCkalloc.obj \ $(TMP_DIR)\tclClock.obj \ + $(TMP_DIR)\tclClockFmt.obj \ $(TMP_DIR)\tclCmdAH.obj \ $(TMP_DIR)\tclCmdIL.obj \ $(TMP_DIR)\tclCmdMZ.obj \ -- cgit v0.12 From 3d02b25690bc4f8c08d1292375acd5194a86b086 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:09:02 +0000 Subject: [temp-commit]: tclClockFmt.c - 2nd try (with cherry picking of tclSE incompatible facilities) Prepared for common usage of scan command (free scan / format scan) --- generic/tclClock.c | 328 +++++++++++++++++++--------------------------- generic/tclClockFmt.c | 117 +++++++++++++++-- generic/tclDate.h | 63 ++++++++- tests-perf/clock.perf.tcl | 4 +- 4 files changed, 297 insertions(+), 215 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index c869cf4..888757f 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -136,29 +136,6 @@ typedef struct ClockClientData { */ } ClockClientData; -/* - * Structure containing the fields used in [clock format] and [clock scan] - */ - -typedef struct TclDateFields { - Tcl_WideInt seconds; /* Time expressed in seconds from the Posix - * epoch */ - Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds - * from the Posix epoch */ - int tzOffset; /* Time zone offset in seconds east of - * Greenwich */ - Tcl_Obj *tzName; /* Time zone name */ - int julianDay; /* Julian Day Number in local time zone */ - enum {BCE=1, CE=0} era; /* Era */ - int gregorian; /* Flag == 1 if the date is Gregorian */ - int year; /* Year of the era */ - int dayOfYear; /* Day of the year (1 January == 1) */ - int month; /* Month number */ - int dayOfMonth; /* Day of the month */ - int iso8601Year; /* ISO8601 week-based year */ - int iso8601Week; /* ISO8601 week number */ - int dayOfWeek; /* Day of the week */ -} TclDateFields; static const char *const eras[] = { "CE", "BCE", NULL }; /* @@ -241,8 +218,8 @@ static int ClockScanObjCmd( int objc, Tcl_Obj *const objv[]); static int ClockFreeScan( ClientData clientData, Tcl_Interp *interp, - Tcl_Obj *strObj, Tcl_WideInt baseVal, - Tcl_Obj *timezoneObj, Tcl_Obj *locale); + register TclDateFields *date, + Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); static struct tm * ThreadSafeLocalTime(const time_t *); static unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); @@ -2339,20 +2316,13 @@ ClockMicrosecondsObjCmd( } -typedef struct _ClockFmtScnArgs { - Tcl_Obj *formatObj; /* Format */ - Tcl_Obj *localeObj; /* Locale */ - Tcl_Obj *timezoneObj; /* Timezone */ - Tcl_Obj *baseObj; /* Base (scan only) */ -} _ClockFmtScnArgs; - static int _ClockParseFmtScnArgs( ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ - _ClockFmtScnArgs *resOpts, /* Result vector: format, locale, timezone... */ + ClockFmtScnCmdArgs *resOpts, /* Result vector: format, locale, timezone... */ int forScan /* Flag to differentiate between format and scan */ ) { ClockClientData *dataPtr = clientData; @@ -2455,7 +2425,7 @@ ClockParseformatargsObjCmd( { ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; - _ClockFmtScnArgs resOpts; /* Format, locale and timezone */ + ClockFmtScnCmdArgs resOpts; /* Format, locale and timezone */ Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int ret; @@ -2520,12 +2490,10 @@ ClockScanObjCmd( ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; - Tcl_Time retClock; - char *string, *format = NULL; - int gmt, ret = 0; - char *locale; - _ClockFmtScnArgs opts; /* Format, locale, timezone and base */ - Tcl_WideInt baseVal; /* Base value */ + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ + TclDateFields date; /* Date fields used for converting */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, "string " @@ -2547,6 +2515,8 @@ ClockScanObjCmd( return ret; } + ret = TCL_ERROR; + if (opts.baseObj != NULL) { if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { return TCL_ERROR; @@ -2557,28 +2527,45 @@ ClockScanObjCmd( baseVal = (Tcl_WideInt) now.sec; } + date.tzName = NULL; + + /* If time zone not specified use system time zone */ + if ( opts.timezoneObj == NULL + || TclGetString(opts.timezoneObj) == NULL + || opts.timezoneObj->length == 0 + ) { + opts.timezoneObj = ClockGetSystemTimeZone(clientData, interp); + if (opts.timezoneObj == NULL) { + goto done; + } + } + + /* Get the data for time changes in the given zone */ + + opts.timezoneObj = ClockSetupTimeZone(clientData, interp, opts.timezoneObj); + if (opts.timezoneObj == NULL) { + goto done; + } + + /* + * Extract year, month and day from the base time for the parser to use as + * defaults + */ + + date.tzData = ClockGetTZData(clientData, interp, opts.timezoneObj); + if (date.tzData == NULL) { + goto done; + } + date.seconds = baseVal; + if (ClockGetDateFields(interp, &date, date.tzData, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; + } + /* If free scan */ if (opts.formatObj == NULL) { -#if 0 - /* Tcled FreeScan proc - */ - Tcl_Obj *callargs[5]; - /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ - if (opts.localeObj != NULL) { - Tcl_SetResult(interp, - "legacy [clock scan] does not support -locale", TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); - return TCL_ERROR; - } - callargs[0] = literals[LIT_FREESCAN]; - callargs[1] = objv[1]; - callargs[2] = opts.baseObj != NULL ? opts.baseObj : Tcl_NewWideIntObj(baseVal); - callargs[3] = opts.timezoneObj != NULL ? opts.timezoneObj : literals[LIT__NIL]; - callargs[4] = opts.localeObj != NULL ? opts.localeObj : literals[LIT_C]; - return Tcl_EvalObjv(interp, 5, callargs, 0); -#else /* Use compiled version of FreeScan - */ - /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ if (opts.localeObj != NULL) { Tcl_SetResult(interp, @@ -2586,21 +2573,9 @@ ClockScanObjCmd( Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); return TCL_ERROR; } - return ClockFreeScan(clientData, interp, objv[1], baseVal, - opts.timezoneObj, opts.localeObj); -#endif - } - - - // **** - string = TclGetString(objv[1]); - // **** timezone = ClockGetSystemTimeZone(clientData, interp) - /* - if (timezoneObj == NULL) { - goto done; - } - */ - + ret = ClockFreeScan(clientData, interp, &date, objv[1], &opts); + } + else if (0) { /* TODO: Tcled Scan proc - */ int ret; @@ -2612,19 +2587,45 @@ ClockScanObjCmd( Tcl_DecrRefCount(callargs[0]); return ret; } + else { + /* Use compiled version of Scan - */ + + ret = ClockScan(clientData, interp, &date, objv[1], &opts); + } - if (1) { + if (ret != TCL_OK) { + goto done; + } - ClockFmtScnStorage * fss; - if ((fss = Tcl_GetClockFrmScnFromObj(interp, opts.formatObj)) == NULL) { - return TCL_ERROR; - }; + /* If needed assemble julianDay using new year, month, etc. */ + if (date.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + } + + /* Local seconds to UTC (stored in date.seconds) */ - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)fss)); + date.localSeconds = + -210866803200L + + ( 86400 * (Tcl_WideInt)date.julianDay ) + + ( date.secondOfDay % 86400 ); + if (ConvertLocalToUTC(interp, &date, date.tzData, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; } - + + ret = TCL_OK; + +done: + + Tcl_UnsetObjRef(date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(date.seconds)); return TCL_OK; } @@ -2634,57 +2635,17 @@ int ClockFreeScan( ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ + register + TclDateFields *date, /* Date fields used for converting */ Tcl_Obj *strObj, /* String containing the time to scan */ - Tcl_WideInt baseVal, /* Base time, expressed in seconds from the Epoch */ - Tcl_Obj *timezoneObj, /* Default time zone in which the time will be expressed */ - Tcl_Obj *locale) /* (Unused) Name of the locale where the time will be scanned. */ + ClockFmtScnCmdArgs *opts) /* Command options */ { - enum Flags {CL_INVALIDATE = (signed int)0x80000000}; - ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; DateInfo yy; /* parse structure of TclClockFreeScan */ - TclDateFields date; /* date fields used for converting from seconds */ - Tcl_Obj *tzdata; - int secondOfDay; /* Seconds of day (time only calculation) */ - Tcl_WideInt seconds; int ret = TCL_ERROR; - date.tzName = NULL; - - /* If time zone not specified use system time zone */ - if (timezoneObj == NULL || - TclGetString(timezoneObj) == NULL || timezoneObj->length == 0) { - timezoneObj = ClockGetSystemTimeZone(clientData, interp); - if (timezoneObj == NULL) { - goto done; - } - } - - /* Get the data for time changes in the given zone */ - - timezoneObj = ClockSetupTimeZone(clientData, interp, timezoneObj); - if (timezoneObj == NULL) { - goto done; - } - - /* - * Extract year, month and day from the base time for the parser to use as - * defaults - */ - - tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if (tzdata == NULL) { - goto done; - } - date.seconds = baseVal; - if (ClockGetDateFields(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; - } - - secondOfDay = date.localSeconds % 86400; /* * Parse the date. The parser will fill a structure "yy" with date, time, @@ -2692,9 +2653,9 @@ ClockFreeScan( */ yy.dateInput = Tcl_GetString(strObj); - yy.dateYear = date.year; - yy.dateMonth = date.month; - yy.dateDay = date.dayOfMonth; + yy.dateYear = date->year; + yy.dateMonth = date->month; + yy.dateDay = date->dayOfMonth; if (TclClockFreeScan(interp, &yy) != TCL_OK) { Tcl_Obj *msg = Tcl_NewObj(); @@ -2717,10 +2678,10 @@ ClockFreeScan( } yy.dateYear += ClockCurrentYearCentury(clientData, interp); } - date.era = CE; - date.year = yy.dateYear; - date.month = yy.dateMonth; - date.dayOfMonth = yy.dateDay; + date->era = CE; + date->year = yy.dateYear; + date->month = yy.dateMonth; + date->dayOfMonth = yy.dateDay; if (yy.dateHaveTime == 0) { yy.dateHaveTime = -1; } @@ -2738,34 +2699,34 @@ ClockFreeScan( tzObjStor = ClockFormatNumericTimeZone( 60 * minEast + 3600 * dstFlag); - timezoneObj = ClockSetupTimeZone(clientData, interp, tzObjStor); - if (tzObjStor != timezoneObj) { + opts->timezoneObj = ClockSetupTimeZone(clientData, interp, tzObjStor); + if (tzObjStor != opts->timezoneObj) { Tcl_DecrRefCount(tzObjStor); } - if (timezoneObj == NULL) { + if (opts->timezoneObj == NULL) { goto done; } - tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if (tzdata == NULL) { + date->tzData = ClockGetTZData(clientData, interp, opts->timezoneObj); + if (date->tzData == NULL) { goto done; } } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - date.julianDay = CL_INVALIDATE; + date->julianDay = CL_INVALIDATE; /* * Assemble date, time, zone into seconds-from-epoch */ - Tcl_SetObjRef(date.tzName, timezoneObj); + Tcl_SetObjRef(date->tzName, opts->timezoneObj); if (yy.dateHaveTime == -1) { - secondOfDay = 0; + date->secondOfDay = 0; } else if (yy.dateHaveTime) { - secondOfDay = ToSeconds(yy.dateHour, yy.dateMinutes, + date->secondOfDay = ToSeconds(yy.dateHour, yy.dateMinutes, yy.dateSeconds, yy.dateMeridian); } else @@ -2775,7 +2736,10 @@ ClockFreeScan( && ( yy.dateRelMonth != 0 || yy.dateRelDay != 0 ) ) ) { - secondOfDay = 0; + date->secondOfDay = 0; + } + else { + date->secondOfDay = date->localSeconds % 86400; } /* @@ -2792,26 +2756,26 @@ repeat_rel: int m, h; /* if needed extract year, month, etc. again */ - if (date.month == CL_INVALIDATE) { - GetGregorianEraYearDay(&date, GREGORIAN_CHANGE_DATE); - GetMonthDay(&date); - GetYearWeekDay(&date, GREGORIAN_CHANGE_DATE); + if (date->month == CL_INVALIDATE) { + GetGregorianEraYearDay(date, GREGORIAN_CHANGE_DATE); + GetMonthDay(date); + GetYearWeekDay(date, GREGORIAN_CHANGE_DATE); } /* add the requisite number of months */ - date.month += yy.dateRelMonth - 1; - date.year += date.month / 12; - m = date.month % 12; - date.month = m + 1; + date->month += yy.dateRelMonth - 1; + date->year += date->month / 12; + m = date->month % 12; + date->month = m + 1; /* if the day doesn't exist in the current month, repair it */ - h = hath[IsGregorianLeapYear(&date)][m]; - if (date.dayOfMonth > h) { - date.dayOfMonth = h; + h = hath[IsGregorianLeapYear(date)][m]; + if (date->dayOfMonth > h) { + date->dayOfMonth = h; } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - date.julianDay = CL_INVALIDATE; + date->julianDay = CL_INVALIDATE; yy.dateRelMonth = 0; } @@ -2820,19 +2784,19 @@ repeat_rel: if (yy.dateRelDay) { /* assemble julianDay using new year, month, etc. */ - if (date.julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + if (date->julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(date, GREGORIAN_CHANGE_DATE); } - date.julianDay += yy.dateRelDay; + date->julianDay += yy.dateRelDay; /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ - date.month = CL_INVALIDATE; + date->month = CL_INVALIDATE; yy.dateRelDay = 0; } /* relative time (seconds) */ - secondOfDay += yy.dateRelSeconds; + date->secondOfDay += yy.dateRelSeconds; yy.dateRelSeconds = 0; } @@ -2845,20 +2809,20 @@ repeat_rel: int monthDiff; /* if needed extract year, month, etc. again */ - if (date.month == CL_INVALIDATE) { - GetGregorianEraYearDay(&date, GREGORIAN_CHANGE_DATE); - GetMonthDay(&date); - GetYearWeekDay(&date, GREGORIAN_CHANGE_DATE); + if (date->month == CL_INVALIDATE) { + GetGregorianEraYearDay(date, GREGORIAN_CHANGE_DATE); + GetMonthDay(date); + GetYearWeekDay(date, GREGORIAN_CHANGE_DATE); } if (yy.dateMonthOrdinal > 0) { - monthDiff = yy.dateMonth - date.month; + monthDiff = yy.dateMonth - date->month; if (monthDiff <= 0) { monthDiff += 12; } yy.dateMonthOrdinal--; } else { - monthDiff = date.month - yy.dateMonth; + monthDiff = date->month - yy.dateMonth; if (monthDiff >= 0) { monthDiff -= 12; } @@ -2867,7 +2831,7 @@ repeat_rel: /* process it further via relative times */ yy.dateHaveRel++; - date.year += yy.dateMonthOrdinal; + date->year += yy.dateMonthOrdinal; yy.dateRelMonth += monthDiff; yy.dateHaveOrdinalMonth = 0; @@ -2881,48 +2845,24 @@ repeat_rel: if (yy.dateHaveDay && !yy.dateHaveDate) { /* if needed assemble julianDay now */ - if (date.julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + if (date->julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(date, GREGORIAN_CHANGE_DATE); } - date.era = CE; - date.julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date.julianDay + 6) + date->era = CE; + date->julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date->julianDay + 6) + 7 * yy.dateDayOrdinal; if (yy.dateDayOrdinal > 0) { - date.julianDay -= 7; + date->julianDay -= 7; } } - /* If needed assemble julianDay using new year, month, etc. */ - if (date.julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); - } - - /* Local seconds to UTC */ - - date.localSeconds = - -210866803200L - + ( 86400 * (Tcl_WideInt)date.julianDay ) - + ( secondOfDay % 86400 ); - - if (ConvertLocalToUTC(interp, &date, tzdata, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; - } - - seconds = date.seconds; + /* Free scanning completed - date ready */ ret = TCL_OK; done: - Tcl_UnsetObjRef(date.tzName); - - if (ret != TCL_OK) { - return ret; - } - - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(seconds)); return TCL_OK; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index fa89dde..356965d 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -35,8 +35,6 @@ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); * Clock scan and format facilities. */ -#define TOK_CHAIN_BLOCK_SIZE 8 - /* *---------------------------------------------------------------------- */ @@ -139,16 +137,16 @@ ClockFmtScnStorageFreeProc( Tcl_HashEntry *hPtr) { ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr); - ClockScanToken *tok; - - tok = fss->firstScnTok; - while (tok != NULL) { - if (tok->nextTok == tok + 1) { - tok++; - /*****************************/ - } else { - tok = tok->nextTok; - } + + if (fss->scnTok != NULL) { + ckfree(fss->scnTok); + fss->scnTok = NULL; + fss->scnTokC = 0; + } + if (fss->fmtTok != NULL) { + ckfree(fss->fmtTok); + fss->fmtTok = NULL; + fss->fmtTokC = 0; } ckfree(fss); @@ -394,6 +392,101 @@ Tcl_GetClockFrmScnFromObj( } +#define AllocTokenInChain(tok, chain, tokC) \ + if ((tok) >= (chain) + (tokC)) { \ + (char *)(chain) = ckrealloc((char *)(chain), \ + (tokC) + sizeof((**(tok))) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); \ + if ((chain) == NULL) { return NULL; }; \ + (tok) = (chain) + (tokC); \ + (tokC) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } + +const char *ScnSTokenChars = "dmyYHMS"; +static ClockScanToken ScnSTokens[] = { + {CTOKT_DIGIT, 1, 2, 0}, +}; + +/* + *---------------------------------------------------------------------- + */ +ClockScanToken ** +ClockGetOrParseScanFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockScanToken **tok; + + if (formatObj->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, formatObj) != TCL_OK) { + return NULL; + } + } + + fss = ObjClockFmtScn(formatObj); + + if (fss == NULL) { + fss = FindOrCreateFmtScnStorage(interp, TclGetString(formatObj)); + if (fss == NULL) { + return NULL; + } + } + + /* if first time scanning - tokenize format */ + if (fss->scnTok == NULL) { + const char *strFmt; + register const char *p, *e; + + fss->scnTokC = CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; + fss->scnTok = + tok = ckalloc(sizeof(**tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); + (*tok)->type = CTOKT_EOB; + strFmt = TclGetString(formatObj); + for (e = p = strFmt, e += formatObj->length; p != e; p++) { + switch (*p) { + case '%': + if (p+1 >= e) + goto word_tok; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + p++; + // *tok = + break; + case ' ': + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + // *tok = + break; + default: +word_tok: + break; + } + } + } + + return fss->scnTok; +} + +/* + *---------------------------------------------------------------------- + */ +int +ClockScan( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + TclDateFields *date, /* Date fields used for converting */ + Tcl_Obj *strObj, /* String containing the time to scan */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockScanToken **tok; + + if (ClockGetOrParseScanFormat(interp, opts->formatObj) == NULL) { + return TCL_ERROR; + } + + // Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)fss)); + return TCL_ERROR; +} + + static void Tcl_GetClockFrmScnFinalize() { diff --git a/generic/tclDate.h b/generic/tclDate.h index c3c362a..0329b2c 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -57,6 +57,44 @@ typedef struct DateInfo { } DateInfo; +enum {CL_INVALIDATE = (signed int)0x80000000}; +/* + * Structure containing the command arguments supplied to [clock format] and [clock scan] + */ + +typedef struct ClockFmtScnCmdArgs { + Tcl_Obj *formatObj; /* Format */ + Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ + Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ + Tcl_Obj *baseObj; /* Base (scan only) */ +} ClockFmtScnCmdArgs; + +/* + * Structure containing the fields used in [clock format] and [clock scan] + */ + +typedef struct TclDateFields { + Tcl_WideInt seconds; /* Time expressed in seconds from the Posix + * epoch */ + Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds + * from the Posix epoch */ + int secondOfDay; /* Seconds of day (in-between time only calculation) */ + int tzOffset; /* Time zone offset in seconds east of + * Greenwich */ + Tcl_Obj *tzName; /* Time zone name (if set the refCount is incremented) */ + Tcl_Obj *tzData; /* Time zone data object (internally referenced) */ + int julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ +} TclDateFields; + /* * Meridian: am, pm, or 24-hour style. */ @@ -71,23 +109,31 @@ typedef enum _MERIDIAN { #define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 +#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 12 + +typedef enum _CLCKTOK_TYPE { + CTOKT_EOB=0, CTOKT_DIGIT, CTOKT_SPACE +} CLCKTOK_TYPE; -typedef struct ClockFormatToken ClockFormatToken; -typedef struct ClockScanToken ClockScanToken; typedef struct ClockFmtScnStorage ClockFmtScnStorage; typedef struct ClockFormatToken { - ClockFormatToken *nextTok; + CLCKTOK_TYPE type; } ClockFormatToken; typedef struct ClockScanToken { - ClockScanToken *nextTok; + unsigned short int type; + unsigned short int minSize; + unsigned short int maxSize; + unsigned short int offs; } ClockScanToken; typedef struct ClockFmtScnStorage { - int objRefCount; /* Reference count shared across threads */ - ClockScanToken *firstScnTok; - ClockFormatToken *firstFmtTok; + int objRefCount; /* Reference count shared across threads */ + ClockScanToken **scnTok; + unsigned int scnTokC; + ClockFormatToken **fmtTok; + unsigned int fmtTokC; #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 ClockFmtScnStorage *nextPtr; ClockFmtScnStorage *prevPtr; @@ -115,6 +161,9 @@ MODULE_SCOPE ClockFmtScnStorage * Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, + TclDateFields *date, Tcl_Obj *strObj, + ClockFmtScnCmdArgs *opts); /* * Other externals. diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 59469fd..7994428 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -28,8 +28,7 @@ proc _test_get_commands {lst} { proc test-scan {{reptime 1000}} { foreach _(c) [_test_get_commands { # Scan : date - {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} - #return + #{clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} #{**STOP** : Wed Nov 25 01:00:00 CET 2015} # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} @@ -80,6 +79,7 @@ proc test-other {{reptime 1000}} { foreach _(c) [_test_get_commands { # Bad zone {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + **STOP** # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) -- cgit v0.12 From 68f320e5ffddc67ee02c233c1b8396b198bde577 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:10:44 +0000 Subject: [temp-commit]: tclClockFmt.c - amend for 2nd try (with cherry picking of tclSE incompatible facilities) Prepared for common usage of both scan commands - free scan / scan with format (currently faked via eval to __org_scan); test cases passed. --- generic/tclClock.c | 218 +++++++++++++++++++++++++-------------------------- generic/tclDate.c | 51 +++--------- generic/tclDate.h | 93 ++++++++++++++-------- generic/tclGetDate.y | 39 ++------- 4 files changed, 189 insertions(+), 212 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 888757f..3c296b5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -218,7 +218,7 @@ static int ClockScanObjCmd( int objc, Tcl_Obj *const objv[]); static int ClockFreeScan( ClientData clientData, Tcl_Interp *interp, - register TclDateFields *date, + register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); static struct tm * ThreadSafeLocalTime(const time_t *); static unsigned long TzsetGetEpoch(void); @@ -2492,8 +2492,9 @@ ClockScanObjCmd( int ret; ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ - TclDateFields date; /* Date fields used for converting */ + Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, "string " @@ -2527,7 +2528,7 @@ ClockScanObjCmd( baseVal = (Tcl_WideInt) now.sec; } - date.tzName = NULL; + yydate.tzName = NULL; /* If time zone not specified use system time zone */ if ( opts.timezoneObj == NULL @@ -2552,12 +2553,12 @@ ClockScanObjCmd( * defaults */ - date.tzData = ClockGetTZData(clientData, interp, opts.timezoneObj); - if (date.tzData == NULL) { + yydate.tzData = ClockGetTZData(clientData, interp, opts.timezoneObj); + if (yydate.tzData == NULL) { goto done; } - date.seconds = baseVal; - if (ClockGetDateFields(interp, &date, date.tzData, GREGORIAN_CHANGE_DATE) + yydate.seconds = baseVal; + if (ClockGetDateFields(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } @@ -2573,10 +2574,10 @@ ClockScanObjCmd( Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); return TCL_ERROR; } - ret = ClockFreeScan(clientData, interp, &date, objv[1], &opts); + ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); } else - if (0) { + if (1) { /* TODO: Tcled Scan proc - */ int ret; Tcl_Obj *callargs[10]; @@ -2585,12 +2586,12 @@ ClockScanObjCmd( Tcl_IncrRefCount(callargs[0]); ret = Tcl_EvalObjv(interp, objc, callargs, 0); Tcl_DecrRefCount(callargs[0]); - return ret; + return ret; } else { /* Use compiled version of Scan - */ - ret = ClockScan(clientData, interp, &date, objv[1], &opts); + ret = ClockScan(clientData, interp, &yydate, objv[1], &opts); } if (ret != TCL_OK) { @@ -2599,18 +2600,18 @@ ClockScanObjCmd( /* If needed assemble julianDay using new year, month, etc. */ - if (date.julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(&date, GREGORIAN_CHANGE_DATE); + if (yydate.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } - /* Local seconds to UTC (stored in date.seconds) */ + /* Local seconds to UTC (stored in yydate.seconds) */ - date.localSeconds = + yydate.localSeconds = -210866803200L - + ( 86400 * (Tcl_WideInt)date.julianDay ) - + ( date.secondOfDay % 86400 ); + + ( 86400 * (Tcl_WideInt)yydate.julianDay ) + + ( yySeconds % 86400 ); - if (ConvertLocalToUTC(interp, &date, date.tzData, GREGORIAN_CHANGE_DATE) + if (ConvertLocalToUTC(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } @@ -2619,13 +2620,13 @@ ClockScanObjCmd( done: - Tcl_UnsetObjRef(date.tzName); + Tcl_UnsetObjRef(yydate.tzName); if (ret != TCL_OK) { return ret; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(date.seconds)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yydate.seconds)); return TCL_OK; } @@ -2636,28 +2637,28 @@ ClockFreeScan( ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ register - TclDateFields *date, /* Date fields used for converting */ + DateInfo *info, /* Date fields used for parsing & converting + * simultaneously a yy-parse structure of the + * TclClockFreeScan */ Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; + // ClockClientData *dataPtr = clientData; + // Tcl_Obj **literals = dataPtr->literals; - DateInfo yy; /* parse structure of TclClockFreeScan */ int ret = TCL_ERROR; - /* - * Parse the date. The parser will fill a structure "yy" with date, time, - * time zone, relative month/day/seconds, relative weekday, ordinal month. + * Parse the date. The parser will fill a structure "info" with date, + * time, time zone, relative month/day/seconds, relative weekday, ordinal + * month. + * Notice that many yy-defines point to values in the "info" or "date" + * structure, e. g. yySeconds -> info->date.secondOfDay or + * yySeconds -> info->date.month (same as yydate.month) */ - yy.dateInput = Tcl_GetString(strObj); + yyInput = Tcl_GetString(strObj); - yy.dateYear = date->year; - yy.dateMonth = date->month; - yy.dateDay = date->dayOfMonth; - - if (TclClockFreeScan(interp, &yy) != TCL_OK) { + if (TclClockFreeScan(interp, info) != TCL_OK) { Tcl_Obj *msg = Tcl_NewObj(); Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s", Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp))); @@ -2671,19 +2672,16 @@ ClockFreeScan( * midnight. */ - if (yy.dateHaveDate) { - if (yy.dateYear < 100) { - if (yy.dateYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { - yy.dateYear -= 100; + if (yyHaveDate) { + if (yyYear < 100) { + if (yyYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { + yyYear -= 100; } - yy.dateYear += ClockCurrentYearCentury(clientData, interp); + yyYear += ClockCurrentYearCentury(clientData, interp); } - date->era = CE; - date->year = yy.dateYear; - date->month = yy.dateMonth; - date->dayOfMonth = yy.dateDay; - if (yy.dateHaveTime == 0) { - yy.dateHaveTime = -1; + yydate.era = CE; + if (yyHaveTime == 0) { + yyHaveTime = -1; } } @@ -2692,10 +2690,10 @@ ClockFreeScan( * zone indicator of +-hhmm and setup this time zone. */ - if (yy.dateHaveZone) { + if (yyHaveZone) { Tcl_Obj *tzObjStor = NULL; - int minEast = -yy.dateTimezone; - int dstFlag = 1 - yy.dateDSTmode; + int minEast = -yyTimezone; + int dstFlag = 1 - yyDSTmode; tzObjStor = ClockFormatNumericTimeZone( 60 * minEast + 3600 * dstFlag); @@ -2706,40 +2704,40 @@ ClockFreeScan( if (opts->timezoneObj == NULL) { goto done; } - date->tzData = ClockGetTZData(clientData, interp, opts->timezoneObj); - if (date->tzData == NULL) { + yydate.tzData = ClockGetTZData(clientData, interp, opts->timezoneObj); + if (yydate.tzData == NULL) { goto done; } } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - date->julianDay = CL_INVALIDATE; + yydate.julianDay = CL_INVALIDATE; /* * Assemble date, time, zone into seconds-from-epoch */ - Tcl_SetObjRef(date->tzName, opts->timezoneObj); + Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); - if (yy.dateHaveTime == -1) { - date->secondOfDay = 0; + if (yyHaveTime == -1) { + yySeconds = 0; } else - if (yy.dateHaveTime) { - date->secondOfDay = ToSeconds(yy.dateHour, yy.dateMinutes, - yy.dateSeconds, yy.dateMeridian); + if (yyHaveTime) { + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); } else - if ( (yy.dateHaveDay && !yy.dateHaveDate) - || yy.dateHaveOrdinalMonth - || ( yy.dateHaveRel - && ( yy.dateRelMonth != 0 - || yy.dateRelDay != 0 ) ) + if ( (yyHaveDay && !yyHaveDate) + || yyHaveOrdinalMonth + || ( yyHaveRel + && ( yyRelMonth != 0 + || yyRelDay != 0 ) ) ) { - date->secondOfDay = 0; + yySeconds = 0; } else { - date->secondOfDay = date->localSeconds % 86400; + yySeconds = yydate.localSeconds % 86400; } /* @@ -2748,56 +2746,56 @@ ClockFreeScan( repeat_rel: - if (yy.dateHaveRel) { + if (yyHaveRel) { /* add months (or years in months) */ - if (yy.dateRelMonth != 0) { + if (yyRelMonth != 0) { int m, h; /* if needed extract year, month, etc. again */ - if (date->month == CL_INVALIDATE) { - GetGregorianEraYearDay(date, GREGORIAN_CHANGE_DATE); - GetMonthDay(date); - GetYearWeekDay(date, GREGORIAN_CHANGE_DATE); + if (yyMonth == CL_INVALIDATE) { + GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + GetMonthDay(&yydate); + GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); } /* add the requisite number of months */ - date->month += yy.dateRelMonth - 1; - date->year += date->month / 12; - m = date->month % 12; - date->month = m + 1; + yyMonth += yyRelMonth - 1; + yyYear += yyMonth / 12; + m = yyMonth % 12; + yyMonth = m + 1; /* if the day doesn't exist in the current month, repair it */ - h = hath[IsGregorianLeapYear(date)][m]; - if (date->dayOfMonth > h) { - date->dayOfMonth = h; + h = hath[IsGregorianLeapYear(&yydate)][m]; + if (yyDay > h) { + yyDay = h; } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - date->julianDay = CL_INVALIDATE; + yydate.julianDay = CL_INVALIDATE; - yy.dateRelMonth = 0; + yyRelMonth = 0; } /* add days (or other parts aligned to days) */ - if (yy.dateRelDay) { + if (yyRelDay) { /* assemble julianDay using new year, month, etc. */ - if (date->julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(date, GREGORIAN_CHANGE_DATE); + if (yydate.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } - date->julianDay += yy.dateRelDay; + yydate.julianDay += yyRelDay; /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ - date->month = CL_INVALIDATE; + yyMonth = CL_INVALIDATE; - yy.dateRelDay = 0; + yyRelDay = 0; } /* relative time (seconds) */ - date->secondOfDay += yy.dateRelSeconds; - yy.dateRelSeconds = 0; + yySeconds += yyRelSeconds; + yyRelSeconds = 0; } @@ -2805,35 +2803,35 @@ repeat_rel: * Do relative (ordinal) month */ - if (yy.dateHaveOrdinalMonth) { + if (yyHaveOrdinalMonth) { int monthDiff; /* if needed extract year, month, etc. again */ - if (date->month == CL_INVALIDATE) { - GetGregorianEraYearDay(date, GREGORIAN_CHANGE_DATE); - GetMonthDay(date); - GetYearWeekDay(date, GREGORIAN_CHANGE_DATE); + if (yyMonth == CL_INVALIDATE) { + GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + GetMonthDay(&yydate); + GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); } - if (yy.dateMonthOrdinal > 0) { - monthDiff = yy.dateMonth - date->month; + if (yyMonthOrdinalIncr > 0) { + monthDiff = yyMonthOrdinal - yyMonth; if (monthDiff <= 0) { monthDiff += 12; } - yy.dateMonthOrdinal--; + yyMonthOrdinalIncr--; } else { - monthDiff = date->month - yy.dateMonth; + monthDiff = yyMonth - yyMonthOrdinal; if (monthDiff >= 0) { monthDiff -= 12; } - yy.dateMonthOrdinal++; + yyMonthOrdinalIncr++; } /* process it further via relative times */ - yy.dateHaveRel++; - date->year += yy.dateMonthOrdinal; - yy.dateRelMonth += monthDiff; - yy.dateHaveOrdinalMonth = 0; + yyHaveRel++; + yyYear += yyMonthOrdinalIncr; + yyRelMonth += monthDiff; + yyHaveOrdinalMonth = 0; goto repeat_rel; } @@ -2842,18 +2840,18 @@ repeat_rel: * Do relative weekday */ - if (yy.dateHaveDay && !yy.dateHaveDate) { + if (yyHaveDay && !yyHaveDate) { /* if needed assemble julianDay now */ - if (date->julianDay == CL_INVALIDATE) { - GetJulianDayFromEraYearMonthDay(date, GREGORIAN_CHANGE_DATE); + if (yydate.julianDay == CL_INVALIDATE) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } - date->era = CE; - date->julianDay = WeekdayOnOrBefore(yy.dateDayNumber, date->julianDay + 6) - + 7 * yy.dateDayOrdinal; - if (yy.dateDayOrdinal > 0) { - date->julianDay -= 7; + yydate.era = CE; + yydate.julianDay = WeekdayOnOrBefore(yyDayNumber, yydate.julianDay + 6) + + 7 * yyDayOrdinal; + if (yyDayOrdinal > 0) { + yydate.julianDay -= 7; } } @@ -2863,7 +2861,7 @@ repeat_rel: done: - return TCL_OK; + return ret; } /*---------------------------------------------------------------------- diff --git a/generic/tclDate.c b/generic/tclDate.c index 389b245..a47f43d 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -109,31 +109,6 @@ #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) -#define yyDSTmode (info->dateDSTmode) -#define yyDayOrdinal (info->dateDayOrdinal) -#define yyDayNumber (info->dateDayNumber) -#define yyMonthOrdinal (info->dateMonthOrdinal) -#define yyHaveDate (info->dateHaveDate) -#define yyHaveDay (info->dateHaveDay) -#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) -#define yyHaveRel (info->dateHaveRel) -#define yyHaveTime (info->dateHaveTime) -#define yyHaveZone (info->dateHaveZone) -#define yyTimezone (info->dateTimezone) -#define yyDay (info->dateDay) -#define yyMonth (info->dateMonth) -#define yyYear (info->dateYear) -#define yyHour (info->dateHour) -#define yyMinutes (info->dateMinutes) -#define yySeconds (info->dateSeconds) -#define yyMeridian (info->dateMeridian) -#define yyRelMonth (info->dateRelMonth) -#define yyRelDay (info->dateRelDay) -#define yyRelSeconds (info->dateRelSeconds) -#define yyRelPointer (info->dateRelPointer) -#define yyInput (info->dateInput) -#define yyDigitCount (info->dateDigitCount) - #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 @@ -570,12 +545,12 @@ static const yytype_int8 yyrhs[] = /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 177, 177, 178, 181, 184, 187, 190, 193, 196, - 199, 203, 208, 211, 217, 223, 231, 237, 248, 252, - 256, 262, 266, 270, 274, 278, 284, 288, 293, 298, - 303, 308, 312, 317, 321, 326, 333, 337, 343, 352, - 361, 371, 385, 390, 393, 396, 399, 402, 405, 410, - 413, 418, 422, 426, 432, 450, 453 + 0, 152, 152, 153, 156, 159, 162, 165, 168, 171, + 174, 178, 183, 186, 192, 198, 206, 212, 223, 227, + 231, 237, 241, 245, 249, 253, 259, 263, 268, 273, + 278, 283, 287, 292, 296, 301, 308, 312, 318, 327, + 336, 346, 360, 365, 368, 371, 374, 377, 380, 385, + 388, 393, 397, 401, 407, 425, 428 }; #endif @@ -1842,16 +1817,16 @@ yyreduce: case 36: { - yyMonthOrdinal = 1; - yyMonth = (yyvsp[(2) - (2)].Number); + yyMonthOrdinalIncr = 1; + yyMonthOrdinal = (yyvsp[(2) - (2)].Number); ;} break; case 37: { - yyMonthOrdinal = (yyvsp[(2) - (3)].Number); - yyMonth = (yyvsp[(3) - (3)].Number); + yyMonthOrdinalIncr = (yyvsp[(2) - (3)].Number); + yyMonthOrdinal = (yyvsp[(3) - (3)].Number); ;} break; @@ -2722,7 +2697,7 @@ TclClockFreeScan( yyTimezone = 0; yyDSTmode = DSTmaybe; yyHaveOrdinalMonth = 0; - yyMonthOrdinal = 0; + yyMonthOrdinalIncr = 0; yyHaveDay = 0; yyDayOrdinal = 0; yyDayNumber = 0; @@ -2873,9 +2848,9 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinalIncr)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj((int) yyMonthOrdinal)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclDate.h b/generic/tclDate.h index 0329b2c..49420a2 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -14,19 +14,43 @@ #define _TCLCLOCK_H /* + * Structure containing the fields used in [clock format] and [clock scan] + */ + +typedef struct TclDateFields { + Tcl_WideInt seconds; /* Time expressed in seconds from the Posix + * epoch */ + Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds + * from the Posix epoch */ + int tzOffset; /* Time zone offset in seconds east of + * Greenwich */ + Tcl_Obj *tzName; /* Time zone name (if set the refCount is incremented) */ + Tcl_Obj *tzData; /* Time zone data object (internally referenced) */ + int julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ + int hour; /* Hours of day (in-between time only calculation) */ + int minutes; /* Minutes of day (in-between time only calculation) */ + int secondOfDay; /* Seconds of day (in-between time only calculation) */ +} TclDateFields; + +/* * Structure contains return parsed fields. */ typedef struct DateInfo { - time_t dateYear; - time_t dateMonth; - time_t dateDay; + TclDateFields date; + int dateHaveDate; - time_t dateHour; - time_t dateMinutes; - time_t dateSeconds; int dateMeridian; int dateHaveTime; @@ -39,6 +63,7 @@ typedef struct DateInfo { time_t dateRelSeconds; int dateHaveRel; + time_t dateMonthOrdinalIncr; time_t dateMonthOrdinal; int dateHaveOrdinalMonth; @@ -56,6 +81,36 @@ typedef struct DateInfo { const char* separatrix; /* String separating messages */ } DateInfo; +#define yydate (info->date) /* Date fields used for converting */ + +#define yyDay (info->date.dayOfMonth) +#define yyMonth (info->date.month) +#define yyYear (info->date.year) + +#define yyHour (info->date.hour) +#define yyMinutes (info->date.minutes) +#define yySeconds (info->date.secondOfDay) + +#define yyDSTmode (info->dateDSTmode) +#define yyDayOrdinal (info->dateDayOrdinal) +#define yyDayNumber (info->dateDayNumber) +#define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr) +#define yyMonthOrdinal (info->dateMonthOrdinal) +#define yyHaveDate (info->dateHaveDate) +#define yyHaveDay (info->dateHaveDay) +#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) +#define yyHaveRel (info->dateHaveRel) +#define yyHaveTime (info->dateHaveTime) +#define yyHaveZone (info->dateHaveZone) +#define yyTimezone (info->dateTimezone) +#define yyMeridian (info->dateMeridian) +#define yyRelMonth (info->dateRelMonth) +#define yyRelDay (info->dateRelDay) +#define yyRelSeconds (info->dateRelSeconds) +#define yyRelPointer (info->dateRelPointer) +#define yyInput (info->dateInput) +#define yyDigitCount (info->dateDigitCount) + enum {CL_INVALIDATE = (signed int)0x80000000}; /* @@ -70,32 +125,6 @@ typedef struct ClockFmtScnCmdArgs { } ClockFmtScnCmdArgs; /* - * Structure containing the fields used in [clock format] and [clock scan] - */ - -typedef struct TclDateFields { - Tcl_WideInt seconds; /* Time expressed in seconds from the Posix - * epoch */ - Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds - * from the Posix epoch */ - int secondOfDay; /* Seconds of day (in-between time only calculation) */ - int tzOffset; /* Time zone offset in seconds east of - * Greenwich */ - Tcl_Obj *tzName; /* Time zone name (if set the refCount is incremented) */ - Tcl_Obj *tzData; /* Time zone data object (internally referenced) */ - int julianDay; /* Julian Day Number in local time zone */ - enum {BCE=1, CE=0} era; /* Era */ - int gregorian; /* Flag == 1 if the date is Gregorian */ - int year; /* Year of the era */ - int dayOfYear; /* Day of the year (1 January == 1) */ - int month; /* Month number */ - int dayOfMonth; /* Day of the month */ - int iso8601Year; /* ISO8601 week-based year */ - int iso8601Week; /* ISO8601 week number */ - int dayOfWeek; /* Day of the week */ -} TclDateFields; - -/* * Meridian: am, pm, or 24-hour style. */ diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index d500d6b..571b7df 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -56,31 +56,6 @@ #define YYMALLOC ckalloc #define YYFREE(x) (ckfree((void*) (x))) -#define yyDSTmode (info->dateDSTmode) -#define yyDayOrdinal (info->dateDayOrdinal) -#define yyDayNumber (info->dateDayNumber) -#define yyMonthOrdinal (info->dateMonthOrdinal) -#define yyHaveDate (info->dateHaveDate) -#define yyHaveDay (info->dateHaveDay) -#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) -#define yyHaveRel (info->dateHaveRel) -#define yyHaveTime (info->dateHaveTime) -#define yyHaveZone (info->dateHaveZone) -#define yyTimezone (info->dateTimezone) -#define yyDay (info->dateDay) -#define yyMonth (info->dateMonth) -#define yyYear (info->dateYear) -#define yyHour (info->dateHour) -#define yyMinutes (info->dateMinutes) -#define yySeconds (info->dateSeconds) -#define yyMeridian (info->dateMeridian) -#define yyRelMonth (info->dateRelMonth) -#define yyRelDay (info->dateRelDay) -#define yyRelSeconds (info->dateRelSeconds) -#define yyRelPointer (info->dateRelPointer) -#define yyInput (info->dateInput) -#define yyDigitCount (info->dateDigitCount) - #define EPOCH 1970 #define START_OF_TIME 1902 #define END_OF_TIME 2037 @@ -331,12 +306,12 @@ date : tUNUMBER '/' tUNUMBER { ; ordMonth: tNEXT tMONTH { - yyMonthOrdinal = 1; - yyMonth = $2; + yyMonthOrdinalIncr = 1; + yyMonthOrdinal = $2; } | tNEXT tUNUMBER tMONTH { - yyMonthOrdinal = $2; - yyMonth = $3; + yyMonthOrdinalIncr = $2; + yyMonthOrdinal = $3; } ; @@ -933,7 +908,7 @@ TclClockFreeScan( yyTimezone = 0; yyDSTmode = DSTmaybe; yyHaveOrdinalMonth = 0; - yyMonthOrdinal = 0; + yyMonthOrdinalIncr = 0; yyHaveDay = 0; yyDayOrdinal = 0; yyDayNumber = 0; @@ -1084,9 +1059,9 @@ TclClockOldscanObjCmd( resultElement = Tcl_NewObj(); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj((int) yyMonthOrdinalIncr)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj((int) yyMonthOrdinal)); } Tcl_ListObjAppendElement(interp, result, resultElement); -- cgit v0.12 From 3f06a6ec89b41434fe38bede870563e35b809019 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:12:07 +0000 Subject: [temp-commit]: rewrite scan token map handling --- generic/tclClock.c | 2 + generic/tclClockFmt.c | 102 ++++++++++++++++++++++++++++++++++++---------- tests-perf/clock.perf.tcl | 12 +++++- 3 files changed, 93 insertions(+), 23 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 3c296b5..e00d6a2 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2576,6 +2576,7 @@ ClockScanObjCmd( } ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); } +#if 0 else if (1) { /* TODO: Tcled Scan proc - */ @@ -2588,6 +2589,7 @@ ClockScanObjCmd( Tcl_DecrRefCount(callargs[0]); return ret; } +#endif else { /* Use compiled version of Scan - */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 356965d..93416af 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -392,19 +392,32 @@ Tcl_GetClockFrmScnFromObj( } -#define AllocTokenInChain(tok, chain, tokC) \ - if ((tok) >= (chain) + (tokC)) { \ +#define AllocTokenInChain(tok, chain, tokCnt) \ + if (++(tok) >= (chain) + (tokCnt)) { \ (char *)(chain) = ckrealloc((char *)(chain), \ - (tokC) + sizeof((**(tok))) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); \ - if ((chain) == NULL) { return NULL; }; \ - (tok) = (chain) + (tokC); \ - (tokC) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } - -const char *ScnSTokenChars = "dmyYHMS"; -static ClockScanToken ScnSTokens[] = { + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ + if ((chain) == NULL) { goto done; }; \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ + *(tok) = NULL; + +const char *ScnSTokenMapChars = + "dmyYHMS"; +static ClockScanToken ScnSTokenMap[] = { + {CTOKT_DIGIT, 1, 2, 0}, + {CTOKT_DIGIT, 1, 2, 0}, + {CTOKT_DIGIT, 1, 2, 0}, + {CTOKT_DIGIT, 1, 4, 0}, + {CTOKT_DIGIT, 1, 2, 0}, + {CTOKT_DIGIT, 1, 2, 0}, {CTOKT_DIGIT, 1, 2, 0}, }; +const char *ScnSpecTokenMapChars = + " %"; +static ClockScanToken ScnSpecTokenMap[] = { + {CTOKT_SPACE, 1, 0xffff, 0}, +}; /* *---------------------------------------------------------------------- @@ -435,31 +448,73 @@ ClockGetOrParseScanFormat( /* if first time scanning - tokenize format */ if (fss->scnTok == NULL) { const char *strFmt; - register const char *p, *e; + register const char *p, *e, *cp, *word_start = NULL; + + Tcl_MutexLock(&ClockFmtMutex); fss->scnTokC = CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; fss->scnTok = - tok = ckalloc(sizeof(**tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); - (*tok)->type = CTOKT_EOB; + tok = ckalloc(sizeof(*tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); + *tok = NULL; strFmt = TclGetString(formatObj); for (e = p = strFmt, e += formatObj->length; p != e; p++) { switch (*p) { case '%': - if (p+1 >= e) - goto word_tok; - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + if (p+1 >= e) { + word_start = p; + continue; + } p++; - // *tok = + /* try to find modifier: */ + switch (*p) { + case '%': + word_start = p-1; + continue; + break; + case 'E': + goto ext_tok_E; + break; + case 'O': + goto ext_tok_O; + break; + default: + cp = strchr(ScnSTokenMapChars, *p); + if (!cp || *cp == '\0') { + word_start = p-1; + continue; + } + *tok = &ScnSTokenMap[cp - ScnSTokenMapChars]; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + break; + } break; case ' ': + cp = strchr(ScnSpecTokenMapChars, *p); + if (!cp || *cp == '\0') { + p--; + goto word_tok; + } + *tok = &ScnSpecTokenMap[cp - ScnSpecTokenMapChars]; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); - // *tok = break; default: word_tok: - break; + + continue; } + + continue; +ext_tok_E: + +ext_tok_O: + + /*******************/ + continue; + } + +done: + Tcl_MutexUnlock(&ClockFmtMutex); } return fss->scnTok; @@ -478,11 +533,16 @@ ClockScan( { ClockScanToken **tok; - if (ClockGetOrParseScanFormat(interp, opts->formatObj) == NULL) { + if ((tok = ClockGetOrParseScanFormat(interp, opts->formatObj)) == NULL) { return TCL_ERROR; } - // Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)fss)); + //*********************************** + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)tok)); + return TCL_OK; + + return TCL_ERROR; } diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 7994428..969e279 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -28,8 +28,16 @@ proc _test_get_commands {lst} { proc test-scan {{reptime 1000}} { foreach _(c) [_test_get_commands { # Scan : date - #{clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} - #{**STOP** : Wed Nov 25 01:00:00 CET 2015} + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} + {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} + {**STOP** : Wed Nov 25 01:00:00 CET 2015} + # Scan : long format test (allock chain) + {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} + # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): + {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + # Scan : again: + {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday -- cgit v0.12 From c313bacc9f0d53d7090a7bc98b24b78ecb92d2f4 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:15:36 +0000 Subject: [temp-commit]: clock scan tokenizer logic ready (still needs many rules) caching extended (currentYearCentury, yearOfCenturySwitch, lastBaseDate ...) --- generic/tclClock.c | 69 +++++++++++---- generic/tclClockFmt.c | 218 +++++++++++++++++++++++++++++++++++++++------- generic/tclDate.c | 1 - generic/tclDate.h | 88 ++++++++++++------- generic/tclGetDate.y | 1 - tests-perf/clock.perf.tcl | 98 ++++++++++++++++----- 6 files changed, 372 insertions(+), 103 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e00d6a2..2e7b854 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -117,6 +117,8 @@ typedef struct ClockClientData { Tcl_Obj **literals; /* Pool of object literals. */ /* Cache for current clock parameters, imparted via "configure" */ unsigned long LastTZEpoch; + int currentYearCentury; + int yearOfCenturySwitch; Tcl_Obj *SystemTimeZone; Tcl_Obj *SystemSetupTZData; Tcl_Obj *GMTSetupTimeZone; @@ -126,6 +128,9 @@ typedef struct ClockClientData { Tcl_Obj *LastUnnormSetupTimeZone; Tcl_Obj *LastSetupTimeZone; Tcl_Obj *LastSetupTZData; + /* Cache for last base (fast convert if base/tz not changed) */ + Tcl_Obj *lastBaseTimeZone; + TclDateFields lastBaseDate; /* /* [SB] TODO: back-port (from tclSE) the same date caching ... * Cache for last date (fast convert if date parsed was the same) * / @@ -325,6 +330,8 @@ TclClockInit( Tcl_IncrRefCount(data->literals[i]); } data->LastTZEpoch = 0; + data->currentYearCentury = -1; + data->yearOfCenturySwitch = -1; data->SystemTimeZone = NULL; data->SystemSetupTZData = NULL; data->GMTSetupTimeZone = NULL; @@ -335,6 +342,8 @@ TclClockInit( data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; + data->lastBaseTimeZone = NULL; + /* * Install the commands. */ @@ -368,6 +377,8 @@ ClockConfigureClear( ClockClientData *data) { data->LastTZEpoch = 0; + data->currentYearCentury = -1; + data->yearOfCenturySwitch = -1; Tcl_UnsetObjRef(data->SystemTimeZone); Tcl_UnsetObjRef(data->SystemSetupTZData); Tcl_UnsetObjRef(data->GMTSetupTimeZone); @@ -708,11 +719,16 @@ ClockCurrentYearCentury( { ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; - int year = 2000; + int year = dataPtr->currentYearCentury; - Tcl_Obj * yearObj = Tcl_ObjGetVar2(interp, - literals[LIT_CURRENTYEARCENTURY], NULL, TCL_LEAVE_ERR_MSG); - Tcl_GetIntFromObj(NULL, yearObj, &year); + if (year == -1) { + Tcl_Obj * yearObj; + year = 2000; + yearObj = Tcl_ObjGetVar2(interp, + literals[LIT_CURRENTYEARCENTURY], NULL, TCL_LEAVE_ERR_MSG); + Tcl_GetIntFromObj(NULL, yearObj, &year); + dataPtr->currentYearCentury = year; + } return year; } inline int @@ -722,11 +738,16 @@ ClockGetYearOfCenturySwitch( { ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; - int year = 37; - - Tcl_Obj * yearObj = Tcl_ObjGetVar2(interp, - literals[LIT_YEAROFCENTURYSWITCH], NULL, TCL_LEAVE_ERR_MSG); - Tcl_GetIntFromObj(NULL, yearObj, &year); + int year = dataPtr->yearOfCenturySwitch; + + if (year == -1) { + Tcl_Obj * yearObj; + year = 37; + yearObj = Tcl_ObjGetVar2(interp, + literals[LIT_YEAROFCENTURYSWITCH], NULL, TCL_LEAVE_ERR_MSG); + Tcl_GetIntFromObj(NULL, yearObj, &year); + dataPtr->yearOfCenturySwitch = year; + } return year; } @@ -2557,12 +2578,27 @@ ClockScanObjCmd( if (yydate.tzData == NULL) { goto done; } - yydate.seconds = baseVal; - if (ClockGetDateFields(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) - != TCL_OK) { - goto done; + Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); + + /* check cached */ + if ( dataPtr->lastBaseTimeZone == opts.timezoneObj + && dataPtr->lastBaseDate.seconds == baseVal) { + memcpy(&yydate, &dataPtr->lastBaseDate, ClockCacheableDateFieldsSize); + } else { + /* extact fields from base */ + yydate.seconds = baseVal; + if (ClockGetDateFields(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) + != TCL_OK) { + goto done; + } + /* cache last base */ + memcpy(&dataPtr->lastBaseDate, &yydate, ClockCacheableDateFieldsSize); + dataPtr->lastBaseTimeZone = opts.timezoneObj; } + /* seconds are in localSeconds (relative base date), so reset time here */ + yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; + /* If free scan */ if (opts.formatObj == NULL) { /* Use compiled version of FreeScan - */ @@ -2593,7 +2629,7 @@ ClockScanObjCmd( else { /* Use compiled version of Scan - */ - ret = ClockScan(clientData, interp, &yydate, objv[1], &opts); + ret = ClockScan(clientData, interp, info, objv[1], &opts); } if (ret != TCL_OK) { @@ -2710,6 +2746,9 @@ ClockFreeScan( if (yydate.tzData == NULL) { goto done; } + + Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); + } /* on demand (lazy) assemble julianDay using new year, month, etc. */ @@ -2719,8 +2758,6 @@ ClockFreeScan( * Assemble date, time, zone into seconds-from-epoch */ - Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); - if (yyHaveTime == -1) { yySeconds = 0; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 93416af..b074681 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -400,35 +400,48 @@ Tcl_GetClockFrmScnFromObj( (tok) = (chain) + (tokCnt); \ (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ } \ - *(tok) = NULL; + memset(tok, 0, sizeof(*(tok))); const char *ScnSTokenMapChars = "dmyYHMS"; -static ClockScanToken ScnSTokenMap[] = { - {CTOKT_DIGIT, 1, 2, 0}, - {CTOKT_DIGIT, 1, 2, 0}, - {CTOKT_DIGIT, 1, 2, 0}, - {CTOKT_DIGIT, 1, 4, 0}, - {CTOKT_DIGIT, 1, 2, 0}, - {CTOKT_DIGIT, 1, 2, 0}, - {CTOKT_DIGIT, 1, 2, 0}, +static ClockScanTokenMap ScnSTokenMap[] = { + {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + NULL}, + {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.month), + NULL}, + {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.year), + NULL}, + {CTOKT_DIGIT, CLF_DATE, 1, 4, TclOffset(DateInfo, date.year), + NULL}, + {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.hour), + NULL}, + {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.minutes), + NULL}, + {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.secondOfDay), + NULL}, }; const char *ScnSpecTokenMapChars = - " %"; -static ClockScanToken ScnSpecTokenMap[] = { - {CTOKT_SPACE, 1, 0xffff, 0}, + " "; +static ClockScanTokenMap ScnSpecTokenMap[] = { + {CTOKT_SPACE, 0, 1, 0xffff, 0, + NULL}, +}; + +static ClockScanTokenMap ScnWordTokenMap = { + CTOKT_WORD, 0, 1, 0, 0, + NULL }; /* *---------------------------------------------------------------------- */ -ClockScanToken ** +ClockScanToken * ClockGetOrParseScanFormat( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *formatObj) /* Format container */ { ClockFmtScnStorage *fss; - ClockScanToken **tok; + ClockScanToken *tok; if (formatObj->typePtr != &ClockFmtObjType) { if (ClockFmtObj_SetFromAny(interp, formatObj) != TCL_OK) { @@ -448,27 +461,30 @@ ClockGetOrParseScanFormat( /* if first time scanning - tokenize format */ if (fss->scnTok == NULL) { const char *strFmt; - register const char *p, *e, *cp, *word_start = NULL; + register const char *p, *e, *cp; Tcl_MutexLock(&ClockFmtMutex); fss->scnTokC = CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; fss->scnTok = tok = ckalloc(sizeof(*tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); - *tok = NULL; + memset(tok, 0, sizeof(*(tok))); strFmt = TclGetString(formatObj); for (e = p = strFmt, e += formatObj->length; p != e; p++) { switch (*p) { case '%': if (p+1 >= e) { - word_start = p; - continue; + goto word_tok; } p++; /* try to find modifier: */ switch (*p) { case '%': - word_start = p-1; + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &ScnWordTokenMap; + tok->tokWord.start = tok->tokWord.end = p; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); continue; break; case 'E': @@ -480,10 +496,24 @@ ClockGetOrParseScanFormat( default: cp = strchr(ScnSTokenMapChars, *p); if (!cp || *cp == '\0') { - word_start = p-1; - continue; + p--; + goto word_tok; + } + tok->map = &ScnSTokenMap[cp - ScnSTokenMapChars]; + /* calculate look ahead value by standing together tokens */ + if (tok > fss->scnTok) { + ClockScanToken *prevTok = tok - 1; + unsigned int lookAhead = tok->map->minSize; + + while (prevTok >= fss->scnTok) { + if (prevTok->map->type != tok->map->type) { + break; + } + prevTok->lookAhead += lookAhead; + prevTok--; + } } - *tok = &ScnSTokenMap[cp - ScnSTokenMapChars]; + /* next token */ AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); break; } @@ -494,18 +524,33 @@ ClockGetOrParseScanFormat( p--; goto word_tok; } - *tok = &ScnSpecTokenMap[cp - ScnSpecTokenMapChars]; + tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapChars]; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); break; default: word_tok: - - continue; + if (1) { + ClockScanToken *wordTok = tok; + if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { + wordTok = tok-1; + } + wordTok->tokWord.end = p; + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &ScnWordTokenMap; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + } + continue; + } } continue; + ext_tok_E: + /*******************/ + continue; + ext_tok_O: /*******************/ @@ -527,23 +572,134 @@ int ClockScan( ClientData clientData, /* Client data containing literal pool */ Tcl_Interp *interp, /* Tcl interpreter */ - TclDateFields *date, /* Date fields used for converting */ + register DateInfo *info, /* Date fields used for parsing & converting */ Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockScanToken **tok; + ClockScanToken *tok; + ClockScanTokenMap *map; + register const char *p, *x, *end; + unsigned short int flags = 0; + int ret = TCL_ERROR; if ((tok = ClockGetOrParseScanFormat(interp, opts->formatObj)) == NULL) { return TCL_ERROR; } + + /* prepare parsing */ + + yyMeridian = MER24; + + /* bypass spaces at begin of string */ + + p = TclGetString(strObj); + end = p + strObj->length; + while (p < end && isspace(UCHAR(*p))) { + p++; + } + info->dateStart = yyInput = p; + + /* parse string */ + for (; tok->map != NULL; yyInput = p, tok++) { + map = tok->map; + switch (map->type) + { + case CTOKT_DIGIT: + if (1) { + unsigned int val = 0; + int size = map->maxSize; + /* greedy find digits (look forward), corresponding pre-calculated lookAhead */ + size += tok->lookAhead; + x = yyInput + size; + while (isdigit(UCHAR(*p)) && p < x) { p++; }; + /* consider reserved (lookAhead) for next tokens */ + p -= tok->lookAhead; + size = p - yyInput; + if (size < map->minSize) { + /* missing input -> error */ + goto done; + } + /* string 2 number */ + p = yyInput; x = p + size; + while (p < x) { + val = val * 10 + (*p++ - '0'); + } + /* put number into info by offset */ + *(time_t *)(((char *)info) + map->offs) = val; + flags |= map->flags; + } + break; + case CTOKT_SPACE: + while (p < end && isspace(UCHAR(*p))) { + p++; + } + break; + case CTOKT_WORD: + x = tok->tokWord.start; + if (x == tok->tokWord.end) { /* single char word */ + if (*p != *x) { + /* no match -> error */ + goto done; + } + p++; + continue; + } + /* multi-char word */ + while (p < end && x < tok->tokWord.end && *p++ == *x++) {}; + if (x < tok->tokWord.end) { + /* no match -> error */ + goto done; + } + break; + } + } - //*********************************** + /* ignore spaces at end */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + /* check end was reached */ + if (p < end) { + /* something after last token - wrong format */ + goto done; + } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)tok)); - return TCL_OK; + /* invalidate result */ + if (flags & CLF_DATE) { + yydate.julianDay = CL_INVALIDATE; + + if (yyYear < 100) { + if (yyYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { + yyYear -= 100; + } + yyYear += ClockCurrentYearCentury(clientData, interp); + } + yydate.era = CE; + if (!(flags & CLF_TIME)) { + yydate.localSeconds = 0; + } + } + + if (flags & CLF_TIME) { + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + } else { + yySeconds = yydate.localSeconds % 86400; + } + + ret = TCL_OK; + +done: + + if (ret != TCL_OK) { + Tcl_SetResult(interp, + "input string does not match supplied format", TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); + return ret; + } - return TCL_ERROR; + return ret; } diff --git a/generic/tclDate.c b/generic/tclDate.c index a47f43d..97d13b4 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2691,7 +2691,6 @@ TclClockFreeScan( yyHaveDate = 0; yyHaveTime = 0; - yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyHaveZone = 0; yyTimezone = 0; yyDSTmode = DSTmaybe; diff --git a/generic/tclDate.h b/generic/tclDate.h index 49420a2..4b0b47e 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -22,60 +22,64 @@ typedef struct TclDateFields { * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds * from the Posix epoch */ - int tzOffset; /* Time zone offset in seconds east of + time_t tzOffset; /* Time zone offset in seconds east of * Greenwich */ + time_t julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + time_t gregorian; /* Flag == 1 if the date is Gregorian */ + time_t year; /* Year of the era */ + time_t dayOfYear; /* Day of the year (1 January == 1) */ + time_t month; /* Month number */ + time_t dayOfMonth; /* Day of the month */ + time_t iso8601Year; /* ISO8601 week-based year */ + time_t iso8601Week; /* ISO8601 week number */ + time_t dayOfWeek; /* Day of the week */ + time_t hour; /* Hours of day (in-between time only calculation) */ + time_t minutes; /* Minutes of day (in-between time only calculation) */ + time_t secondOfDay; /* Seconds of day (in-between time only calculation) */ + Tcl_Obj *tzName; /* Time zone name (if set the refCount is incremented) */ Tcl_Obj *tzData; /* Time zone data object (internally referenced) */ - int julianDay; /* Julian Day Number in local time zone */ - enum {BCE=1, CE=0} era; /* Era */ - int gregorian; /* Flag == 1 if the date is Gregorian */ - int year; /* Year of the era */ - int dayOfYear; /* Day of the year (1 January == 1) */ - int month; /* Month number */ - int dayOfMonth; /* Day of the month */ - int iso8601Year; /* ISO8601 week-based year */ - int iso8601Week; /* ISO8601 week number */ - int dayOfWeek; /* Day of the week */ - int hour; /* Hours of day (in-between time only calculation) */ - int minutes; /* Minutes of day (in-between time only calculation) */ - int secondOfDay; /* Seconds of day (in-between time only calculation) */ } TclDateFields; +#define ClockCacheableDateFieldsSize \ + TclOffset(TclDateFields, tzName) + /* * Structure contains return parsed fields. */ typedef struct DateInfo { + const char *dateStart; + const char *dateInput; TclDateFields date; - int dateHaveDate; + time_t dateHaveDate; - int dateMeridian; - int dateHaveTime; + time_t dateMeridian; + time_t dateHaveTime; time_t dateTimezone; - int dateDSTmode; - int dateHaveZone; + time_t dateDSTmode; + time_t dateHaveZone; time_t dateRelMonth; time_t dateRelDay; time_t dateRelSeconds; - int dateHaveRel; + time_t dateHaveRel; time_t dateMonthOrdinalIncr; time_t dateMonthOrdinal; - int dateHaveOrdinalMonth; + time_t dateHaveOrdinalMonth; time_t dateDayOrdinal; time_t dateDayNumber; - int dateHaveDay; + time_t dateHaveDay; - const char *dateStart; - const char *dateInput; time_t *dateRelPointer; - int dateDigitCount; + time_t dateDigitCount; Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ @@ -140,8 +144,19 @@ typedef enum _MERIDIAN { #define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 12 +typedef struct ClockScanToken ClockScanToken; + + +typedef int ClockScanTokenProc( + DateInfo *info, + ClockScanToken *tok); + + +#define CLF_DATE (1 << 2) +#define CLF_TIME (1 << 3) + typedef enum _CLCKTOK_TYPE { - CTOKT_EOB=0, CTOKT_DIGIT, CTOKT_SPACE + CTOKT_DIGIT = 1, CTOKT_SPACE, CTOKT_WORD } CLCKTOK_TYPE; typedef struct ClockFmtScnStorage ClockFmtScnStorage; @@ -150,18 +165,29 @@ typedef struct ClockFormatToken { CLCKTOK_TYPE type; } ClockFormatToken; -typedef struct ClockScanToken { +typedef struct ClockScanTokenMap { unsigned short int type; + unsigned short int flags; unsigned short int minSize; unsigned short int maxSize; unsigned short int offs; + ClockScanTokenProc *parser; +} ClockScanTokenMap; + +typedef struct ClockScanToken { + ClockScanTokenMap *map; + unsigned int lookAhead; + struct { + const char *start; + const char *end; + } tokWord; } ClockScanToken; typedef struct ClockFmtScnStorage { int objRefCount; /* Reference count shared across threads */ - ClockScanToken **scnTok; + ClockScanToken *scnTok; unsigned int scnTokC; - ClockFormatToken **fmtTok; + ClockFormatToken *fmtTok; unsigned int fmtTokC; #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 ClockFmtScnStorage *nextPtr; @@ -191,8 +217,8 @@ MODULE_SCOPE ClockFmtScnStorage * Tcl_Obj *objPtr); MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, - TclDateFields *date, Tcl_Obj *strObj, - ClockFmtScnCmdArgs *opts); + register DateInfo *info, + Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); /* * Other externals. diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 571b7df..54087ca 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -902,7 +902,6 @@ TclClockFreeScan( yyHaveDate = 0; yyHaveTime = 0; - yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24; yyHaveZone = 0; yyTimezone = 0; yyDSTmode = DSTmaybe; diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 969e279..93a78e4 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -25,19 +25,82 @@ proc _test_get_commands {lst} { regsub -all {(?:^|\n)[ \t]*(\#[^\n]*)(?=\n\s*[\{\#])} $lst "\n{\\1}" } +proc _test_out_total {} { + upvar _ _ + + puts [string repeat ** 40] + puts [format "Total %d cases in %.2f sec.:" [llength $_(itcnt)] [expr {[llength $_(itcnt)] * $_(reptime) / 1000.0}]] + lset _(m) 0 [format %.6f [expr [join $_(ittm) +]]] + lset _(m) 2 [expr [join $_(itcnt) +]] + lset _(m) 4 [expr {[lindex $_(m) 2] / ([llength $_(itcnt)] * $_(reptime) / 1000.0)}] + puts $_(m) + puts "Average:" + lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / [llength $_(itcnt)]}]] + lset _(m) 2 [expr {[lindex $_(m) 2] / [llength $_(itcnt)]}] + lset _(m) 4 [expr {[lindex $_(m) 2] * (1000 / $_(reptime))}] + puts $_(m) + puts [string repeat ** 40] + puts "" +} + +proc _test_run {reptime lst {outcmd {puts {$_(r)}}}} { + upvar _ _ + array set _ [list ittm {} itcnt {} itrate {} reptime $reptime] + + foreach _(c) [_test_get_commands $lst] { + puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" + if {[regexp {\s*\#} $_(c)]} continue + set _(r) [if 1 $_(c)] + if {$outcmd ne {}} $outcmd + puts [set _(m) [timerate $_(c) $reptime]] + lappend _(ittm) [lindex $_(m) 0] + lappend _(itcnt) [lindex $_(m) 2] + lappend _(itrate) [lindex $_(m) 4] + puts "" + } + _test_out_total +} + proc test-scan {{reptime 1000}} { - foreach _(c) [_test_get_commands { - # Scan : date + _test_run $reptime { + # Scan : date (in gmt) {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} + # Scan : date (system time zone, with base) + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} + # Scan : date (system time zone, without base) + {clock scan "25.11.2015" -format "%d.%m.%Y"} + # Scan : greedy match + {clock scan "111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} - {**STOP** : Wed Nov 25 01:00:00 CET 2015} - # Scan : long format test (allock chain) - {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} - # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): - {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} - # Scan : again: - {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1} + + # Scan : date-time (in gmt) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1} + # Scan : date-time (system time zone with base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0} + # Scan : date-time (system time zone without base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"} + # Scan : dynamic format (cacheable) + {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} + + # Scan : zone only + {clock scan "CET" -format "%z"} + {clock scan "EST" -format "%z"} + #{**STOP** : Wed Nov 25 01:00:00 CET 2015} + + # # Scan : long format test (allock chain) + # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} + # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): + # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + # # Scan : again: + # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + } {puts [clock format $_(r) -locale en]} +} + +proc test-freescan {{reptime 1000}} { + _test_run $reptime { # FreeScan : relative date {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} # FreeScan : relative date with relative weekday @@ -74,17 +137,11 @@ proc test-scan {{reptime 1000}} { {clock scan "19:18:30 MST" -base 148863600 -gmt 1 clock scan "19:18:30 EST" -base 148863600 } - }] { - puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" - if {[regexp {\s*\#} $_(c)]} continue - puts [clock format [if 1 $_(c)] -locale en] - puts [timerate $_(c) $reptime] - puts "" - } + } {puts [clock format $_(r) -locale en]} } proc test-other {{reptime 1000}} { - foreach _(c) [_test_get_commands { + _test_run $reptime { # Bad zone {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} **STOP** @@ -92,18 +149,13 @@ proc test-other {{reptime 1000}} { {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} - }] { - puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" - if {[regexp {\s*\#} $_(c)]} continue - puts [if 1 $_(c)] - puts [timerate $_(c) $reptime] - puts "" } } proc test {{reptime 1000}} { puts "" test-scan $reptime + #test-freescan $reptime test-other $reptime puts \n**OK** -- cgit v0.12 From 1eb32293de0bc1f5a1ff4b2e1ef636affd396e32 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:19:01 +0000 Subject: [temp-commit]: code review, DST-hole mistake by scan with relative time resolved; caching of UTC2Local / Local2UTC cherry picked --- generic/tclClock.c | 394 ++++++++++++++++++++++++++++------------------ generic/tclClockFmt.c | 220 +++++++++++++++++++++----- generic/tclDate.h | 84 +++++++++- library/clock.tcl | 13 +- tests-perf/clock.perf.tcl | 50 +++++- tests/clock.test | 87 ++++++++++ 6 files changed, 638 insertions(+), 210 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 2e7b854..7cc5d86 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -26,22 +26,6 @@ #endif /* - * Constants - */ - -#define JULIAN_DAY_POSIX_EPOCH 2440588 -#define GREGORIAN_CHANGE_DATE 2361222 -#define SECONDS_PER_DAY 86400 -#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ - * SECONDS_PER_DAY) -#define FOUR_CENTURIES 146097 /* days */ -#define JDAY_1_JAN_1_CE_JULIAN 1721424 -#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 -#define ONE_CENTURY_GREGORIAN 36524 /* days */ -#define FOUR_YEARS 1461 /* days */ -#define ONE_YEAR 365 /* days */ - -/* * Table of the days in each month, leap and common years */ @@ -72,8 +56,6 @@ typedef enum ClockLiteral { LIT_MONTH, LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, LIT_YEAR, - LIT_CURRENTYEARCENTURY, - LIT_YEAROFCENTURYSWITCH, LIT_TZDATA, LIT_GETSYSTEMTIMEZONE, LIT_SETUPTIMEZONE, @@ -96,8 +78,6 @@ static const char *const Literals[] = { "month", "seconds", "tzName", "tzOffset", "year", - "::tcl::clock::CurrentYearCentury", - "::tcl::clock::YearOfCenturySwitch", "::tcl::clock::TZData", "::tcl::clock::GetSystemTimeZone", "::tcl::clock::SetupTimeZone", @@ -106,41 +86,6 @@ static const char *const Literals[] = { #endif }; -#define CurrentYearCentury 2000 - -/* - * Structure containing the client data for [clock] - */ - -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 long LastTZEpoch; - int currentYearCentury; - int yearOfCenturySwitch; - Tcl_Obj *SystemTimeZone; - Tcl_Obj *SystemSetupTZData; - Tcl_Obj *GMTSetupTimeZone; - Tcl_Obj *GMTSetupTZData; - Tcl_Obj *AnySetupTimeZone; - Tcl_Obj *AnySetupTZData; - Tcl_Obj *LastUnnormSetupTimeZone; - Tcl_Obj *LastSetupTimeZone; - Tcl_Obj *LastSetupTZData; - /* Cache for last base (fast convert if base/tz not changed) */ - Tcl_Obj *lastBaseTimeZone; - TclDateFields lastBaseDate; - /* - /* [SB] TODO: back-port (from tclSE) the same date caching ... - * Cache for last date (fast convert if date parsed was the same) * / - struct { - DateInfo yy; - TclDateFields date; - } lastDate; - */ -} ClockClientData; - static const char *const eras[] = { "CE", "BCE", NULL }; /* @@ -161,13 +106,13 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ -static int ConvertUTCToLocal(Tcl_Interp *, +static int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); -static int ConvertLocalToUTC(Tcl_Interp *, +static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); @@ -191,9 +136,9 @@ static int ClockConvertlocaltoutcObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockGetDateFields(Tcl_Interp *interp, - TclDateFields *fields, Tcl_Obj *tzdata, - int changeover); +static int ClockGetDateFields(ClientData clientData, + Tcl_Interp *interp, TclDateFields *fields, + Tcl_Obj *tzdata, int changeover); static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -330,8 +275,8 @@ TclClockInit( Tcl_IncrRefCount(data->literals[i]); } data->LastTZEpoch = 0; - data->currentYearCentury = -1; - data->yearOfCenturySwitch = -1; + data->currentYearCentury = ClockDefaultYearCentury; + data->yearOfCenturySwitch = ClockDefaultCenturySwitch; data->SystemTimeZone = NULL; data->SystemSetupTZData = NULL; data->GMTSetupTimeZone = NULL; @@ -342,7 +287,10 @@ TclClockInit( data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; - data->lastBaseTimeZone = NULL; + data->lastBase.TimeZone = NULL; + data->UTC2Local.tzData = NULL; + data->UTC2Local.tzName = NULL; + data->Local2UTC.tzData = NULL; /* * Install the commands. @@ -377,8 +325,6 @@ ClockConfigureClear( ClockClientData *data) { data->LastTZEpoch = 0; - data->currentYearCentury = -1; - data->yearOfCenturySwitch = -1; Tcl_UnsetObjRef(data->SystemTimeZone); Tcl_UnsetObjRef(data->SystemSetupTZData); Tcl_UnsetObjRef(data->GMTSetupTimeZone); @@ -388,6 +334,11 @@ ClockConfigureClear( Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone); Tcl_UnsetObjRef(data->LastSetupTimeZone); Tcl_UnsetObjRef(data->LastSetupTZData); + + Tcl_UnsetObjRef(data->lastBase.TimeZone); + Tcl_UnsetObjRef(data->UTC2Local.tzData); + Tcl_UnsetObjRef(data->UTC2Local.tzName); + Tcl_UnsetObjRef(data->Local2UTC.tzData); } static void @@ -397,7 +348,8 @@ ClockDeleteCmdProc( ClockClientData *data = clientData; int i; - if (data->refCount-- <= 1) { + data->refCount--; + if (data->refCount == 0) { for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } @@ -471,10 +423,12 @@ ClockConfigureObjCmd( static const char *const options[] = { "-system-tz", "-setup-tz", "-clear", + "-year-century", "-century-switch", NULL }; enum optionInd { CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CLEAR_CACHE, + CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, CLOCK_SETUP_GMT, CLOCK_SETUP_NOP }; int optionIndex; /* Index of an option. */ @@ -542,6 +496,32 @@ ClockConfigureObjCmd( Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone); } break; + case CLOCK_YEAR_CENTURY: + if (i+1 < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i+1], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->currentYearCentury = year; + Tcl_SetObjResult(interp, objv[i+1]); + continue; + } + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->currentYearCentury)); + break; + case CLOCK_CENTURY_SWITCH: + if (i+1 < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i+1], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->yearOfCenturySwitch = year; + Tcl_SetObjResult(interp, objv[i+1]); + continue; + } + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->yearOfCenturySwitch)); + break; case CLOCK_CLEAR_CACHE: ClockConfigureClear(dataPtr); break; @@ -577,14 +557,16 @@ ClockGetTZData( /* simple caching, because almost used the tz-data of last timezone */ if (timezoneObj == dataPtr->SystemTimeZone) { - if (dataPtr->SystemSetupTZData != NULL) + if (dataPtr->SystemSetupTZData != NULL) { return dataPtr->SystemSetupTZData; + } out = &dataPtr->SystemSetupTZData; } else if (timezoneObj == dataPtr->GMTSetupTimeZone) { - if (dataPtr->GMTSetupTZData != NULL) + if (dataPtr->GMTSetupTZData != NULL) { return dataPtr->GMTSetupTZData; + } out = &dataPtr->GMTSetupTZData; } else @@ -602,11 +584,11 @@ ClockGetTZData( if (out != NULL) { Tcl_SetObjRef(*out, ret); } - Tcl_SetObjRef(dataPtr->LastSetupTZData, ret); + Tcl_SetObjRef(dataPtr->LastSetupTZData, ret); if (dataPtr->LastSetupTimeZone != timezoneObj) { Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone); - } + } return ret; } /* @@ -710,49 +692,6 @@ ClockFormatNumericTimeZone(int z) { /* *---------------------------------------------------------------------- - * [SB] TODO: make constans cacheable (once per second, etc.) ... - */ -inline int -ClockCurrentYearCentury( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; - int year = dataPtr->currentYearCentury; - - if (year == -1) { - Tcl_Obj * yearObj; - year = 2000; - yearObj = Tcl_ObjGetVar2(interp, - literals[LIT_CURRENTYEARCENTURY], NULL, TCL_LEAVE_ERR_MSG); - Tcl_GetIntFromObj(NULL, yearObj, &year); - dataPtr->currentYearCentury = year; - } - return year; -} -inline int -ClockGetYearOfCenturySwitch( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; - int year = dataPtr->yearOfCenturySwitch; - - if (year == -1) { - Tcl_Obj * yearObj; - year = 37; - yearObj = Tcl_ObjGetVar2(interp, - literals[LIT_YEAROFCENTURYSWITCH], NULL, TCL_LEAVE_ERR_MSG); - Tcl_GetIntFromObj(NULL, yearObj, &year); - dataPtr->yearOfCenturySwitch = year; - } - return year; -} - -/* - *---------------------------------------------------------------------- * * ClockConvertlocaltoutcObjCmd -- * @@ -816,7 +755,7 @@ ClockConvertlocaltoutcObjCmd( if ((Tcl_GetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) - || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { + || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) { return TCL_ERROR; } @@ -911,8 +850,8 @@ ClockGetdatefieldsObjCmd( /* Extract fields */ - if (ClockGetDateFields(interp, &fields, objv[2], changeover) - != TCL_OK) { + if (ClockGetDateFields(clientData, interp, &fields, objv[2], + changeover) != TCL_OK) { return TCL_ERROR; } @@ -957,6 +896,7 @@ ClockGetdatefieldsObjCmd( */ int ClockGetDateFields( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Pointer to result fields, where * fields->seconds contains date to extract */ @@ -967,7 +907,8 @@ ClockGetDateFields( * Convert UTC time to local. */ - if (ConvertUTCToLocal(interp, fields, tzdata, changeover) != TCL_OK) { + if (ConvertUTCToLocal(clientData, interp, fields, tzdata, + changeover) != TCL_OK) { return TCL_ERROR; } @@ -1221,15 +1162,33 @@ ClockGetjuliandayfromerayearweekdayObjCmd( static int ConvertLocalToUTC( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { + ClockClientData *dataPtr = clientData; int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* + * Check cacheable conversion could be used + * (last-minute Local2UTC cache with the same TZ) + */ + if ( tzdata == dataPtr->Local2UTC.tzData + && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds + || fields->localSeconds / 60 == dataPtr->Local2UTC.localSeconds / 60 + ) + && changeover == dataPtr->Local2UTC.changeover + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = dataPtr->Local2UTC.tzOffset; + fields->seconds = fields->localSeconds - fields->tzOffset; + return TCL_OK; + } + + /* * Unpack the tz data. */ @@ -1243,10 +1202,22 @@ ConvertLocalToUTC( */ if (rowc == 0) { - return ConvertLocalToUTCUsingC(interp, fields, changeover); + if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + }; } else { - return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); + if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv) != TCL_OK) { + return TCL_ERROR; + }; } + + /* Cache the last conversion */ + Tcl_SetObjRef(dataPtr->Local2UTC.tzData, tzdata); + dataPtr->Local2UTC.localSeconds = fields->localSeconds; + dataPtr->Local2UTC.changeover = changeover; + dataPtr->Local2UTC.tzOffset = fields->tzOffset; + + return TCL_OK; } /* @@ -1321,6 +1292,40 @@ ConvertLocalToUTCUsingTable( } fields->tzOffset = have[i]; fields->seconds = fields->localSeconds - fields->tzOffset; + +#if 0 + /* + * Convert back from UTC, if local times are different - wrong local time + * (local time seems to be in between DST-hole). + */ + if (fields->tzOffset) { + + int corrOffset; + Tcl_WideInt backCompVal; + /* check DST-hole interval contains UTC time */ + Tcl_GetWideIntFromObj(NULL, cellv[0], &backCompVal); + if ( fields->seconds >= backCompVal - fields->tzOffset + && fields->seconds <= backCompVal + fields->tzOffset + ) { + row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + if (row == NULL || + TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || + TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) { + return TCL_ERROR; + } + if (fields->localSeconds != fields->seconds + corrOffset) { + Tcl_Panic("wrong local time %ld by LocalToUTC conversion," + " local time seems to be in between DST-hole", + fields->localSeconds); + /* correcting offset * / + fields->tzOffset -= corrOffset; + fields->seconds += fields->tzOffset; + */ + } + } + } +#endif + return TCL_OK; } @@ -1424,15 +1429,34 @@ ConvertLocalToUTCUsingC( static int ConvertUTCToLocal( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { + ClockClientData *dataPtr = clientData; int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* + * Check cacheable conversion could be used + * (last-minute UTC2Local cache with the same TZ) + */ + if ( tzdata == dataPtr->UTC2Local.tzData + && ( fields->seconds == dataPtr->UTC2Local.seconds + || fields->seconds / 60 == dataPtr->UTC2Local.seconds / 60 + ) + && changeover == dataPtr->UTC2Local.changeover + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + Tcl_SetObjRef(fields->tzName, dataPtr->UTC2Local.tzName); + fields->tzOffset = dataPtr->UTC2Local.tzOffset; + fields->localSeconds = fields->seconds + fields->tzOffset; + return TCL_OK; + } + + /* * Unpack the tz data. */ @@ -1446,10 +1470,22 @@ ConvertUTCToLocal( */ if (rowc == 0) { - return ConvertUTCToLocalUsingC(interp, fields, changeover); + if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + } } else { - return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); + if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv) != TCL_OK) { + return TCL_ERROR; + } } + + /* Cache the last conversion */ + Tcl_SetObjRef(dataPtr->UTC2Local.tzData, tzdata); + dataPtr->UTC2Local.seconds = fields->seconds; + dataPtr->UTC2Local.changeover = changeover; + dataPtr->UTC2Local.tzOffset = fields->tzOffset; + Tcl_SetObjRef(dataPtr->UTC2Local.tzName, fields->tzName); + return TCL_OK; } /* @@ -2373,6 +2409,7 @@ _ClockParseFmtScnArgs( resOpts->localeObj = NULL; resOpts->timezoneObj = NULL; resOpts->baseObj = NULL; + resOpts->flags = 0; for (i = 2; i < objc; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options[forScan], "option", 0, &optionIndex) != TCL_OK) { @@ -2539,6 +2576,8 @@ ClockScanObjCmd( ret = TCL_ERROR; + info->flags = 0; + if (opts.baseObj != NULL) { if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { return TCL_ERROR; @@ -2580,20 +2619,20 @@ ClockScanObjCmd( } Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); - /* check cached */ - if ( dataPtr->lastBaseTimeZone == opts.timezoneObj - && dataPtr->lastBaseDate.seconds == baseVal) { - memcpy(&yydate, &dataPtr->lastBaseDate, ClockCacheableDateFieldsSize); + /* check base fields already cached (by TZ, last-second cache) */ + if ( dataPtr->lastBase.TimeZone == opts.timezoneObj + && dataPtr->lastBase.Date.seconds == baseVal) { + memcpy(&yydate, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); } else { /* extact fields from base */ yydate.seconds = baseVal; - if (ClockGetDateFields(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) - != TCL_OK) { + if (ClockGetDateFields(clientData, interp, &yydate, yydate.tzData, + GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } /* cache last base */ - memcpy(&dataPtr->lastBaseDate, &yydate, ClockCacheableDateFieldsSize); - dataPtr->lastBaseTimeZone = opts.timezoneObj; + memcpy(&dataPtr->lastBase.Date, &yydate, ClockCacheableDateFieldsSize); + Tcl_SetObjRef(dataPtr->lastBase.TimeZone, opts.timezoneObj); } /* seconds are in localSeconds (relative base date), so reset time here */ @@ -2612,7 +2651,7 @@ ClockScanObjCmd( } ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); } -#if 0 +#if 1 else if (1) { /* TODO: Tcled Scan proc - */ @@ -2636,24 +2675,40 @@ ClockScanObjCmd( goto done; } - /* If needed assemble julianDay using new year, month, etc. */ - if (yydate.julianDay == CL_INVALIDATE) { + if (info->flags & CLF_INVALIDATE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } - + + /* some overflow checks, if not extended */ + if (!(opts.flags & CLF_EXTENDED)) { + if (yydate.julianDay > 5373484) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested date too large to represent", -1)); + Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); + ret = TCL_ERROR; + goto done; + } + } + /* Local seconds to UTC (stored in yydate.seconds) */ - yydate.localSeconds = - -210866803200L - + ( 86400 * (Tcl_WideInt)yydate.julianDay ) - + ( yySeconds % 86400 ); + if (info->flags & (CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY)) { + yydate.localSeconds = + -210866803200L + + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + + ( yySeconds % SECONDS_PER_DAY ); + } - if (ConvertLocalToUTC(interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) + if (ConvertLocalToUTC(clientData, interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } + /* Increment UTC seconds with relative time */ + + yydate.seconds += yyRelSeconds; + ret = TCL_OK; done: @@ -2681,7 +2736,7 @@ ClockFreeScan( Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - // ClockClientData *dataPtr = clientData; + ClockClientData *dataPtr = clientData; // Tcl_Obj **literals = dataPtr->literals; int ret = TCL_ERROR; @@ -2712,15 +2767,16 @@ ClockFreeScan( if (yyHaveDate) { if (yyYear < 100) { - if (yyYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { yyYear -= 100; } - yyYear += ClockCurrentYearCentury(clientData, interp); + yyYear += dataPtr->currentYearCentury; } yydate.era = CE; if (yyHaveTime == 0) { yyHaveTime = -1; } + info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; } /* @@ -2749,22 +2805,22 @@ ClockFreeScan( Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); + info->flags |= CLF_INVALIDATE_SECONDS; } - /* on demand (lazy) assemble julianDay using new year, month, etc. */ - yydate.julianDay = CL_INVALIDATE; - /* * Assemble date, time, zone into seconds-from-epoch */ if (yyHaveTime == -1) { yySeconds = 0; + info->flags |= CLF_INVALIDATE_SECONDS; } else if (yyHaveTime) { yySeconds = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); + info->flags |= CLF_INVALIDATE_SECONDS; } else if ( (yyHaveDay && !yyHaveDate) @@ -2774,9 +2830,10 @@ ClockFreeScan( || yyRelDay != 0 ) ) ) { yySeconds = 0; + info->flags |= CLF_INVALIDATE_SECONDS; } else { - yySeconds = yydate.localSeconds % 86400; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; } /* @@ -2787,16 +2844,24 @@ repeat_rel: if (yyHaveRel) { + /* + * Relative conversion normally possible in UTC time only, because + * of possible wrong local time increment if ignores in-between DST-hole. + * (see test-cases clock-34.53, clock-34.54). + * So increment date in julianDay, but time inside day in UTC (seconds). + */ + /* add months (or years in months) */ if (yyRelMonth != 0) { int m, h; /* if needed extract year, month, etc. again */ - if (yyMonth == CL_INVALIDATE) { + if (info->flags & CLF_INVALIDATE_DATE) { GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); GetMonthDay(&yydate); GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_INVALIDATE_DATE; } /* add the requisite number of months */ @@ -2812,7 +2877,7 @@ repeat_rel: } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - yydate.julianDay = CL_INVALIDATE; + info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; yyRelMonth = 0; } @@ -2821,21 +2886,33 @@ repeat_rel: if (yyRelDay) { /* assemble julianDay using new year, month, etc. */ - if (yydate.julianDay == CL_INVALIDATE) { + if (info->flags & CLF_INVALIDATE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_INVALIDATE_JULIANDAY; } - yydate.julianDay += yyRelDay; + yydate.julianDay += yyRelDay; /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ - yyMonth = CL_INVALIDATE; + info->flags |= CLF_INVALIDATE_DATE|CLF_INVALIDATE_SECONDS; yyRelDay = 0; } - /* relative time (seconds) */ - yySeconds += yyRelSeconds; - yyRelSeconds = 0; - + /* relative time (seconds), if exceeds current date, do the day conversion and + * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */ + if (yyRelSeconds) { + time_t newSecs = yySeconds + yyRelSeconds; + + /* if seconds increment outside of current date, increment day */ + if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) { + + yyRelDay += newSecs / SECONDS_PER_DAY; + yySeconds = 0; + yyRelSeconds = newSecs % SECONDS_PER_DAY; + + goto repeat_rel; + } + } } /* @@ -2846,10 +2923,11 @@ repeat_rel: int monthDiff; /* if needed extract year, month, etc. again */ - if (yyMonth == CL_INVALIDATE) { + if (info->flags & CLF_INVALIDATE_DATE) { GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); GetMonthDay(&yydate); GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_INVALIDATE_DATE; } if (yyMonthOrdinalIncr > 0) { @@ -2872,6 +2950,8 @@ repeat_rel: yyRelMonth += monthDiff; yyHaveOrdinalMonth = 0; + info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; + goto repeat_rel; } @@ -2882,8 +2962,9 @@ repeat_rel: if (yyHaveDay && !yyHaveDate) { /* if needed assemble julianDay now */ - if (yydate.julianDay == CL_INVALIDATE) { + if (info->flags & CLF_INVALIDATE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_INVALIDATE_JULIANDAY; } yydate.era = CE; @@ -2892,6 +2973,7 @@ repeat_rel: if (yyDayOrdinal > 0) { yydate.julianDay -= 7; } + info->flags |= CLF_INVALIDATE_DATE|CLF_INVALIDATE_SECONDS; } /* Free scanning completed - date ready */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index b074681..48b9b69 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -35,6 +35,66 @@ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); * Clock scan and format facilities. */ +inline int +_str2int( + time_t *out, + register + const char *p, + const char *e, + int sign) +{ + register time_t val = 0, prev = 0; + if (sign > 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + +inline int +_str2wideInt( + Tcl_WideInt *out, + register + const char *p, + const char *e, + int sign) +{ + register Tcl_WideInt val = 0, prev = 0; + if (sign > 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + /* *---------------------------------------------------------------------- */ @@ -403,22 +463,35 @@ Tcl_GetClockFrmScnFromObj( memset(tok, 0, sizeof(*(tok))); const char *ScnSTokenMapChars = - "dmyYHMS"; + "dmyYHMSJs"; static ClockScanTokenMap ScnSTokenMap[] = { - {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + /* %d */ + {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.dayOfMonth), NULL}, + /* %m */ {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.month), NULL}, + /* %y */ {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.year), NULL}, + /* %Y */ {CTOKT_DIGIT, CLF_DATE, 1, 4, TclOffset(DateInfo, date.year), NULL}, + /* %H */ {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.hour), NULL}, + /* %M */ {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.minutes), NULL}, + /* %S */ {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.secondOfDay), NULL}, + /* %J */ + {CTOKT_DIGIT, CLF_DATE | CLF_JULIANDAY, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + NULL}, + /* %s */ + {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + NULL}, }; const char *ScnSpecTokenMapChars = " "; @@ -576,6 +649,7 @@ ClockScan( Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { + ClockClientData *dataPtr = clientData; ClockScanToken *tok; ClockScanTokenMap *map; register const char *p, *x, *end; @@ -590,46 +664,100 @@ ClockScan( yyMeridian = MER24; - /* bypass spaces at begin of string */ - p = TclGetString(strObj); end = p + strObj->length; - while (p < end && isspace(UCHAR(*p))) { - p++; + /* in strict mode - bypass spaces at begin / end only (not between tokens) */ + if (opts->flags & CLF_STRICT) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } } info->dateStart = yyInput = p; /* parse string */ - for (; tok->map != NULL; yyInput = p, tok++) { + for (; tok->map != NULL; tok++) { map = tok->map; + /* bypass spaces at begin of input before parsing each token */ + if (!(opts->flags & CLF_STRICT) && map->type != CTOKT_SPACE) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } + yyInput = p; + } switch (map->type) { case CTOKT_DIGIT: if (1) { - unsigned int val = 0; int size = map->maxSize; - /* greedy find digits (look forward), corresponding pre-calculated lookAhead */ - size += tok->lookAhead; - x = yyInput + size; - while (isdigit(UCHAR(*p)) && p < x) { p++; }; - /* consider reserved (lookAhead) for next tokens */ - p -= tok->lookAhead; + int sign = 1; + if (map->flags & CLF_SIGNED) { + if (*p == '+') { yyInput = ++p; } + else + if (*p == '-') { yyInput = ++p; sign = -1; }; + } + /* greedy find digits (look for forward digits consider spaces), + * corresponding pre-calculated lookAhead */ + if (size != map->minSize && tok->lookAhead) { + int spcnt = 0; + const char *pe; + size += tok->lookAhead; + x = p + size; if (x > end) { x = end; }; + pe = x; + while (p < x) { + if (isspace(UCHAR(*p))) { + if (pe > p) { pe = p; }; + if (x < end) x++; + p++; + spcnt++; + continue; + } + if (isdigit(UCHAR(*p))) { + p++; + continue; + } + break; + } + /* consider reserved (lookAhead) for next tokens */ + p -= tok->lookAhead + spcnt; + if (p > pe) { + p = pe; + } + } else { + x = p + size; if (x > end) { x = end; }; + while (isdigit(UCHAR(*p)) && p < x) { p++; }; + } size = p - yyInput; if (size < map->minSize) { /* missing input -> error */ - goto done; + goto error; } - /* string 2 number */ + /* string 2 number, put number into info structure by offset */ p = yyInput; x = p + size; - while (p < x) { - val = val * 10 + (*p++ - '0'); + if (!(map->flags & CLF_LOCALSEC)) { + if (_str2int((time_t *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; } - /* put number into info by offset */ - *(time_t *)(((char *)info) + map->offs) = val; flags |= map->flags; } break; case CTOKT_SPACE: + /* at least one space in strict mode */ + if (opts->flags & CLF_STRICT) { + if (!isspace(UCHAR(*p))) { + /* unmatched -> error */ + goto error; + } + p++; + } while (p < end && isspace(UCHAR(*p))) { p++; } @@ -639,7 +767,7 @@ ClockScan( if (x == tok->tokWord.end) { /* single char word */ if (*p != *x) { /* no match -> error */ - goto done; + goto error; } p++; continue; @@ -648,7 +776,7 @@ ClockScan( while (p < end && x < tok->tokWord.end && *p++ == *x++) {}; if (x < tok->tokWord.end) { /* no match -> error */ - goto done; + goto error; } break; } @@ -661,43 +789,57 @@ ClockScan( /* check end was reached */ if (p < end) { /* something after last token - wrong format */ - goto done; + goto error; } /* invalidate result */ if (flags & CLF_DATE) { - yydate.julianDay = CL_INVALIDATE; + if (!(flags & CLF_JULIANDAY)) { + info->flags |= CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY; - if (yyYear < 100) { - if (yyYear >= ClockGetYearOfCenturySwitch(clientData, interp)) { - yyYear -= 100; + if (yyYear < 100) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; } - yyYear += ClockCurrentYearCentury(clientData, interp); + yydate.era = CE; } - yydate.era = CE; - if (!(flags & CLF_TIME)) { + /* if date but no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + info->flags |= CLF_INVALIDATE_SECONDS; yydate.localSeconds = 0; } } if (flags & CLF_TIME) { + info->flags |= CLF_INVALIDATE_SECONDS; yySeconds = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); - } else { - yySeconds = yydate.localSeconds % 86400; + } else + if (!(flags & CLF_LOCALSEC)) { + info->flags |= CLF_INVALIDATE_SECONDS; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; } ret = TCL_OK; + goto done; -done: +overflow: - if (ret != TCL_OK) { - Tcl_SetResult(interp, - "input string does not match supplied format", TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); - return ret; - } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent", -1)); + Tcl_SetErrorCode(interp, "CLOCK", "integervalueTooLarge", NULL); + goto done; + +error: + + Tcl_SetResult(interp, + "input string does not match supplied format", TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); + +done: return ret; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 4b0b47e..47f2a21 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -14,6 +14,28 @@ #define _TCLCLOCK_H /* + * Constants + */ + +#define JULIAN_DAY_POSIX_EPOCH 2440588 +#define GREGORIAN_CHANGE_DATE 2361222 +#define SECONDS_PER_DAY 86400 +#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ + * SECONDS_PER_DAY) +#define FOUR_CENTURIES 146097 /* days */ +#define JDAY_1_JAN_1_CE_JULIAN 1721424 +#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 +#define ONE_CENTURY_GREGORIAN 36524 /* days */ +#define FOUR_YEARS 1461 /* days */ +#define ONE_YEAR 365 /* days */ + + +/* On demand (lazy) assemble flags */ +#define CLF_INVALIDATE_DATE (1 << 6) /* assemble year, month, etc. using julianDay */ +#define CLF_INVALIDATE_JULIANDAY (1 << 7) /* assemble julianDay using year, month, etc. */ +#define CLF_INVALIDATE_SECONDS (1 << 8) /* assemble localSeconds (and seconds at end) */ + +/* * Structure containing the fields used in [clock format] and [clock scan] */ @@ -52,6 +74,7 @@ typedef struct TclDateFields { typedef struct DateInfo { const char *dateStart; const char *dateInput; + int flags; TclDateFields date; @@ -116,19 +139,71 @@ typedef struct DateInfo { #define yyDigitCount (info->dateDigitCount) -enum {CL_INVALIDATE = (signed int)0x80000000}; /* * Structure containing the command arguments supplied to [clock format] and [clock scan] */ +#define CLF_EXTENDED (1 << 4) +#define CLF_STRICT (1 << 8) + typedef struct ClockFmtScnCmdArgs { Tcl_Obj *formatObj; /* Format */ Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ Tcl_Obj *baseObj; /* Base (scan only) */ + int flags; /* Flags control scanning */ } ClockFmtScnCmdArgs; /* + * Structure containing the client data for [clock] + */ + +typedef struct ClockClientData { + int refCount; /* Number of live references. */ + Tcl_Obj **literals; /* Pool of object literals. */ + /* Cache for current clock parameters, imparted via "configure" */ + unsigned long LastTZEpoch; + int currentYearCentury; + int yearOfCenturySwitch; + Tcl_Obj *SystemTimeZone; + Tcl_Obj *SystemSetupTZData; + Tcl_Obj *GMTSetupTimeZone; + Tcl_Obj *GMTSetupTZData; + Tcl_Obj *AnySetupTimeZone; + Tcl_Obj *AnySetupTZData; + Tcl_Obj *LastUnnormSetupTimeZone; + Tcl_Obj *LastSetupTimeZone; + Tcl_Obj *LastSetupTZData; + /* Cache for last base (last-second fast convert if base/tz not changed) */ + struct { + Tcl_Obj *TimeZone; + TclDateFields Date; + } lastBase; + /* Las-minute cache for fast UTC2Local conversion */ + struct { + /* keys */ + Tcl_Obj *tzData; + int changeover; + Tcl_WideInt seconds; + /* values */ + time_t tzOffset; + Tcl_Obj *tzName; + } UTC2Local; + /* Las-minute cache for fast Local2UTC conversion */ + struct { + /* keys */ + Tcl_Obj *tzData; + int changeover; + Tcl_WideInt localSeconds; + /* values */ + time_t tzOffset; + } Local2UTC; +} ClockClientData; + +#define ClockDefaultYearCentury 2000 +#define ClockDefaultCenturySwitch 38 + +/* * Meridian: am, pm, or 24-hour style. */ @@ -152,8 +227,11 @@ typedef int ClockScanTokenProc( ClockScanToken *tok); -#define CLF_DATE (1 << 2) -#define CLF_TIME (1 << 3) +#define CLF_DATE (1 << 2) +#define CLF_JULIANDAY (1 << 3) +#define CLF_TIME (1 << 4) +#define CLF_LOCALSEC (1 << 5) +#define CLF_SIGNED (1 << 8) typedef enum _CLCKTOK_TYPE { CTOKT_DIGIT = 1, CTOKT_SPACE, CTOKT_WORD diff --git a/library/clock.tcl b/library/clock.tcl index ace4176..e0de904 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -287,9 +287,10 @@ proc ::tcl::clock::Initialize {} { variable FEB_28 58 - # Current year century and year of century switch - variable CurrentYearCentury 2000 - variable YearOfCenturySwitch 38 + # Default configuration + + # configure -year-century 2000 \ + # -century-switch 38 # Translation table to map Windows TZI onto cities, so that the Olson # rules can apply. In some cases the mapping is ambiguous, so it's wise @@ -2534,13 +2535,11 @@ proc ::tcl::clock::ScanWide { str } { proc ::tcl::clock::InterpretTwoDigitYear { date baseTime { twoDigitField yearOfCentury } { fourDigitField year } } { - variable CurrentYearCentury - variable YearOfCenturySwitch set yr [dict get $date $twoDigitField] - if { $yr >= $YearOfCenturySwitch } { + if { $yr >= [configure -century-switch] } { incr yr -100 } - incr yr $CurrentYearCentury + incr yr [configure -year-century] dict set date $fourDigitField $yr return $date } diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 93a78e4..9267684 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -15,10 +15,19 @@ # of this file. # + +## set testing defaults: set ::env(TCL_TZ) :CET +## warm-up (load clock.tcl, system zones, etc.): +clock scan "" -gmt 1 +clock scan "" +clock scan "" -timezone :CET + +## ------------------------------------------ + proc {**STOP**} {args} { - return -code error -level 2 "**STOP** in [info level [expr {[info level]-1}]] [join $args { }]" + return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" } proc _test_get_commands {lst} { @@ -43,7 +52,7 @@ proc _test_out_total {} { puts "" } -proc _test_run {reptime lst {outcmd {puts {$_(r)}}}} { +proc _test_run {reptime lst {outcmd {puts $_(r)}}} { upvar _ _ array set _ [list ittm {} itcnt {} itrate {} reptime $reptime] @@ -74,6 +83,22 @@ proc test-scan {{reptime 1000}} { {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1} {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1} + # Scan : greedy match (space separated) + {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1} + + # Scan : time (in gmt) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1} + # Scan : time (system time zone, with base) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000} + # Scan : time (gmt, without base) + {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1} + # Scan : time (system time zone, without base) + {clock scan "10:35:55" -format "%H:%M:%S"} # Scan : date-time (in gmt) {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1} @@ -85,6 +110,17 @@ proc test-scan {{reptime 1000}} { # Scan : dynamic format (cacheable) {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} + # Scan : julian day in gmt + {clock scan 2451545 -format %J -gmt 1} + # Scan : julian day in system TZ + {clock scan 2451545 -format %J} + # Scan : julian day in other TZ + {clock scan 2451545 -format %J -timezone +0200} + # Scan : julian day with time: + {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"} + # Scan : julian day with time (greedy match): + {clock scan "2451545 102030" -format "%J%H%M%S"} + # Scan : zone only {clock scan "CET" -format "%z"} {clock scan "EST" -format "%z"} @@ -144,6 +180,10 @@ proc test-other {{reptime 1000}} { _test_run $reptime { # Bad zone {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + + # Scan : julian day (overflow) + {catch {clock scan 5373485 -format %J}} + **STOP** # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} @@ -154,11 +194,11 @@ proc test-other {{reptime 1000}} { proc test {{reptime 1000}} { puts "" - test-scan $reptime - #test-freescan $reptime + #test-scan $reptime + test-freescan $reptime test-other $reptime puts \n**OK** } -test 250; # 250 ms +test 100; # ms diff --git a/tests/clock.test b/tests/clock.test index 477f142..9e3dbd7 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35917,7 +35917,94 @@ test clock-34.52 {more than one ordinal month} {*}{ -result {unable to convert date-time string "next January next March": more than one ordinal month in string} } +test clock-34.53.1 {relative from base, date switch} { + set base [clock scan "12/31/2016 23:59:59" -gmt 1] + clock format [clock scan "+1 second" \ + -base $base -gmt 1] -gmt 1 -format {%Y-%m-%d %H:%M:%S} +} {2017-01-01 00:00:00} +test clock-34.53.2 {relative time, daylight switch} { + set base [clock scan "03/27/2016" -timezone CET] + set res {} + lappend res [clock format [clock scan "+1 hour" \ + -base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] + lappend res [clock format [clock scan "+2 hour" \ + -base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] +} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} + +test clock-34.53.3 {relative time with day increment / daylight switch} { + set base [clock scan "03/27/2016" -timezone CET] + set res {} + lappend res [clock format [clock scan "+5 day +25 hour" \ + -base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] + lappend res [clock format [clock scan "+5 day +26 hour" \ + -base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] +} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} + +test clock-34.53.4 {relative time with month & day increment / daylight switch} { + set base [clock scan "03/27/2016" -timezone CET] + set res {} + lappend res [clock format [clock scan "next Mar +5 day +25 hour" \ + -base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] + lappend res [clock format [clock scan "next Mar +5 day +26 hour" \ + -base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] +} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} + +test clock-34.54.1 {check date in DST-hole: daylight switch CET -> CEST} { + set res {} + # forwards + set base 1459033200 + for {set i 0} {$i <= 3} {incr i} { + set d [clock scan "+$i hour" -base $base -timezone CET] + lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]" + } + lappend res "#--" + # backwards + set base 1459044000 + for {set i 0} {$i <= 3} {incr i} { + set d [clock scan "-$i hour" -base $base -timezone CET] + lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]" + } + set res +} [split [regsub -all {^\n|\n$} { +1459033200 = 2016-03-27 00:00:00 CET +1459036800 = 2016-03-27 01:00:00 CET +1459040400 = 2016-03-27 03:00:00 CEST +1459044000 = 2016-03-27 04:00:00 CEST +#-- +1459044000 = 2016-03-27 04:00:00 CEST +1459040400 = 2016-03-27 03:00:00 CEST +1459036800 = 2016-03-27 01:00:00 CET +1459033200 = 2016-03-27 00:00:00 CET +} {}] \n] + +test clock-34.54.2 {check date in DST-hole: daylight switch CEST -> CET} { + set res {} + # forwards + set base 1477782000 + for {set i 0} {$i <= 3} {incr i} { + set d [clock scan "+$i hour" -base $base -timezone CET] + lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]" + } + lappend res "#--" + # backwards + set base 1477792800 + for {set i 0} {$i <= 3} {incr i} { + set d [clock scan "-$i hour" -base $base -timezone CET] + lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]" + } + set res +} [split [regsub -all {^\n|\n$} { +1477782000 = 2016-10-30 01:00:00 CEST +1477785600 = 2016-10-30 02:00:00 CEST +1477789200 = 2016-10-30 02:00:00 CET +1477792800 = 2016-10-30 03:00:00 CET +#-- +1477792800 = 2016-10-30 03:00:00 CET +1477789200 = 2016-10-30 02:00:00 CET +1477785600 = 2016-10-30 02:00:00 CEST +1477782000 = 2016-10-30 01:00:00 CEST +} {}] \n] # clock seconds test clock-35.1 {clock seconds tests} { -- cgit v0.12 From 18be594c8481eee9b98d140af50df7ccb3a3a79e Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:20:25 +0000 Subject: amend for caching of UTC2Local / Local2UTC: * tzdata used internally only (because cached, replaced with timezone object as parameter for several functions) * small improvement (don't need to convert UTC to UTC) --- generic/tclClock.c | 104 ++++++++++++++++++++++++++++++++--------------------- generic/tclDate.h | 14 ++++---- library/clock.tcl | 34 +++++++++--------- 3 files changed, 88 insertions(+), 64 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 7cc5d86..6bd6336 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -107,13 +107,13 @@ TCL_DECLARE_MUTEX(clockMutex) */ static int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, - TclDateFields *, Tcl_Obj *, int); + TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, - TclDateFields *, Tcl_Obj *, int); + TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, @@ -138,7 +138,7 @@ static int ClockConvertlocaltoutcObjCmd( static int ClockGetDateFields(ClientData clientData, Tcl_Interp *interp, TclDateFields *fields, - Tcl_Obj *tzdata, int changeover); + Tcl_Obj *timezoneObj, int changeover); static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -287,10 +287,10 @@ TclClockInit( data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; - data->lastBase.TimeZone = NULL; - data->UTC2Local.tzData = NULL; + data->lastBase.timezoneObj = NULL; + data->UTC2Local.timezoneObj = NULL; data->UTC2Local.tzName = NULL; - data->Local2UTC.tzData = NULL; + data->Local2UTC.timezoneObj = NULL; /* * Install the commands. @@ -335,10 +335,10 @@ ClockConfigureClear( Tcl_UnsetObjRef(data->LastSetupTimeZone); Tcl_UnsetObjRef(data->LastSetupTZData); - Tcl_UnsetObjRef(data->lastBase.TimeZone); - Tcl_UnsetObjRef(data->UTC2Local.tzData); + Tcl_UnsetObjRef(data->lastBase.timezoneObj); + Tcl_UnsetObjRef(data->UTC2Local.timezoneObj); Tcl_UnsetObjRef(data->UTC2Local.tzName); - Tcl_UnsetObjRef(data->Local2UTC.tzData); + Tcl_UnsetObjRef(data->Local2UTC.timezoneObj); } static void @@ -699,11 +699,11 @@ ClockFormatNumericTimeZone(int z) { * is available. * * Usage: - * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover + * ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover * * Parameters: * dict - Dictionary containing a 'localSeconds' entry. - * tzdata - Time zone data + * timezone - Time zone * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: @@ -739,7 +739,7 @@ ClockConvertlocaltoutcObjCmd( */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover"); return TCL_ERROR; } dict = objv[1]; @@ -789,12 +789,11 @@ ClockConvertlocaltoutcObjCmd( * formatting a date, and populates a dictionary with them. * * Usage: - * ::tcl::clock::GetDateFields seconds tzdata changeover + * ::tcl::clock::GetDateFields seconds timezone changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. - * tzdata - Time zone data of the time zone in which time is to be - * expressed. + * timezone - Time zone in which time is to be expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * @@ -830,7 +829,7 @@ ClockGetdatefieldsObjCmd( */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK @@ -900,14 +899,14 @@ ClockGetDateFields( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Pointer to result fields, where * fields->seconds contains date to extract */ - Tcl_Obj *tzdata, /* Time zone data object or NULL for gmt */ + Tcl_Obj *timezoneObj, /* Time zone object or NULL for gmt */ int changeover) /* Julian Day Number */ { /* * Convert UTC time to local. */ - if (ConvertUTCToLocal(clientData, interp, fields, tzdata, + if (ConvertUTCToLocal(clientData, interp, fields, timezoneObj, changeover) != TCL_OK) { return TCL_ERROR; } @@ -1165,18 +1164,26 @@ ConvertLocalToUTC( ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ int changeover) /* Julian Day of the Gregorian transition */ { ClockClientData *dataPtr = clientData; + Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ + if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) { + fields->seconds = fields->localSeconds; + fields->tzOffset = 0; + return TCL_OK; + } + /* * Check cacheable conversion could be used * (last-minute Local2UTC cache with the same TZ) */ - if ( tzdata == dataPtr->Local2UTC.tzData + if ( timezoneObj == dataPtr->Local2UTC.timezoneObj && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds || fields->localSeconds / 60 == dataPtr->Local2UTC.localSeconds / 60 ) @@ -1192,6 +1199,11 @@ ConvertLocalToUTC( * Unpack the tz data. */ + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -1212,7 +1224,7 @@ ConvertLocalToUTC( } /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->Local2UTC.tzData, tzdata); + Tcl_SetObjRef(dataPtr->Local2UTC.timezoneObj, timezoneObj); dataPtr->Local2UTC.localSeconds = fields->localSeconds; dataPtr->Local2UTC.changeover = changeover; dataPtr->Local2UTC.tzOffset = fields->tzOffset; @@ -1432,18 +1444,34 @@ ConvertUTCToLocal( ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ int changeover) /* Julian Day of the Gregorian transition */ { ClockClientData *dataPtr = clientData; + Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ + if (timezoneObj == dataPtr->GMTSetupTimeZone + && dataPtr->GMTSetupTimeZone != NULL + && dataPtr->GMTSetupTZData != NULL + ) { + fields->localSeconds = fields->seconds; + fields->tzOffset = 0; + if ( TclListObjGetElements(interp, dataPtr->GMTSetupTZData, &rowc, &rowv) != TCL_OK + || Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) { + return TCL_ERROR; + } + Tcl_IncrRefCount(fields->tzName); + return TCL_OK; + } + /* * Check cacheable conversion could be used * (last-minute UTC2Local cache with the same TZ) */ - if ( tzdata == dataPtr->UTC2Local.tzData + if ( timezoneObj == dataPtr->UTC2Local.timezoneObj && ( fields->seconds == dataPtr->UTC2Local.seconds || fields->seconds / 60 == dataPtr->UTC2Local.seconds / 60 ) @@ -1460,6 +1488,11 @@ ConvertUTCToLocal( * Unpack the tz data. */ + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -1480,7 +1513,7 @@ ConvertUTCToLocal( } /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->UTC2Local.tzData, tzdata); + Tcl_SetObjRef(dataPtr->UTC2Local.timezoneObj, timezoneObj); dataPtr->UTC2Local.seconds = fields->seconds; dataPtr->UTC2Local.changeover = changeover; dataPtr->UTC2Local.tzOffset = fields->tzOffset; @@ -2607,32 +2640,27 @@ ClockScanObjCmd( if (opts.timezoneObj == NULL) { goto done; } + // Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); /* * Extract year, month and day from the base time for the parser to use as * defaults */ - yydate.tzData = ClockGetTZData(clientData, interp, opts.timezoneObj); - if (yydate.tzData == NULL) { - goto done; - } - Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); - /* check base fields already cached (by TZ, last-second cache) */ - if ( dataPtr->lastBase.TimeZone == opts.timezoneObj + if ( dataPtr->lastBase.timezoneObj == opts.timezoneObj && dataPtr->lastBase.Date.seconds == baseVal) { memcpy(&yydate, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); } else { /* extact fields from base */ yydate.seconds = baseVal; - if (ClockGetDateFields(clientData, interp, &yydate, yydate.tzData, + if (ClockGetDateFields(clientData, interp, &yydate, opts.timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } /* cache last base */ memcpy(&dataPtr->lastBase.Date, &yydate, ClockCacheableDateFieldsSize); - Tcl_SetObjRef(dataPtr->lastBase.TimeZone, opts.timezoneObj); + Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts.timezoneObj); } /* seconds are in localSeconds (relative base date), so reset time here */ @@ -2700,8 +2728,8 @@ ClockScanObjCmd( + ( yySeconds % SECONDS_PER_DAY ); } - if (ConvertLocalToUTC(clientData, interp, &yydate, yydate.tzData, GREGORIAN_CHANGE_DATE) - != TCL_OK) { + if (ConvertLocalToUTC(clientData, interp, &yydate, opts.timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } @@ -2798,12 +2826,8 @@ ClockFreeScan( if (opts->timezoneObj == NULL) { goto done; } - yydate.tzData = ClockGetTZData(clientData, interp, opts->timezoneObj); - if (yydate.tzData == NULL) { - goto done; - } - Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); + // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); info->flags |= CLF_INVALIDATE_SECONDS; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 47f2a21..9585258 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -60,8 +60,8 @@ typedef struct TclDateFields { time_t minutes; /* Minutes of day (in-between time only calculation) */ time_t secondOfDay; /* Seconds of day (in-between time only calculation) */ - Tcl_Obj *tzName; /* Time zone name (if set the refCount is incremented) */ - Tcl_Obj *tzData; /* Time zone data object (internally referenced) */ + Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the + * time zone, if set the refCount is incremented */ } TclDateFields; #define ClockCacheableDateFieldsSize \ @@ -176,14 +176,14 @@ typedef struct ClockClientData { Tcl_Obj *LastSetupTZData; /* Cache for last base (last-second fast convert if base/tz not changed) */ struct { - Tcl_Obj *TimeZone; + Tcl_Obj *timezoneObj; TclDateFields Date; } lastBase; /* Las-minute cache for fast UTC2Local conversion */ struct { /* keys */ - Tcl_Obj *tzData; - int changeover; + Tcl_Obj *timezoneObj; + int changeover; Tcl_WideInt seconds; /* values */ time_t tzOffset; @@ -192,8 +192,8 @@ typedef struct ClockClientData { /* Las-minute cache for fast Local2UTC conversion */ struct { /* keys */ - Tcl_Obj *tzData; - int changeover; + Tcl_Obj *timezoneObj; + int changeover; Tcl_WideInt localSeconds; /* values */ time_t tzOffset; diff --git a/library/clock.tcl b/library/clock.tcl index e0de904..ebbecb9 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -677,7 +677,7 @@ proc ::tcl::clock::format { args } { } } if {![info exists TZData($timezone)]} { - if {[catch {SetupTimeZone $timezone} retval opts]} { + if {[catch {set timezone [SetupTimeZone $timezone]} retval opts]} { dict unset opts -errorinfo return -options $opts $retval } @@ -744,7 +744,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { { variable TZData set date [GetDateFields $clockval \ - $TZData($timezone) \ + $timezone \ @GREGORIAN_CHANGE_DATE@] }] set formatString {} @@ -1776,7 +1776,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { } } append procBody { - ::tcl::clock::SetupTimeZone $timeZone + set timeZone [::tcl::clock::SetupTimeZone $timeZone] } } @@ -1810,7 +1810,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { append procBody { set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \ - $TZData($timeZone) $changeover] + $timeZone $changeover] } } @@ -2572,7 +2572,7 @@ proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } { # Find the Julian Day Number corresponding to the base time, and # find the Gregorian year corresponding to that Julian Day. - set date2 [GetDateFields $baseTime $TZData($timezone) $changeover] + set date2 [GetDateFields $baseTime $timezone $changeover] # Store the converted year @@ -2610,7 +2610,7 @@ proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} { # Find the Julian Day Number corresponding to the base time - set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] + set date2 [GetDateFields $baseTime $timeZone $changeover] # Calculate the ISO8601 date and transfer the year @@ -2646,7 +2646,7 @@ proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} { # Find the year and month corresponding to the base time - set date2 [GetDateFields $baseTime $TZData($timezone) $changeover] + set date2 [GetDateFields $baseTime $timezone $changeover] dict set date era [dict get $date2 era] dict set date year [dict get $date2 year] dict set date month [dict get $date2 month] @@ -2680,7 +2680,7 @@ proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} { # Find the Julian Day Number corresponding to the base time - set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] + set date2 [GetDateFields $baseTime $timeZone $changeover] # Calculate the ISO8601 date and transfer the year @@ -2716,7 +2716,7 @@ proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } { # Find the Julian Day Number corresponding to the base time - set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover] + set date2 [GetDateFields $baseTime $timeZone $changeover] dict set date julianDay [dict get $date2 julianDay] return $date @@ -2823,7 +2823,7 @@ proc ::tcl::clock::GetSystemTimeZone {} { } } if { ![dict exists $TimeZoneBad $timezone] } { - catch {SetupTimeZone $timezone} + catch {set timezone [SetupTimeZone $timezone]} } if { [dict exists $TimeZoneBad $timezone] } { @@ -2965,7 +2965,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } { } } - # tell backend - timezone is initialized: + # tell backend - timezone is initialized and return shared timezone object: configure -setup-tz $timezone } @@ -3037,7 +3037,7 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { if { [dict exists $WinZoneInfo $data] } { set tzname [dict get $WinZoneInfo $data] if { ! [dict exists $TimeZoneBad $tzname] } { - catch {SetupTimeZone $tzname} + catch {set tzname [SetupTimeZone $tzname]} } } else { set tzname {} @@ -4131,7 +4131,7 @@ proc ::tcl::clock::add { clockval args } { set changeover [mc GREGORIAN_CHANGE_DATE] - if {[catch {SetupTimeZone $timezone} retval opts]} { + if {[catch {set timezone [SetupTimeZone $timezone]} retval opts]} { dict unset opts -errorinfo return -options $opts $retval } @@ -4215,7 +4215,7 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } { # Convert the time to year, month, day, and fraction of day. - set date [GetDateFields $clockval $TZData($timezone) $changeover] + set date [GetDateFields $clockval $timezone $changeover] dict set date secondOfDay [expr { [dict get $date localSeconds] % 86400 }] @@ -4252,7 +4252,7 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } { + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] - set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \ + set date [ConvertLocalToUTC $date[set date {}] $timezone \ $changeover] return [dict get $date seconds] @@ -4336,7 +4336,7 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } { # Convert the time to Julian Day - set date [GetDateFields $clockval $TZData($timezone) $changeover] + set date [GetDateFields $clockval $timezone $changeover] dict set date secondOfDay [expr { [dict get $date localSeconds] % 86400 }] @@ -4353,7 +4353,7 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } { + ( 86400 * wide([dict get $date julianDay]) ) + [dict get $date secondOfDay] }] - set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \ + set date [ConvertLocalToUTC $date[set date {}] $timezone \ $changeover] return [dict get $date seconds] -- cgit v0.12 From dc9796c6e858828861b1339b4734bab19cccca4c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:21:26 +0000 Subject: several initialize and finalize facilities --- generic/tclClock.c | 16 +++++++++------- generic/tclClockFmt.c | 26 +++++++++++++++++++++----- generic/tclDate.c | 19 +++---------------- generic/tclDate.h | 14 +++++++++++++- generic/tclGetDate.y | 19 +++---------------- 5 files changed, 49 insertions(+), 45 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 6bd6336..a4edb82 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -324,6 +324,8 @@ static void ClockConfigureClear( ClockClientData *data) { + ClockFrmScnClearCaches(); + data->LastTZEpoch = 0; Tcl_UnsetObjRef(data->SystemTimeZone); Tcl_UnsetObjRef(data->SystemSetupTZData); @@ -2609,8 +2611,6 @@ ClockScanObjCmd( ret = TCL_ERROR; - info->flags = 0; - if (opts.baseObj != NULL) { if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { return TCL_ERROR; @@ -2621,8 +2621,6 @@ ClockScanObjCmd( baseVal = (Tcl_WideInt) now.sec; } - yydate.tzName = NULL; - /* If time zone not specified use system time zone */ if ( opts.timezoneObj == NULL || TclGetString(opts.timezoneObj) == NULL @@ -2630,7 +2628,7 @@ ClockScanObjCmd( ) { opts.timezoneObj = ClockGetSystemTimeZone(clientData, interp); if (opts.timezoneObj == NULL) { - goto done; + return TCL_ERROR; } } @@ -2638,8 +2636,12 @@ ClockScanObjCmd( opts.timezoneObj = ClockSetupTimeZone(clientData, interp, opts.timezoneObj); if (opts.timezoneObj == NULL) { - goto done; + return TCL_ERROR; } + + ClockInitDateInfo(info); + yydate.tzName = NULL; + // Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); /* @@ -2679,7 +2681,7 @@ ClockScanObjCmd( } ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); } -#if 1 +#if 0 else if (1) { /* TODO: Tcled Scan proc - */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 48b9b69..ad04e4b 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -31,6 +31,8 @@ TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); +static void ClockFrmScnFinalize(ClientData clientData); + /* * Clock scan and format facilities. */ @@ -148,7 +150,7 @@ ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) */ static Tcl_HashTable FmtScnHashTable; -static int initFmtScnHashTable = 0; +static int initialized = 0; inline Tcl_HashEntry * HashEntry4FmtScn(ClockFmtScnStorage *fss) { @@ -246,16 +248,18 @@ FindOrCreateFmtScnStorage( Tcl_MutexLock(&ClockFmtMutex); /* if not yet initialized */ - if (!initFmtScnHashTable) { + if (!initialized) { /* initialize type */ memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; - initFmtScnHashTable = 1; /* initialize hash table */ Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, &ClockFmtScnStorageHashKeyType); + + initialized = 1; + Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL); } /* get or create entry (and alocate storage) */ @@ -845,18 +849,30 @@ done: } +MODULE_SCOPE void +ClockFrmScnClearCaches(void) +{ + Tcl_MutexLock(&ClockFmtMutex); + /* clear caches ... */ + Tcl_MutexUnlock(&ClockFmtMutex); +} + static void -Tcl_GetClockFrmScnFinalize() +ClockFrmScnFinalize( + ClientData clientData) /* Not used. */ { + Tcl_MutexLock(&ClockFmtMutex); #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* clear GC */ ClockFmtScnStorage_GC.stackPtr = NULL; ClockFmtScnStorage_GC.stackBound = NULL; ClockFmtScnStorage_GC.count = 0; #endif - if (initFmtScnHashTable) { + if (initialized) { Tcl_DeleteHashTable(&FmtScnHashTable); + initialized = 0; } + Tcl_MutexUnlock(&ClockFmtMutex); Tcl_MutexFinalize(&ClockFmtMutex); } /* diff --git a/generic/tclDate.c b/generic/tclDate.c index 97d13b4..5bd96d0 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2685,24 +2685,11 @@ TclClockFreeScan( /* * yyInput = stringToParse; - * yyYear = baseYear; yyMonth = baseMonth; yyDay = baseDay; + * + * ClockInitDateInfo(info) should be executed to pre-init info; */ - yyHaveDate = 0; - - yyHaveTime = 0; - - yyHaveZone = 0; - yyTimezone = 0; yyDSTmode = DSTmaybe; - - yyHaveOrdinalMonth = 0; - yyMonthOrdinalIncr = 0; - - yyHaveDay = 0; - yyDayOrdinal = 0; yyDayNumber = 0; - - yyHaveRel = 0; - yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; + yyDSTmode = DSTmaybe; info->messages = Tcl_NewObj(); info->separatrix = ""; diff --git a/generic/tclDate.h b/generic/tclDate.h index 9585258..2010178 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -40,6 +40,9 @@ */ typedef struct TclDateFields { + + /* Cacheable fields: */ + Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds @@ -60,6 +63,8 @@ typedef struct TclDateFields { time_t minutes; /* Minutes of day (in-between time only calculation) */ time_t secondOfDay; /* Seconds of day (in-between time only calculation) */ + /* Non cacheable fields: */ + Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the * time zone, if set the refCount is incremented */ } TclDateFields; @@ -74,10 +79,11 @@ typedef struct TclDateFields { typedef struct DateInfo { const char *dateStart; const char *dateInput; - int flags; TclDateFields date; + int flags; + time_t dateHaveDate; time_t dateMeridian; @@ -138,6 +144,10 @@ typedef struct DateInfo { #define yyInput (info->dateInput) #define yyDigitCount (info->dateDigitCount) +inline void +ClockInitDateInfo(DateInfo *info) { + memset(info, 0, sizeof(DateInfo)); +} /* * Structure containing the command arguments supplied to [clock format] and [clock scan] @@ -298,6 +308,8 @@ MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); +MODULE_SCOPE void ClockFrmScnClearCaches(void); + /* * Other externals. */ diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 54087ca..9e3623f 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -896,24 +896,11 @@ TclClockFreeScan( /* * yyInput = stringToParse; - * yyYear = baseYear; yyMonth = baseMonth; yyDay = baseDay; + * + * ClockInitDateInfo(info) should be executed to pre-init info; */ - yyHaveDate = 0; - - yyHaveTime = 0; - - yyHaveZone = 0; - yyTimezone = 0; yyDSTmode = DSTmaybe; - - yyHaveOrdinalMonth = 0; - yyMonthOrdinalIncr = 0; - - yyHaveDay = 0; - yyDayOrdinal = 0; yyDayNumber = 0; - - yyHaveRel = 0; - yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL; + yyDSTmode = DSTmaybe; info->messages = Tcl_NewObj(); info->separatrix = ""; -- cgit v0.12 From 62ddcc3daa746fc8be02e6b118e0c923ec227793 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:23:37 +0000 Subject: [temp-commit]: not ready --- generic/tclClock.c | 167 ++++++++++++++++++++---- generic/tclClockFmt.c | 319 ++++++++++++++++++++++++++++++++++++++-------- generic/tclDate.h | 32 ++++- library/msgcat/msgcat.tcl | 54 +++++++- tests-perf/clock.perf.tcl | 13 +- 5 files changed, 501 insertions(+), 84 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a4edb82..1e9abba 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -59,6 +59,8 @@ typedef enum ClockLiteral { LIT_TZDATA, LIT_GETSYSTEMTIMEZONE, LIT_SETUPTIMEZONE, + LIT_GETSYSTEMLOCALE, + LIT_SETUPLOCALE, #if 0 LIT_FREESCAN, #endif @@ -81,6 +83,8 @@ static const char *const Literals[] = { "::tcl::clock::TZData", "::tcl::clock::GetSystemTimeZone", "::tcl::clock::SetupTimeZone", + "::tcl::clock::mclocale", + "::tcl::clock::EnterLocale", #if 0 "::tcl::clock::FreeScan" #endif @@ -176,24 +180,6 @@ static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); /* - * Primitives to safe set, reset and free references. - */ - -#define Tcl_UnsetObjRef(obj) \ - if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } -#define Tcl_InitObjRef(obj, val) \ - obj = val; if (obj) { Tcl_IncrRefCount(obj); } -#define Tcl_SetObjRef(obj, val) \ -if (1) { \ - Tcl_Obj *nval = val; \ - if (obj != nval) { \ - Tcl_Obj *prev = obj; \ - Tcl_InitObjRef(obj, nval); \ - if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ - } \ -} - -/* * Structure containing description of "native" clock commands to create. */ @@ -610,12 +596,18 @@ ClockGetSystemTimeZone( return dataPtr->SystemTimeZone; } + Tcl_UnsetObjRef(dataPtr->SystemTimeZone); + Tcl_UnsetObjRef(data->SystemSetupTZData); + literals = dataPtr->literals; if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { return NULL; } - return Tcl_GetObjResult(interp); + if (dataPtr->SystemTimeZone == NULL) { + Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp)); + } + return dataPtr->SystemTimeZone; } /* *---------------------------------------------------------------------- @@ -694,6 +686,124 @@ ClockFormatNumericTimeZone(int z) { /* *---------------------------------------------------------------------- + */ +inline Tcl_Obj * +NormLocaleObj( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Obj *localeObj) +{ + const char * tz; + if ( localeObj == dataPtr->LastUnnormSetupLocale + && dataPtr->LastSetupLocale != NULL + ) { + return dataPtr->LastSetupLocale; + } + if ( localeObj == dataPtr->LastSetupLocale + || localeObj == dataPtr->literals[LIT_CLOCALE] + || localeObj == dataPtr->SystemLocale + || localeObj == dataPtr->AnySetupLocale + ) { + return localeObj; + } + + tz = TclGetString(localeObj); + if (dataPtr->AnySetupLocale != NULL && + (localeObj == dataPtr->AnySetupLocale + || strcmp(tz, TclGetString(dataPtr->AnySetupLocale)) == 0 + ) + ) { + localeObj = dataPtr->AnySetupLocale; + } + else + if (dataPtr->SystemLocale != NULL && + (localeObj == dataPtr->SystemLocale + || strcmp(tz, TclGetString(dataPtr->SystemLocale)) == 0 + ) + ) { + localeObj = dataPtr->SystemLocale; + } + else + if ( + strcmp(tz, Literals[LIT_GMT]) == 0 + ) { + localeObj = dataPtr->literals[LIT_GMT]; + } + return localeObj; +} +/* + *---------------------------------------------------------------------- + */ +static Tcl_Obj * +ClockGetSystemLocale( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals; + + /* if known (cached) - return now */ + if (dataPtr->SystemLocale != NULL) { + return dataPtr->SystemLocale; + } + + literals = dataPtr->literals; + + if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) { + return NULL; + } + Tcl_SetObjRef(dataPtr->SystemLocale, Tcl_GetObjResult(interp)); + return dataPtr->SystemLocale; +} +/* + *---------------------------------------------------------------------- + */ +static Tcl_Obj * +ClockSetupLocale( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *localeObj) +{ + ClockClientData *dataPtr = clientData; + Tcl_Obj **literals = dataPtr->literals; + Tcl_Obj *callargs[2]; + + if (localeObj == NULL || localeObj == dataPtr->SystemLocale) { + if (dataPtr->SystemLocale == NULL) { + return ClockGetSystemLocale(clientData, interp); + } + return dataPtr->SystemLocale; + } + +#if 0 + /* if cached (if already setup this one) */ + if ( dataPtr->LastSetupTimeZone != NULL + && ( localeObj == dataPtr->LastSetupTimeZone + || timezoneObj == dataPtr->LastUnnormSetupTimeZone + ) + ) { + return dataPtr->LastSetupTimeZone; + } + + /* differentiate GMT and system zones, because used often and already set */ + timezoneObj = NormTimezoneObj(dataPtr, timezoneObj); + if ( timezoneObj == dataPtr->GMTSetupTimeZone + || timezoneObj == dataPtr->SystemTimeZone + || timezoneObj == dataPtr->AnySetupTimeZone + ) { + return timezoneObj; + } + +#endif + callargs[0] = literals[LIT_SETUPLOCALE]; + callargs[1] = localeObj; + + if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { + return localeObj; // dataPtr->CurrentLocale; + } + return NULL; +} +/* + *---------------------------------------------------------------------- * * ClockConvertlocaltoutcObjCmd -- * @@ -2440,11 +2550,7 @@ _ClockParseFmtScnArgs( * Extract values for the keywords. */ - resOpts->formatObj = NULL; - resOpts->localeObj = NULL; - resOpts->timezoneObj = NULL; - resOpts->baseObj = NULL; - resOpts->flags = 0; + memset(resOpts, 0, sizeof(*resOpts)); for (i = 2; i < objc; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options[forScan], "option", 0, &optionIndex) != TCL_OK) { @@ -2488,6 +2594,9 @@ _ClockParseFmtScnArgs( resOpts->timezoneObj = litPtr[LIT_GMT]; } + resOpts->clientData = clientData; + resOpts->interp = interp; + return TCL_OK; } @@ -2562,7 +2671,7 @@ ClockParseformatargsObjCmd( * Return options as a list. */ - Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&resOpts)); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&resOpts.formatObj)); return TCL_OK; } @@ -2632,13 +2741,19 @@ ClockScanObjCmd( } } - /* Get the data for time changes in the given zone */ + /* Setup timezone and locale */ opts.timezoneObj = ClockSetupTimeZone(clientData, interp, opts.timezoneObj); if (opts.timezoneObj == NULL) { return TCL_ERROR; } + opts.localeObj = ClockSetupLocale(clientData, interp, opts.localeObj); + if (opts.localeObj == NULL) { + return TCL_ERROR; + } + + ClockInitDateInfo(info); yydate.tzName = NULL; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index ad04e4b..17181d9 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -454,32 +454,170 @@ Tcl_GetClockFrmScnFromObj( return fss; } + +static int +LocaleListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, const char * mcKey, int *val) +{ + Tcl_Obj *callargs[4] = {NULL, NULL, NULL, NULL}, **lstv; + int i, lstc; + Tcl_Obj *valObj = NULL; + int ret = TCL_RETURN; + + /* get msgcat value */ + TclNewLiteralStringObj(callargs[0], "::msgcat::mcget"); + TclNewLiteralStringObj(callargs[1], "::tcl::clock"); + callargs[2] = opts->localeObj; + if (opts->localeObj == NULL) { + TclNewLiteralStringObj(callargs[1], "c"); + } + callargs[3] = Tcl_NewStringObj(mcKey, -1); -#define AllocTokenInChain(tok, chain, tokCnt) \ - if (++(tok) >= (chain) + (tokCnt)) { \ - (char *)(chain) = ckrealloc((char *)(chain), \ - (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ - if ((chain) == NULL) { goto done; }; \ - (tok) = (chain) + (tokCnt); \ - (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } \ - memset(tok, 0, sizeof(*(tok))); + for (i = 0; i < 4; i++) { + Tcl_IncrRefCount(callargs[i]); + } + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK) { + goto done; + } + + Tcl_InitObjRef(valObj, Tcl_GetObjResult(opts->interp)); + + /* is a list */ + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + goto done; + } + + /* search in list */ + for (i = 0; i < lstc; i++) { + const char *s = TclGetString(lstv[i]); + int l = lstv[i]->length; + if ( l <= info->dateEnd - yyInput + && strncasecmp(yyInput, s, l) == 0 + ) { + *val = i; + yyInput += l; + break; + } + } + + ret = TCL_OK; + /* if not found */ + if (i >= lstc) { + ret = TCL_ERROR; + } + +done: + + Tcl_UnsetObjRef(valObj); + + for (i = 0; i < 4; i++) { + Tcl_UnsetObjRef(callargs[i]); + } + + return ret; +} + +static int +StaticListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, const char **lst, int *val) +{ + int len; + const char **s = lst; + while (*s != NULL) { + len = strlen(*s); + if ( len <= info->dateEnd - yyInput + && strncasecmp(yyInput, *s, len) == 0 + ) { + *val = (s - lst); + yyInput += len; + break; + } + s++; + } + if (*s == NULL) { + return TCL_ERROR; + } + + return TCL_OK; +}; + +static int +ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + /* + static const char * months[] = { + /* full * / + "January", "February", "March", + "April", "May", "June", + "July", "August", "September", + "October", "November", "December", + /* abbr * / + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + NULL + }; + int val; + if (StaticListSearch(opts, info, months, &val) != TCL_OK) { + return TCL_ERROR; + } + yyMonth = (val % 12) + 1; + return TCL_OK; + */ + + int val; + int ret = LocaleListSearch(opts, info, "MONTHS_FULL", &val); + if (ret != TCL_OK) { + if (ret == TCL_RETURN) { + return ret; + } + ret = LocaleListSearch(opts, info, "MONTHS_ABBREV", &val); + if (ret != TCL_OK) { + return ret; + } + } + + yyMonth = val + 1; + return TCL_OK; + +} + + +static int +ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int val; + + int ret = LocaleListSearch(opts, info, (char *)tok->map->data, &val); + if (ret != TCL_OK) { + return ret; + } + + *(time_t *)(((char *)info) + tok->map->offs) = val; + + return TCL_OK; +} -const char *ScnSTokenMapChars = - "dmyYHMSJs"; + +static const char *ScnSTokenMapIndex = + "dmbyYHMSJCs"; static ClockScanTokenMap ScnSTokenMap[] = { - /* %d */ + /* %d %e */ {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.dayOfMonth), NULL}, /* %m */ {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.month), NULL}, + /* %b %B %h */ + {CTOKT_PARSER, CLF_DATE, 0, 0, 0, + ClockScnToken_Month_Proc}, /* %y */ {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.year), NULL}, /* %Y */ - {CTOKT_DIGIT, CLF_DATE, 1, 4, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 1, 4, TclOffset(DateInfo, date.year), NULL}, /* %H */ {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.hour), @@ -493,11 +631,41 @@ static ClockScanTokenMap ScnSTokenMap[] = { /* %J */ {CTOKT_DIGIT, CLF_DATE | CLF_JULIANDAY, 1, 0xffff, TclOffset(DateInfo, date.julianDay), NULL}, + /* %C */ + {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 1, 2, TclOffset(DateInfo, dateCentury), + NULL}, /* %s */ {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), NULL}, }; -const char *ScnSpecTokenMapChars = +static const char *ScnSTokenWrapMapIndex[2] = { + "eBh", + "dbb" +}; + +static const char *ScnETokenMapIndex = + ""; +static ClockScanTokenMap ScnETokenMap[] = { + {0, 0, 0} +}; +static const char *ScnETokenWrapMapIndex[2] = { + "", + "" +}; + +static const char *ScnOTokenMapIndex = + "d"; +static ClockScanTokenMap ScnOTokenMap[] = { + /* %Od %Oe */ + {CTOKT_PARSER, CLF_DATE, 0, 0, TclOffset(DateInfo, date.dayOfMonth), + ClockScnToken_LocaleListMatcher_Proc, "LOCALE_NUMERALS"}, +}; +static const char *ScnOTokenWrapMapIndex[2] = { + "e", + "d" +}; + +static const char *ScnSpecTokenMapIndex = " "; static ClockScanTokenMap ScnSpecTokenMap[] = { {CTOKT_SPACE, 0, 1, 0xffff, 0, @@ -508,6 +676,17 @@ static ClockScanTokenMap ScnWordTokenMap = { CTOKT_WORD, 0, 1, 0, 0, NULL }; + + +#define AllocTokenInChain(tok, chain, tokCnt) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + (char *)(chain) = ckrealloc((char *)(chain), \ + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ + if ((chain) == NULL) { goto done; }; \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ + memset(tok, 0, sizeof(*(tok))); /* *---------------------------------------------------------------------- @@ -546,10 +725,14 @@ ClockGetOrParseScanFormat( fss->scnTok = tok = ckalloc(sizeof(*tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); memset(tok, 0, sizeof(*(tok))); - strFmt = TclGetString(formatObj); - for (e = p = strFmt, e += formatObj->length; p != e; p++) { + strFmt = HashEntry4FmtScn(fss)->key.string; + for (e = p = strFmt, e += strlen(strFmt); p != e; p++) { switch (*p) { case '%': + if (1) { + ClockScanTokenMap * maps = ScnSTokenMap; + const char *mapIndex = ScnSTokenMapIndex, + **wrapIndex = ScnSTokenWrapMapIndex; if (p+1 >= e) { goto word_tok; } @@ -565,43 +748,62 @@ ClockGetOrParseScanFormat( continue; break; case 'E': - goto ext_tok_E; + maps = ScnETokenMap, + mapIndex = ScnETokenMapIndex, + wrapIndex = ScnETokenWrapMapIndex; + p++; break; case 'O': - goto ext_tok_O; + maps = ScnOTokenMap, + mapIndex = ScnOTokenMapIndex, + wrapIndex = ScnOTokenWrapMapIndex; + p++; break; - default: - cp = strchr(ScnSTokenMapChars, *p); + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(wrapIndex[0], *p); if (!cp || *cp == '\0') { p--; goto word_tok; } - tok->map = &ScnSTokenMap[cp - ScnSTokenMapChars]; - /* calculate look ahead value by standing together tokens */ - if (tok > fss->scnTok) { - ClockScanToken *prevTok = tok - 1; - unsigned int lookAhead = tok->map->minSize; - - while (prevTok >= fss->scnTok) { - if (prevTok->map->type != tok->map->type) { - break; - } - prevTok->lookAhead += lookAhead; - prevTok--; + cp = strchr(mapIndex, wrapIndex[1][cp - wrapIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; + goto word_tok; + } + } + tok->map = &ScnSTokenMap[cp - mapIndex]; + tok->tokWord.start = p; + /* calculate look ahead value by standing together tokens */ + if (tok > fss->scnTok) { + ClockScanToken *prevTok = tok - 1; + unsigned int lookAhead = tok->map->minSize; + + while (prevTok >= fss->scnTok) { + if (prevTok->map->type != tok->map->type) { + break; } + prevTok->lookAhead += lookAhead; + prevTok--; } - /* next token */ - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); - break; } + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + } break; case ' ': - cp = strchr(ScnSpecTokenMapChars, *p); + cp = strchr(ScnSpecTokenMapIndex, *p); if (!cp || *cp == '\0') { p--; goto word_tok; } - tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapChars]; + tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); break; default: @@ -619,20 +821,10 @@ word_tok: } continue; } + break; } continue; - -ext_tok_E: - - /*******************/ - continue; - -ext_tok_O: - - /*******************/ - continue; - } done: @@ -677,17 +869,20 @@ ClockScan( } } info->dateStart = yyInput = p; + info->dateEnd = end; /* parse string */ for (; tok->map != NULL; tok++) { map = tok->map; /* bypass spaces at begin of input before parsing each token */ - if (!(opts->flags & CLF_STRICT) && map->type != CTOKT_SPACE) { + if ( !(opts->flags & CLF_STRICT) + && (map->type != CTOKT_SPACE && map->type != CTOKT_WORD) + ) { while (p < end && isspace(UCHAR(*p))) { p++; } - yyInput = p; } + yyInput = p; switch (map->type) { case CTOKT_DIGIT: @@ -753,6 +948,20 @@ ClockScan( flags |= map->flags; } break; + case CTOKT_PARSER: + switch (map->parser(opts, info, tok)) { + case TCL_OK: + break; + case TCL_RETURN: + goto done; + break; + default: + goto error; + break; + }; + p = yyInput; + flags |= map->flags; + break; case CTOKT_SPACE: /* at least one space in strict mode */ if (opts->flags & CLF_STRICT) { @@ -803,10 +1012,14 @@ ClockScan( info->flags |= CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY; if (yyYear < 100) { - if (yyYear >= dataPtr->yearOfCenturySwitch) { - yyYear -= 100; + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; } - yyYear += dataPtr->currentYearCentury; } yydate.era = CE; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 2010178..d97cd3c 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -36,6 +36,24 @@ #define CLF_INVALIDATE_SECONDS (1 << 8) /* assemble localSeconds (and seconds at end) */ /* + * Primitives to safe set, reset and free references. + */ + +#define Tcl_UnsetObjRef(obj) \ + if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } +#define Tcl_InitObjRef(obj, val) \ + obj = val; if (obj) { Tcl_IncrRefCount(obj); } +#define Tcl_SetObjRef(obj, val) \ +if (1) { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + Tcl_InitObjRef(obj, nval); \ + if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ + } \ +} + +/* * Structure containing the fields used in [clock format] and [clock scan] */ @@ -79,6 +97,7 @@ typedef struct TclDateFields { typedef struct DateInfo { const char *dateStart; const char *dateInput; + const char *dateEnd; TclDateFields date; @@ -110,6 +129,8 @@ typedef struct DateInfo { time_t dateDigitCount; + time_t dateCentury; + Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ } DateInfo; @@ -157,6 +178,9 @@ ClockInitDateInfo(DateInfo *info) { #define CLF_STRICT (1 << 8) typedef struct ClockFmtScnCmdArgs { + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj; /* Format */ Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ @@ -233,6 +257,7 @@ typedef struct ClockScanToken ClockScanToken; typedef int ClockScanTokenProc( + ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok); @@ -241,10 +266,11 @@ typedef int ClockScanTokenProc( #define CLF_JULIANDAY (1 << 3) #define CLF_TIME (1 << 4) #define CLF_LOCALSEC (1 << 5) +#define CLF_CENTURY (1 << 6) #define CLF_SIGNED (1 << 8) typedef enum _CLCKTOK_TYPE { - CTOKT_DIGIT = 1, CTOKT_SPACE, CTOKT_WORD + CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD } CLCKTOK_TYPE; typedef struct ClockFmtScnStorage ClockFmtScnStorage; @@ -260,6 +286,7 @@ typedef struct ClockScanTokenMap { unsigned short int maxSize; unsigned short int offs; ClockScanTokenProc *parser; + void *data; } ClockScanTokenMap; typedef struct ClockScanToken { @@ -271,6 +298,9 @@ typedef struct ClockScanToken { } tokWord; } ClockScanToken; +#define ClockScnTokenChar(tok) \ + *tok->tokWord.start; + typedef struct ClockFmtScnStorage { int objRefCount; /* Reference count shared across threads */ ClockScanToken *scnTok; diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 928474d..7f23568 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5- +package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.6.0 @@ -225,6 +225,56 @@ proc msgcat::mc {src args} { } } +# msgcat::mcget -- +# +# Find the translation for the given string based on the given +# locale setting. Check the given namespace first, then look in each +# parent namespace until the source is found. If additional args are +# specified, use the format command to work them into the traslated +# string. +# If no catalog item is found, mcunknown is called in the caller frame +# and its result is returned. +# +# Arguments: +# src The string to translate. +# args Args to pass to the format command +# +# Results: +# Returns the translated string. Propagates errors thrown by the +# format command. + +proc msgcat::mcget {ns loc src args} { + variable Msgs + + if {$loc eq {C}} { + set loclist [PackagePreferences $ns] + } else { + variable PackageConfig + # if {![dict exists $PackageConfig $ns $loc]} { + # set loc [mclocale] + # } + set loclist [dict get $PackageConfig locales $ns $loc] + } + for {set nscur $ns} {$nscur != ""} {set nscur [namespace parent $nscur]} { + foreach loc $loclist { + if {[dict exists $Msgs $nscur $loc $src]} { + if {[llength $args]} { + return [format [dict get $Msgs $nscur $loc $src] {*}$args] + } else { + return [dict get $Msgs $nscur $loc $src] + } + } + } + } + # call package local or default unknown command + set args [linsert $args 0 $loclist $src] + switch -exact -- [Invoke unknowncmd $args $ns result 1] { + 0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] } + 1 { return [DefaultUnknown {*}$args] } + default { return $result } + } +} + # msgcat::mcexists -- # # Check if a catalog item is set or if mc would invoke mcunknown. @@ -488,6 +538,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { set loclist [GetPreferences $locale] set locale [lindex $loclist 0] dict set PackageConfig loclist $ns $loclist + dict set PackageConfig locales $ns $locale $loclist # load eventual missing locales set loadedLocales [dict get $PackageConfig loadedlocales $ns] @@ -521,6 +572,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { [dict get $PackageConfig loadedlocales $ns] $LoadedLocales] dict unset PackageConfig loadedlocales $ns dict unset PackageConfig loclist $ns + dict unset PackageConfig locales $ns # unset keys not in global loaded locales if {[dict exists $Msgs $ns]} { diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 9267684..fd24068 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -121,10 +121,17 @@ proc test-scan {{reptime 1000}} { # Scan : julian day with time (greedy match): {clock scan "2451545 102030" -format "%J%H%M%S"} + # Scan : century, lookup table month + {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} + # Scan : century, lookup table month and day + {clock scan {1970 Jan 02} -format {%C%y %b %Od} -locale en -gmt 1} + + break + # Scan : zone only {clock scan "CET" -format "%z"} {clock scan "EST" -format "%z"} - #{**STOP** : Wed Nov 25 01:00:00 CET 2015} + {**STOP** : Wed Nov 25 01:00:00 CET 2015} # # Scan : long format test (allock chain) # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} @@ -194,8 +201,8 @@ proc test-other {{reptime 1000}} { proc test {{reptime 1000}} { puts "" - #test-scan $reptime - test-freescan $reptime + test-scan $reptime + #test-freescan $reptime test-other $reptime puts \n**OK** -- cgit v0.12 From 7b6cd1089c2d3a6eeb8f12b106af40c18017c8f3 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:25:20 +0000 Subject: l10n (with caching) implemented, msgcat package optimized, code review, etc. --- generic/tclClock.c | 448 +++++++++++++++++++++++++++++----------------- generic/tclClockFmt.c | 193 +++++++++++--------- generic/tclDate.h | 45 ++++- library/clock.tcl | 79 +++++--- library/msgcat/msgcat.tcl | 113 +++++++++--- tests-perf/clock.perf.tcl | 31 +++- tests/clock.test | 8 +- 7 files changed, 608 insertions(+), 309 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1e9abba..166a4b3 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -59,8 +59,7 @@ typedef enum ClockLiteral { LIT_TZDATA, LIT_GETSYSTEMTIMEZONE, LIT_SETUPTIMEZONE, - LIT_GETSYSTEMLOCALE, - LIT_SETUPLOCALE, + LIT_MCGET, LIT_TCL_CLOCK, #if 0 LIT_FREESCAN, #endif @@ -83,13 +82,17 @@ static const char *const Literals[] = { "::tcl::clock::TZData", "::tcl::clock::GetSystemTimeZone", "::tcl::clock::SetupTimeZone", - "::tcl::clock::mclocale", - "::tcl::clock::EnterLocale", + "::msgcat::mcget", "::tcl::clock" #if 0 "::tcl::clock::FreeScan" #endif }; +/* Msgcat literals for exact match (mcKey) */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, ""); +/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); + static const char *const eras[] = { "CE", "BCE", NULL }; /* @@ -257,9 +260,10 @@ 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); - Tcl_IncrRefCount(data->literals[i]); + Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); } + data->mcLiterals = NULL; + data->mcLitIdxs = NULL; data->LastTZEpoch = 0; data->currentYearCentury = ClockDefaultYearCentury; data->yearOfCenturySwitch = ClockDefaultCenturySwitch; @@ -273,6 +277,12 @@ TclClockInit( data->LastSetupTimeZone = NULL; data->LastSetupTZData = NULL; + data->CurrentLocale = NULL; + data->CurrentLocaleDict = NULL; + data->LastUnnormUsedLocale = NULL; + data->LastUsedLocale = NULL; + data->LastUsedLocaleDict = NULL; + data->lastBase.timezoneObj = NULL; data->UTC2Local.timezoneObj = NULL; data->UTC2Local.tzName = NULL; @@ -323,6 +333,12 @@ ClockConfigureClear( Tcl_UnsetObjRef(data->LastSetupTimeZone); Tcl_UnsetObjRef(data->LastSetupTZData); + Tcl_UnsetObjRef(data->CurrentLocale); + Tcl_UnsetObjRef(data->CurrentLocaleDict); + Tcl_UnsetObjRef(data->LastUnnormUsedLocale); + Tcl_UnsetObjRef(data->LastUsedLocale); + Tcl_UnsetObjRef(data->LastUsedLocaleDict); + Tcl_UnsetObjRef(data->lastBase.timezoneObj); Tcl_UnsetObjRef(data->UTC2Local.timezoneObj); Tcl_UnsetObjRef(data->UTC2Local.tzName); @@ -341,6 +357,18 @@ ClockDeleteCmdProc( for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } + if (data->mcLiterals != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLiterals[i]); + } + data->mcLiterals = NULL; + } + if (data->mcLitIdxs != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLitIdxs[i]); + } + data->mcLitIdxs = NULL; + } ClockConfigureClear(data); @@ -355,9 +383,9 @@ ClockDeleteCmdProc( inline Tcl_Obj * NormTimezoneObj( ClockClientData *dataPtr, /* Client data containing literal pool */ - Tcl_Obj * timezoneObj) + Tcl_Obj *timezoneObj) { - const char * tz; + const char *tz; if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone && dataPtr->LastSetupTimeZone != NULL ) { @@ -399,6 +427,208 @@ NormTimezoneObj( /* *---------------------------------------------------------------------- */ +static Tcl_Obj * +NormLocaleObj( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Obj *localeObj, + Tcl_Obj **mcDictObj) +{ + const char *loc; + if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale + || localeObj == dataPtr->literals[LIT_C] + ) { + *mcDictObj = dataPtr->CurrentLocaleDict; + return dataPtr->CurrentLocale; + } + if ( localeObj == dataPtr->LastUsedLocale + || localeObj == dataPtr->LastUnnormUsedLocale + ) { + *mcDictObj = dataPtr->LastUsedLocaleDict; + return dataPtr->LastUsedLocale; + } + + loc = TclGetString(localeObj); + if (dataPtr->CurrentLocale != NULL && + (localeObj == dataPtr->CurrentLocale + || strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0 + ) + ) { + *mcDictObj = dataPtr->CurrentLocaleDict; + localeObj = dataPtr->CurrentLocale; + } + else + if (dataPtr->LastUsedLocale != NULL && + (localeObj == dataPtr->LastUsedLocale + || strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0 + ) + ) { + *mcDictObj = dataPtr->LastUsedLocaleDict; + Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj); + localeObj = dataPtr->LastUsedLocale; + } + else + if ( + strcmp(loc, Literals[LIT_C]) == 0 + ) { + *mcDictObj = dataPtr->CurrentLocaleDict; + localeObj = dataPtr->CurrentLocale; + } + else + { + *mcDictObj = NULL; + } + return localeObj; +} + +/* + *---------------------------------------------------------------------- + */ +MODULE_SCOPE Tcl_Obj * +ClockMCDict(ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *callargs[3]; + + /* if dict not yet retrieved */ + if (opts->mcDictObj == NULL) { + + /* if locale was not yet used */ + if ( !(opts->flags & CLF_LOCALE_USED) ) { + + opts->localeObj = NormLocaleObj(opts->clientData, + opts->localeObj, &opts->mcDictObj); + + if (opts->localeObj == NULL) { + Tcl_SetResult(opts->interp, + "locale not specified and no default locale set", TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL); + return NULL; + } + opts->flags |= CLF_LOCALE_USED; + + /* check locale literals already available (on demand creation) */ + if (dataPtr->mcLiterals == NULL) { + int i; + dataPtr->mcLiterals = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < MCLIT__END; ++i) { + Tcl_InitObjRef(dataPtr->mcLiterals[i], + Tcl_NewStringObj(MsgCtLiterals[i], -1)); + } + } + } + + if (opts->mcDictObj == NULL) { + /* get msgcat dictionary - ::msgcat::mcget ::tcl::clock locale */ + callargs[0] = dataPtr->literals[LIT_MCGET]; + callargs[1] = dataPtr->literals[LIT_TCL_CLOCK]; + callargs[2] = opts->localeObj; + + if (Tcl_EvalObjv(opts->interp, 3, callargs, 0) != TCL_OK) { + return NULL; + } + + opts->mcDictObj = Tcl_GetObjResult(opts->interp); + if ( opts->localeObj == dataPtr->CurrentLocale ) { + Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj); + } else { + Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj); + Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale); + Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj); + } + } + } + + return opts->mcDictObj; +} + +MODULE_SCOPE Tcl_Obj * +ClockMCGet( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + ClockClientData *dataPtr = opts->clientData; + + Tcl_Obj *valObj = NULL; + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + Tcl_DictObjGet(opts->interp, opts->mcDictObj, + dataPtr->mcLiterals[mcKey], &valObj); + + return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */ +} + +MODULE_SCOPE Tcl_Obj * +ClockMCGetListIdxDict( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + ClockClientData *dataPtr = opts->clientData; + + Tcl_Obj *valObj = NULL; + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to get indices dictionray, + * if not available - create from list */ + + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK + ) { + Tcl_Obj **lstv, *intObj; + int i, lstc; + + if (dataPtr->mcLitIdxs == NULL) { + dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < MCLIT__END; ++i) { + Tcl_InitObjRef(dataPtr->mcLitIdxs[i], + Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); + } + } + + if (Tcl_DictObjGet(opts->interp, opts->mcDictObj, + dataPtr->mcLiterals[mcKey], &valObj) != TCL_OK) { + return NULL; + }; + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + return NULL; + }; + + valObj = Tcl_NewDictObj(); + for (i = 0; i < lstc; i++) { + intObj = Tcl_NewIntObj(i); + if (Tcl_DictObjPut(opts->interp, valObj, + lstv[i], intObj) != TCL_OK + ) { + Tcl_DecrRefCount(valObj); + Tcl_DecrRefCount(intObj); + return NULL; + } + }; + + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + dataPtr->mcLitIdxs[mcKey], valObj) != TCL_OK + ) { + Tcl_DecrRefCount(valObj); + return NULL; + } + }; + + return valObj; +} + +/* + *---------------------------------------------------------------------- + */ static int ClockConfigureObjCmd( ClientData clientData, /* Client data containing literal pool */ @@ -410,23 +640,25 @@ ClockConfigureObjCmd( Tcl_Obj **litPtr = dataPtr->literals; static const char *const options[] = { - "-system-tz", "-setup-tz", "-clear", + "-system-tz", "-setup-tz", "-default-locale", + "-clear", "-year-century", "-century-switch", NULL }; enum optionInd { - CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CLEAR_CACHE, + CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE, + CLOCK_CLEAR_CACHE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, 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, + for (i = 1; i < objc; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i++], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[i]), NULL); + Tcl_GetString(objv[i-1]), NULL); return TCL_ERROR; } switch (optionIndex) { @@ -434,24 +666,24 @@ ClockConfigureObjCmd( if (1) { /* validate current tz-epoch */ unsigned long lastTZEpoch = TzsetGetEpoch(); - if (i+1 < objc) { - if (dataPtr->SystemTimeZone != objv[i+1]) { - Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i+1]); + if (i < objc) { + if (dataPtr->SystemTimeZone != objv[i]) { + Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i]); Tcl_UnsetObjRef(dataPtr->SystemSetupTZData); } dataPtr->LastTZEpoch = lastTZEpoch; } - if (dataPtr->SystemTimeZone != NULL + if (i+1 >= objc && dataPtr->SystemTimeZone != NULL && dataPtr->LastTZEpoch == lastTZEpoch) { Tcl_SetObjResult(interp, dataPtr->SystemTimeZone); } } break; case CLOCK_SETUP_TZ: - if (i+1 < objc) { + if (i < objc) { /* differentiate GMT and system zones, because used often */ - Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i+1]); - Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i+1]); + Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]); + Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]); if (dataPtr->LastSetupTimeZone != timezoneObj) { Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); Tcl_UnsetObjRef(dataPtr->LastSetupTZData); @@ -463,7 +695,7 @@ ClockConfigureObjCmd( } switch (optionIndex) { case CLOCK_SETUP_GMT: - if (i+1 < objc) { + if (i < objc) { if (dataPtr->GMTSetupTimeZone != timezoneObj) { Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj); Tcl_UnsetObjRef(dataPtr->GMTSetupTZData); @@ -471,7 +703,7 @@ ClockConfigureObjCmd( } break; case CLOCK_SETUP_TZ: - if (i+1 < objc) { + if (i < objc) { if (dataPtr->AnySetupTimeZone != timezoneObj) { Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj); Tcl_UnsetObjRef(dataPtr->AnySetupTZData); @@ -480,35 +712,52 @@ ClockConfigureObjCmd( break; } } - if (dataPtr->LastSetupTimeZone != NULL) { + if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) { Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone); } break; + case CLOCK_CURRENT_LOCALE: + if (i < objc) { + if (dataPtr->CurrentLocale != objv[i]) { + Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]); + Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict); + } + } + if (i+1 >= objc && dataPtr->CurrentLocale != NULL) { + Tcl_SetObjResult(interp, dataPtr->CurrentLocale); + } + break; case CLOCK_YEAR_CENTURY: - if (i+1 < objc) { + if (i < objc) { int year; - if (TclGetIntFromObj(interp, objv[i+1], &year) != TCL_OK) { + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { return TCL_ERROR; } dataPtr->currentYearCentury = year; - Tcl_SetObjResult(interp, objv[i+1]); + if (i+1 >= objc) { + Tcl_SetObjResult(interp, objv[i]); + } continue; - } - Tcl_SetObjResult(interp, - Tcl_NewIntObj(dataPtr->currentYearCentury)); + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->currentYearCentury)); + } break; case CLOCK_CENTURY_SWITCH: - if (i+1 < objc) { + if (i < objc) { int year; - if (TclGetIntFromObj(interp, objv[i+1], &year) != TCL_OK) { + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { return TCL_ERROR; } dataPtr->yearOfCenturySwitch = year; - Tcl_SetObjResult(interp, objv[i+1]); + Tcl_SetObjResult(interp, objv[i]); continue; - } - Tcl_SetObjResult(interp, - Tcl_NewIntObj(dataPtr->yearOfCenturySwitch)); + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->yearOfCenturySwitch)); + } break; case CLOCK_CLEAR_CACHE: ClockConfigureClear(dataPtr); @@ -597,7 +846,7 @@ ClockGetSystemTimeZone( } Tcl_UnsetObjRef(dataPtr->SystemTimeZone); - Tcl_UnsetObjRef(data->SystemSetupTZData); + Tcl_UnsetObjRef(dataPtr->SystemSetupTZData); literals = dataPtr->literals; @@ -683,125 +932,6 @@ ClockFormatNumericTimeZone(int z) { } return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); } - -/* - *---------------------------------------------------------------------- - */ -inline Tcl_Obj * -NormLocaleObj( - ClockClientData *dataPtr, /* Client data containing literal pool */ - Tcl_Obj *localeObj) -{ - const char * tz; - if ( localeObj == dataPtr->LastUnnormSetupLocale - && dataPtr->LastSetupLocale != NULL - ) { - return dataPtr->LastSetupLocale; - } - if ( localeObj == dataPtr->LastSetupLocale - || localeObj == dataPtr->literals[LIT_CLOCALE] - || localeObj == dataPtr->SystemLocale - || localeObj == dataPtr->AnySetupLocale - ) { - return localeObj; - } - - tz = TclGetString(localeObj); - if (dataPtr->AnySetupLocale != NULL && - (localeObj == dataPtr->AnySetupLocale - || strcmp(tz, TclGetString(dataPtr->AnySetupLocale)) == 0 - ) - ) { - localeObj = dataPtr->AnySetupLocale; - } - else - if (dataPtr->SystemLocale != NULL && - (localeObj == dataPtr->SystemLocale - || strcmp(tz, TclGetString(dataPtr->SystemLocale)) == 0 - ) - ) { - localeObj = dataPtr->SystemLocale; - } - else - if ( - strcmp(tz, Literals[LIT_GMT]) == 0 - ) { - localeObj = dataPtr->literals[LIT_GMT]; - } - return localeObj; -} -/* - *---------------------------------------------------------------------- - */ -static Tcl_Obj * -ClockGetSystemLocale( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp) /* Tcl interpreter */ -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals; - - /* if known (cached) - return now */ - if (dataPtr->SystemLocale != NULL) { - return dataPtr->SystemLocale; - } - - literals = dataPtr->literals; - - if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) { - return NULL; - } - Tcl_SetObjRef(dataPtr->SystemLocale, Tcl_GetObjResult(interp)); - return dataPtr->SystemLocale; -} -/* - *---------------------------------------------------------------------- - */ -static Tcl_Obj * -ClockSetupLocale( - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *localeObj) -{ - ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; - Tcl_Obj *callargs[2]; - - if (localeObj == NULL || localeObj == dataPtr->SystemLocale) { - if (dataPtr->SystemLocale == NULL) { - return ClockGetSystemLocale(clientData, interp); - } - return dataPtr->SystemLocale; - } - -#if 0 - /* if cached (if already setup this one) */ - if ( dataPtr->LastSetupTimeZone != NULL - && ( localeObj == dataPtr->LastSetupTimeZone - || timezoneObj == dataPtr->LastUnnormSetupTimeZone - ) - ) { - return dataPtr->LastSetupTimeZone; - } - - /* differentiate GMT and system zones, because used often and already set */ - timezoneObj = NormTimezoneObj(dataPtr, timezoneObj); - if ( timezoneObj == dataPtr->GMTSetupTimeZone - || timezoneObj == dataPtr->SystemTimeZone - || timezoneObj == dataPtr->AnySetupTimeZone - ) { - return timezoneObj; - } - -#endif - callargs[0] = literals[LIT_SETUPLOCALE]; - callargs[1] = localeObj; - - if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { - return localeObj; // dataPtr->CurrentLocale; - } - return NULL; -} /* *---------------------------------------------------------------------- * @@ -2741,19 +2871,13 @@ ClockScanObjCmd( } } - /* Setup timezone and locale */ + /* Setup timezone (normalize object id needed and load TZ on demand) */ opts.timezoneObj = ClockSetupTimeZone(clientData, interp, opts.timezoneObj); if (opts.timezoneObj == NULL) { return TCL_ERROR; } - opts.localeObj = ClockSetupLocale(clientData, interp, opts.localeObj); - if (opts.localeObj == NULL) { - return TCL_ERROR; - } - - ClockInitDateInfo(info); yydate.tzName = NULL; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 17181d9..a3c7f20 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -454,45 +454,55 @@ Tcl_GetClockFrmScnFromObj( return fss; } - + +/* + * DetermineGreedySearchLen -- + * + * Determine min/max lengths as exact as possible (speed, greedy match) + * + */ +inline +void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok, int *minLen, int *maxLen) +{ + register const char*p = yyInput; + *minLen = 0; + *maxLen = info->dateEnd - p; + + /* if no tokens anymore */ + if (!(tok+1)->map) { + /* should match to end or first space */ + while (!isspace(UCHAR(*p)) && ++p < info->dateEnd) {}; + *minLen = p - yyInput; + } +} static int LocaleListSearch(ClockFmtScnCmdArgs *opts, - DateInfo *info, const char * mcKey, int *val) + DateInfo *info, int mcKey, int *val, + int minLen, int maxLen) { - Tcl_Obj *callargs[4] = {NULL, NULL, NULL, NULL}, **lstv; - int i, lstc; - Tcl_Obj *valObj = NULL; - int ret = TCL_RETURN; + Tcl_Obj **lstv; + int lstc, i, l; + const char *s; + Tcl_Obj *valObj; /* get msgcat value */ - TclNewLiteralStringObj(callargs[0], "::msgcat::mcget"); - TclNewLiteralStringObj(callargs[1], "::tcl::clock"); - callargs[2] = opts->localeObj; - if (opts->localeObj == NULL) { - TclNewLiteralStringObj(callargs[1], "c"); - } - callargs[3] = Tcl_NewStringObj(mcKey, -1); - - for (i = 0; i < 4; i++) { - Tcl_IncrRefCount(callargs[i]); - } - if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK) { - goto done; + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + return TCL_ERROR; } - Tcl_InitObjRef(valObj, Tcl_GetObjResult(opts->interp)); - /* is a list */ if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { - goto done; + return TCL_ERROR; } /* search in list */ for (i = 0; i < lstc; i++) { - const char *s = TclGetString(lstv[i]); - int l = lstv[i]->length; - if ( l <= info->dateEnd - yyInput + s = TclGetString(lstv[i]); + l = lstv[i]->length; + if ( l >= minLen && l <= maxLen && strncasecmp(yyInput, s, l) == 0 ) { *val = i; @@ -501,21 +511,11 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } } - ret = TCL_OK; /* if not found */ - if (i >= lstc) { - ret = TCL_ERROR; - } - -done: - - Tcl_UnsetObjRef(valObj); - - for (i = 0; i < 4; i++) { - Tcl_UnsetObjRef(callargs[i]); + if (i < lstc) { + return TCL_OK; } - - return ret; + return TCL_RETURN; } static int @@ -535,12 +535,34 @@ StaticListSearch(ClockFmtScnCmdArgs *opts, } s++; } - if (*s == NULL) { - return TCL_ERROR; + if (*s != NULL) { + return TCL_OK; } - - return TCL_OK; -}; + return TCL_RETURN; +} + +inline const char * +FindWordEnd( + ClockScanToken *tok, + register const char * p, const char * end) +{ + register const char *x = tok->tokWord.start; + if (x == tok->tokWord.end) { /* single char word */ + if (*p != *x) { + /* no match -> error */ + return NULL; + } + return ++p; + } + /* multi-char word */ + while (*p++ == *x++) { + if (x >= tok->tokWord.end || p >= end) { + /* no match -> error */ + return NULL; + } + }; + return p; +} static int ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, @@ -560,19 +582,26 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, }; int val; if (StaticListSearch(opts, info, months, &val) != TCL_OK) { - return TCL_ERROR; + return TCL_RETURN; } yyMonth = (val % 12) + 1; return TCL_OK; */ - int val; - int ret = LocaleListSearch(opts, info, "MONTHS_FULL", &val); + int ret, val; + int minLen; + int maxLen; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + ret = LocaleListSearch(opts, info, MCLIT_MONTHS_FULL, &val, + minLen, maxLen); if (ret != TCL_OK) { + /* if not found */ if (ret == TCL_RETURN) { - return ret; + ret = LocaleListSearch(opts, info, MCLIT_MONTHS_ABBREV, &val, + minLen, maxLen); } - ret = LocaleListSearch(opts, info, "MONTHS_ABBREV", &val); if (ret != TCL_OK) { return ret; } @@ -588,9 +617,14 @@ static int ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { - int val; + int ret, val; + int minLen; + int maxLen; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); - int ret = LocaleListSearch(opts, info, (char *)tok->map->data, &val); + ret = LocaleListSearch(opts, info, (int)tok->map->data, &val, + minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -639,8 +673,8 @@ static ClockScanTokenMap ScnSTokenMap[] = { NULL}, }; static const char *ScnSTokenWrapMapIndex[2] = { - "eBh", - "dbb" + "eNBh", + "dmbb" }; static const char *ScnETokenMapIndex = @@ -654,11 +688,14 @@ static const char *ScnETokenWrapMapIndex[2] = { }; static const char *ScnOTokenMapIndex = - "d"; + "dm"; static ClockScanTokenMap ScnOTokenMap[] = { /* %Od %Oe */ {CTOKT_PARSER, CLF_DATE, 0, 0, TclOffset(DateInfo, date.dayOfMonth), - ClockScnToken_LocaleListMatcher_Proc, "LOCALE_NUMERALS"}, + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CTOKT_PARSER, CLF_DATE, 0, 0, TclOffset(DateInfo, date.month), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *ScnOTokenWrapMapIndex[2] = { "e", @@ -730,7 +767,7 @@ ClockGetOrParseScanFormat( switch (*p) { case '%': if (1) { - ClockScanTokenMap * maps = ScnSTokenMap; + ClockScanTokenMap * scnMap = ScnSTokenMap; const char *mapIndex = ScnSTokenMapIndex, **wrapIndex = ScnSTokenWrapMapIndex; if (p+1 >= e) { @@ -748,13 +785,13 @@ ClockGetOrParseScanFormat( continue; break; case 'E': - maps = ScnETokenMap, + scnMap = ScnETokenMap, mapIndex = ScnETokenMapIndex, wrapIndex = ScnETokenWrapMapIndex; p++; break; case 'O': - maps = ScnOTokenMap, + scnMap = ScnOTokenMap, mapIndex = ScnOTokenMapIndex, wrapIndex = ScnOTokenWrapMapIndex; p++; @@ -778,7 +815,7 @@ ClockGetOrParseScanFormat( goto word_tok; } } - tok->map = &ScnSTokenMap[cp - mapIndex]; + tok->map = &scnMap[cp - mapIndex]; tok->tokWord.start = p; /* calculate look ahead value by standing together tokens */ if (tok > fss->scnTok) { @@ -928,7 +965,7 @@ ClockScan( size = p - yyInput; if (size < map->minSize) { /* missing input -> error */ - goto error; + goto not_match; } /* string 2 number, put number into info structure by offset */ p = yyInput; x = p + size; @@ -953,10 +990,10 @@ ClockScan( case TCL_OK: break; case TCL_RETURN: - goto done; + goto not_match; break; default: - goto error; + goto done; break; }; p = yyInput; @@ -967,7 +1004,7 @@ ClockScan( if (opts->flags & CLF_STRICT) { if (!isspace(UCHAR(*p))) { /* unmatched -> error */ - goto error; + goto not_match; } p++; } @@ -976,21 +1013,13 @@ ClockScan( } break; case CTOKT_WORD: - x = tok->tokWord.start; - if (x == tok->tokWord.end) { /* single char word */ - if (*p != *x) { - /* no match -> error */ - goto error; - } - p++; - continue; - } - /* multi-char word */ - while (p < end && x < tok->tokWord.end && *p++ == *x++) {}; - if (x < tok->tokWord.end) { + x = FindWordEnd(tok, p, end); + if (!x) { /* no match -> error */ - goto error; + goto not_match; } + p = x; + continue; break; } } @@ -1002,7 +1031,7 @@ ClockScan( /* check end was reached */ if (p < end) { /* something after last token - wrong format */ - goto error; + goto not_match; } /* invalidate result */ @@ -1045,15 +1074,15 @@ ClockScan( overflow: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "integervalueTooLarge", NULL); + Tcl_SetResult(interp, "requested date too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); goto done; -error: +not_match: - Tcl_SetResult(interp, - "input string does not match supplied format", TCL_STATIC); + Tcl_SetResult(interp, "input string does not match supplied format", + TCL_STATIC); Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); done: diff --git a/generic/tclDate.h b/generic/tclDate.h index d97cd3c..1c51a02 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -35,6 +35,22 @@ #define CLF_INVALIDATE_JULIANDAY (1 << 7) /* assemble julianDay using year, month, etc. */ #define CLF_INVALIDATE_SECONDS (1 << 8) /* assemble localSeconds (and seconds at end) */ + +/* + * Enumeration of the msgcat literals used in [clock] + */ + +typedef enum ClockMsgCtLiteral { + MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, + MCLIT_LOCALE_NUMERALS, + MCLIT__END +} ClockMsgCtLiteral; + +#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", \ + pref "LOCALE_NUMERALS", \ +} + /* * Primitives to safe set, reset and free references. */ @@ -176,16 +192,19 @@ ClockInitDateInfo(DateInfo *info) { #define CLF_EXTENDED (1 << 4) #define CLF_STRICT (1 << 8) +#define CLF_LOCALE_USED (1 << 15) typedef struct ClockFmtScnCmdArgs { - ClientData clientData, /* Opaque pointer to literal pool, etc. */ - Tcl_Interp *interp, /* Tcl interpreter */ + ClientData clientData; /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp; /* Tcl interpreter */ Tcl_Obj *formatObj; /* Format */ Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ Tcl_Obj *baseObj; /* Base (scan only) */ int flags; /* Flags control scanning */ + + Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/ } ClockFmtScnCmdArgs; /* @@ -194,7 +213,11 @@ typedef struct ClockFmtScnCmdArgs { typedef struct ClockClientData { int refCount; /* Number of live references. */ - Tcl_Obj **literals; /* Pool of object literals. */ + Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */ + Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */ + Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_, + * used for quick dictionary search */ + /* Cache for current clock parameters, imparted via "configure" */ unsigned long LastTZEpoch; int currentYearCentury; @@ -208,6 +231,13 @@ typedef struct ClockClientData { Tcl_Obj *LastUnnormSetupTimeZone; Tcl_Obj *LastSetupTimeZone; Tcl_Obj *LastSetupTZData; + + Tcl_Obj *CurrentLocale; + Tcl_Obj *CurrentLocaleDict; + Tcl_Obj *LastUnnormUsedLocale; + Tcl_Obj *LastUsedLocale; + Tcl_Obj *LastUsedLocaleDict; + /* Cache for last base (last-second fast convert if base/tz not changed) */ struct { Tcl_Obj *timezoneObj; @@ -328,6 +358,15 @@ MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); +/* tclClock.c module declarations */ + +MODULE_SCOPE Tcl_Obj * + ClockMCDict(ClockFmtScnCmdArgs *opts); +MODULE_SCOPE Tcl_Obj * + ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE Tcl_Obj * + ClockMCGetListIdxDict(ClockFmtScnCmdArgs *opts, int mcKey); + /* tclClockFmt.c module declarations */ MODULE_SCOPE ClockFmtScnStorage * diff --git a/library/clock.tcl b/library/clock.tcl index ebbecb9..b4632b1 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -289,8 +289,9 @@ proc ::tcl::clock::Initialize {} { # Default configuration - # configure -year-century 2000 \ - # -century-switch 38 + configure -default-locale [mclocale] + #configure -year-century 2000 \ + # -century-switch 38 # Translation table to map Windows TZI onto cities, so that the Olson # rules can apply. In some cases the mapping is ambiguous, so it's wise @@ -2105,6 +2106,51 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } { #---------------------------------------------------------------------- # +# GetSystemTimeZone -- +# +# Determines the system time zone, which is the default for the +# 'clock' command if no other zone is supplied. +# +# Parameters: +# None. +# +# Results: +# Returns the system time zone. +# +# Side effects: +# Stores the sustem time zone in engine configuration, since +# determining it may be an expensive process. +# +#---------------------------------------------------------------------- + +proc ::tcl::clock::GetSystemLocale {} { + if { $::tcl_platform(platform) ne {windows} } { + # On a non-windows platform, the 'system' locale is the same as + # the 'current' locale + + return [mclocale] + } + + # On a windows platform, the 'system' locale is adapted from the + # 'current' locale by applying the date and time formats from the + # Control Panel. First, load the 'current' locale if it's not yet + # loaded + + mcpackagelocale set [mclocale] + + # Make a new locale string for the system locale, and get the + # Control Panel information + + set locale [mclocale]_windows + if { ! [mcpackagelocale present $locale] } { + LoadWindowsDateTimeFormats $locale + } + + return $locale +} + +#---------------------------------------------------------------------- +# # EnterLocale -- # # Switch [mclocale] to a given locale if necessary @@ -2121,33 +2167,12 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } { #---------------------------------------------------------------------- proc ::tcl::clock::EnterLocale { locale } { - if { $locale eq {system} } { - if { $::tcl_platform(platform) ne {windows} } { - # On a non-windows platform, the 'system' locale is the same as - # the 'current' locale - - set locale current - } else { - # On a windows platform, the 'system' locale is adapted from the - # 'current' locale by applying the date and time formats from the - # Control Panel. First, load the 'current' locale if it's not yet - # loaded - - mcpackagelocale set [mclocale] - - # Make a new locale string for the system locale, and get the - # Control Panel information - - set locale [mclocale]_windows - if { ! [mcpackagelocale present $locale] } { - LoadWindowsDateTimeFormats $locale - } - } - } - if { $locale eq {current}} { + switch -- $locale system { + set locale [GetSystemLocale] + } current { set locale [mclocale] } - # Eventually load the locale + # Select the locale, eventually load it mcpackagelocale set $locale } diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 7f23568..3fd2cdb 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -227,52 +227,61 @@ proc msgcat::mc {src args} { # msgcat::mcget -- # -# Find the translation for the given string based on the given -# locale setting. Check the given namespace first, then look in each -# parent namespace until the source is found. If additional args are -# specified, use the format command to work them into the traslated -# string. -# If no catalog item is found, mcunknown is called in the caller frame -# and its result is returned. +# Return the translation for the given string based on the given +# locale setting or the whole dictionary object of the package/locale. +# Searching of catalog is similar to "msgcat::mc". +# +# Contrary to "msgcat::mc" may additionally load a package catalog +# on demand. # # Arguments: -# src The string to translate. -# args Args to pass to the format command +# ns The package namespace (as catalog selector). +# loc The locale used for translation. +# {src} The string to translate. +# {args} Args to pass to the format command # # Results: # Returns the translated string. Propagates errors thrown by the # format command. -proc msgcat::mcget {ns loc src args} { +proc msgcat::mcget {ns loc args} { variable Msgs if {$loc eq {C}} { set loclist [PackagePreferences $ns] + set loc [lindex $loclist 0] } else { + set loc [string tolower $loc] variable PackageConfig - # if {![dict exists $PackageConfig $ns $loc]} { - # set loc [mclocale] - # } - set loclist [dict get $PackageConfig locales $ns $loc] + # get locales list for given locale (de_de -> {de_de de {}}) + if {[catch { + set loclist [dict get $PackageConfig locales $ns $loc] + }]} { + # lazy load catalog on demand + mcpackagelocale load $loc $ns + set loclist [dict get $PackageConfig locales $ns $loc] + } } + if {![llength $args]} { + # get whole catalog: + return [msgcat::Merge $ns $loclist] + } + set src [lindex $args 0] + # search translation for each locale (regarding parent namespaces) for {set nscur $ns} {$nscur != ""} {set nscur [namespace parent $nscur]} { foreach loc $loclist { if {[dict exists $Msgs $nscur $loc $src]} { - if {[llength $args]} { - return [format [dict get $Msgs $nscur $loc $src] {*}$args] + if {[llength $args] > 1} { + return [format [dict get $Msgs $nscur $loc $src] \ + {*}[lrange $args 1 end]] } else { return [dict get $Msgs $nscur $loc $src] } } } } - # call package local or default unknown command - set args [linsert $args 0 $loclist $src] - switch -exact -- [Invoke unknowncmd $args $ns result 1] { - 0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] } - 1 { return [DefaultUnknown {*}$args] } - default { return $result } - } + # get with package default locale + mcget $ns [lindex $loclist 0] {*}$args } # msgcat::mcexists -- @@ -465,6 +474,10 @@ proc msgcat::mcloadedlocales {subcommand} { # items, if the former locale was the default locale. # Returns the normalized set locale. # The default locale is taken, if locale is not given. +# load +# Load a package locale without set it (lazy loading from mcget). +# Returns the normalized set locale. +# The default locale is taken, if locale is not given. # get # Get the locale valid for this package. # isset @@ -492,7 +505,7 @@ proc msgcat::mcloadedlocales {subcommand} { # Results: # Empty string, if not stated differently for the subcommand -proc msgcat::mcpackagelocale {subcommand {locale ""}} { +proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} { # todo: implement using an ensemble variable Loclist variable LoadedLocales @@ -512,7 +525,9 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { } set locale [string tolower $locale] } - set ns [uplevel 1 {::namespace current}] + if {$ns eq ""} { + set ns [uplevel 1 {::namespace current}] + } switch -exact -- $subcommand { get { return [lindex [PackagePreferences $ns] 0] } @@ -520,7 +535,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { loaded { return [PackageLocales $ns] } present { return [expr {$locale in [PackageLocales $ns]} ]} isset { return [dict exists $PackageConfig loclist $ns] } - set { # set a package locale or add a package locale + set - load { # set a package locale or add a package locale # Copy the default locale if no package locale set so far if {![dict exists $PackageConfig loclist $ns]} { @@ -530,18 +545,21 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} { # Check if changed set loclist [dict get $PackageConfig loclist $ns] - if {! [info exists locale] || $locale eq [lindex $loclist 0] } { + if {[llength [info level 0]] == 2 || $locale eq [lindex $loclist 0] } { return [lindex $loclist 0] } # Change loclist set loclist [GetPreferences $locale] set locale [lindex $loclist 0] - dict set PackageConfig loclist $ns $loclist - dict set PackageConfig locales $ns $locale $loclist + if {$subcommand eq {set}} { + # set loclist + dict set PackageConfig loclist $ns $loclist + } # load eventual missing locales set loadedLocales [dict get $PackageConfig loadedlocales $ns] + dict set PackageConfig locales $ns $locale $loclist if {$locale in $loadedLocales} { return $locale } set loadLocales [ListComplement $loadedLocales $loclist] dict set PackageConfig loadedlocales $ns\ @@ -899,6 +917,39 @@ proc msgcat::Load {ns locales {callbackonly 0}} { return $x } +# msgcat::Merge -- +# +# Merge message catalog dictionaries to one dictionary. +# +# Arguments: +# ns Namespace (equal package) to load the message catalog. +# locales List of locales to merge. +# +# Results: +# Returns the merged dictionary of message catalogs. +proc msgcat::Merge {ns locales} { + variable Merged + if {![catch { + set mrgcat [dict get $Merged $ns [set loc [lindex $locales 0]]] + }]} { + return $mrgcat + } + variable Msgs + # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en): + if {[llength $locales] > 1} { + set mrgcat [msgcat::Merge $ns [lrange $locales 1 end]] + catch { + set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]] + } + } else { + catch { + set mrgcat [dict get $Msgs $ns $loc] + } + } + dict set Merged $ns $loc $mrgcat + return $mrgcat +} + # msgcat::Invoke -- # # Invoke a set of registered callbacks. @@ -971,6 +1022,7 @@ proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} { proc msgcat::mcset {locale src {dest ""}} { variable Msgs + variable Merged if {[llength [info level 0]] == 3} { ;# dest not specified set dest $src } @@ -980,6 +1032,7 @@ proc msgcat::mcset {locale src {dest ""}} { set locale [string tolower $locale] dict set Msgs $ns $locale $src $dest + dict unset Merged $ns return $dest } @@ -1019,6 +1072,7 @@ proc msgcat::mcflset {src {dest ""}} { proc msgcat::mcmset {locale pairs} { variable Msgs + variable Merged set length [llength $pairs] if {$length % 2} { @@ -1032,6 +1086,7 @@ proc msgcat::mcmset {locale pairs} { foreach {src dest} $pairs { dict set Msgs $ns $locale $src $dest } + dict unset Merged $ns return [expr {$length / 2}] } diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index fd24068..a005648 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -19,10 +19,11 @@ ## set testing defaults: set ::env(TCL_TZ) :CET -## warm-up (load clock.tcl, system zones, etc.): +## warm-up (load clock.tcl, system zones, locales, etc.): clock scan "" -gmt 1 clock scan "" clock scan "" -timezone :CET +clock scan "" -format "" -locale en ## ------------------------------------------ @@ -37,6 +38,20 @@ proc _test_get_commands {lst} { proc _test_out_total {} { upvar _ _ + if {![llength $_(ittm)]} { + puts "" + return + } + + set mintm 0x7fffffff + set maxtm 0 + set i 0 + foreach tm $_(ittm) { + if {$tm > $maxtm} {set maxtm $tm; set maxi $i} + if {$tm < $mintm} {set mintm $tm; set mini $i} + incr i + } + puts [string repeat ** 40] puts [format "Total %d cases in %.2f sec.:" [llength $_(itcnt)] [expr {[llength $_(itcnt)] * $_(reptime) / 1000.0}]] lset _(m) 0 [format %.6f [expr [join $_(ittm) +]]] @@ -48,6 +63,16 @@ proc _test_out_total {} { lset _(m) 2 [expr {[lindex $_(m) 2] / [llength $_(itcnt)]}] lset _(m) 4 [expr {[lindex $_(m) 2] * (1000 / $_(reptime))}] puts $_(m) + puts "Min:" + lset _(m) 0 [lindex $_(ittm) $mini] + lset _(m) 2 [lindex $_(itcnt) $mini] + lset _(m) 2 [lindex $_(itrate) $mini] + puts $_(m) + puts "Max:" + lset _(m) 0 [lindex $_(ittm) $maxi] + lset _(m) 2 [lindex $_(itcnt) $maxi] + lset _(m) 2 [lindex $_(itrate) $maxi] + puts $_(m) puts [string repeat ** 40] puts "" } @@ -123,8 +148,10 @@ proc test-scan {{reptime 1000}} { # Scan : century, lookup table month {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} - # Scan : century, lookup table month and day + # Scan : century, lookup table month and day (both entries are first) {clock scan {1970 Jan 02} -format {%C%y %b %Od} -locale en -gmt 1} + # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) + {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} break diff --git a/tests/clock.test b/tests/clock.test index 9e3dbd7..22b5bc1 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18553,12 +18553,12 @@ test clock-6.8 {input of seconds} { } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { - list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode +} {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-6.10 {input of seconds - overflow} { - list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode +} {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true -- cgit v0.12 From 5afae758b98de2da47b30d6aa4b40a5d5a604fbc Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:28:25 +0000 Subject: improve LocalizeFormat, internal caching of localized formats inside msgcat for locale and format objects smart reference introduced in dict (smart pointer with 0 object reference but increase dict-reference, provide changeable locale dict) --- generic/tclClock.c | 64 ++++++++++++++++++++++-- generic/tclClockFmt.c | 75 ++++++++++++++++++++-------- generic/tclDate.h | 10 ++-- generic/tclDictObj.c | 122 ++++++++++++++++++++++++++++++++++------------ generic/tclInt.h | 1 + library/clock.tcl | 83 ++++++++++++++++++++----------- library/init.tcl | 2 +- library/msgcat/msgcat.tcl | 3 +- 8 files changed, 269 insertions(+), 91 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 166a4b3..e066812 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -60,6 +60,7 @@ typedef enum ClockLiteral { LIT_GETSYSTEMTIMEZONE, LIT_SETUPTIMEZONE, LIT_MCGET, LIT_TCL_CLOCK, + LIT_LOCALIZE_FORMAT, #if 0 LIT_FREESCAN, #endif @@ -82,7 +83,8 @@ static const char *const Literals[] = { "::tcl::clock::TZData", "::tcl::clock::GetSystemTimeZone", "::tcl::clock::SetupTimeZone", - "::msgcat::mcget", "::tcl::clock" + "::msgcat::mcget", "::tcl::clock", + "::tcl::clock::LocalizeFormat" #if 0 "::tcl::clock::FreeScan" #endif @@ -487,7 +489,6 @@ MODULE_SCOPE Tcl_Obj * ClockMCDict(ClockFmtScnCmdArgs *opts) { ClockClientData *dataPtr = opts->clientData; - Tcl_Obj *callargs[3]; /* if dict not yet retrieved */ if (opts->mcDictObj == NULL) { @@ -518,6 +519,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) } if (opts->mcDictObj == NULL) { + Tcl_Obj *callargs[3]; /* get msgcat dictionary - ::msgcat::mcget ::tcl::clock locale */ callargs[0] = dataPtr->literals[LIT_MCGET]; callargs[1] = dataPtr->literals[LIT_TCL_CLOCK]; @@ -528,6 +530,11 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) } opts->mcDictObj = Tcl_GetObjResult(opts->interp); + /* be sure that object reference not increases (dict changeable) */ + if (opts->mcDictObj->refCount > 0) { + /* smart reference (shared dict as object with no ref-counter) */ + opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj); + } if ( opts->localeObj == dataPtr->CurrentLocale ) { Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj); } else { @@ -535,6 +542,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale); Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj); } + Tcl_ResetResult(opts->interp); } } @@ -626,6 +634,56 @@ ClockMCGetListIdxDict( return valObj; } +MODULE_SCOPE Tcl_Obj * +ClockLocalizeFormat( + ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *valObj, *keyObj; + + keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to find in cache within mc-catalog */ + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + keyObj, &valObj) != TCL_OK) { + return NULL; + } + if (valObj == NULL) { + Tcl_Obj *callargs[4]; + /* call LocalizeFormat locale format fmtkey */ + callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; + callargs[1] = opts->localeObj; + callargs[2] = opts->formatObj; + callargs[3] = keyObj; + Tcl_IncrRefCount(keyObj); + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + ) { + Tcl_DecrRefCount(keyObj); + return NULL; + } + + valObj = Tcl_GetObjResult(opts->interp); + + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + keyObj, valObj) != TCL_OK + ) { + Tcl_DecrRefCount(keyObj); + return NULL; + } + + Tcl_DecrRefCount(keyObj); + Tcl_ResetResult(opts->interp); + } + + return (opts->formatObj = valObj); +} + /* *---------------------------------------------------------------------- */ @@ -2936,7 +2994,7 @@ ClockScanObjCmd( #endif else { /* Use compiled version of Scan - */ - + ret = ClockScan(clientData, interp, info, objv[1], &opts); } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index a3c7f20..184b52a 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -308,14 +308,14 @@ Tcl_ObjType ClockFmtObjType = { #define ObjClockFmtScn(objPtr) \ (ClockFmtScnStorage *)objPtr->internalRep.twoPtrValue.ptr1; -#define SetObjLitStorage(objPtr, lit) \ - objPtr->internalRep.twoPtrValue.ptr2 = lit -#define ObjLitStorage(objPtr) \ - (ClockLitStorage *)objPtr->internalRep.twoPtrValue.ptr2; - -#define ClockFmtObj_SetObjIntRep(objPtr, fss, lit) \ - objPtr->internalRep.twoPtrValue.ptr1 = fss, \ - objPtr->internalRep.twoPtrValue.ptr2 = lit, \ +#define SetObjLocFmtKey(objPtr, key) \ + Tcl_InitObjRef((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2, key) +#define ObjLocFmtKey(objPtr) \ + ((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2) + +#define ClockFmtObj_SetObjIntRep(objPtr, fss, key) \ + objPtr->internalRep.twoPtrValue.ptr1 = fss; \ + Tcl_InitObjRef((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2, key); \ objPtr->typePtr = &ClockFmtObjType; /* @@ -327,7 +327,6 @@ ClockFmtObj_DupInternalRep(srcPtr, copyPtr) Tcl_Obj *copyPtr; { ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr); - // ClockLitStorage *lit = ObjLitStorage(srcPtr); if (fss != NULL) { Tcl_MutexLock(&ClockFmtMutex); @@ -335,7 +334,7 @@ ClockFmtObj_DupInternalRep(srcPtr, copyPtr) Tcl_MutexUnlock(&ClockFmtMutex); } - ClockFmtObj_SetObjIntRep(copyPtr, fss, NULL); + ClockFmtObj_SetObjIntRep(copyPtr, fss, ObjLocFmtKey(srcPtr)); /* if no format representation, dup string representation */ if (fss == NULL) { @@ -352,7 +351,6 @@ ClockFmtObj_FreeInternalRep(objPtr) Tcl_Obj *objPtr; { ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); - // ClockLitStorage *lit = ObjLitStorage(objPtr); if (fss != NULL) { Tcl_MutexLock(&ClockFmtMutex); /* decrement object reference count of format/scan storage */ @@ -368,7 +366,7 @@ ClockFmtObj_FreeInternalRep(objPtr) Tcl_MutexUnlock(&ClockFmtMutex); } SetObjClockFmtScn(objPtr, NULL); - SetObjLitStorage(objPtr, NULL); + Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); objPtr->typePtr = NULL; }; /* @@ -379,16 +377,18 @@ ClockFmtObj_SetFromAny(interp, objPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; { - ClockFmtScnStorage *fss; - const char *strFmt = TclGetString(objPtr); - - if (!strFmt || (fss = FindOrCreateFmtScnStorage(interp, strFmt)) == NULL) { - return TCL_ERROR; - } - + /* validate string representation before free old internal represenation */ + (void)TclGetString(objPtr); + + /* free old internal represenation */ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr); - ClockFmtObj_SetObjIntRep(objPtr, fss, NULL); + + /* initial state of format object */ + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &ClockFmtObjType; + return TCL_OK; }; /* @@ -415,6 +415,33 @@ ClockFmtObj_UpdateString(objPtr) /* *---------------------------------------------------------------------- + */ +MODULE_SCOPE Tcl_Obj* +ClockFrmObjGetLocFmtKey( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + Tcl_Obj *keyObj; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + keyObj = ObjLocFmtKey(objPtr); + if (keyObj) { + return keyObj; + } + + keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr)); + SetObjLocFmtKey(objPtr, keyObj); + + return keyObj; +} + +/* + *---------------------------------------------------------------------- * * Tcl_GetClockFrmScnFromObj -- * @@ -731,7 +758,7 @@ static ClockScanTokenMap ScnWordTokenMap = { ClockScanToken * ClockGetOrParseScanFormat( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Obj *formatObj) /* Format container */ + Tcl_Obj *formatObj) /* Format container */ { ClockFmtScnStorage *fss; ClockScanToken *tok; @@ -889,6 +916,12 @@ ClockScan( unsigned short int flags = 0; int ret = TCL_ERROR; + /* get localized format */ + + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + if ((tok = ClockGetOrParseScanFormat(interp, opts->formatObj)) == NULL) { return TCL_ERROR; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 1c51a02..62fa693 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -345,10 +345,6 @@ typedef struct ClockFmtScnStorage { * stored by offset +sizeof(self) */ } ClockFmtScnStorage; -typedef struct ClockLitStorage { - int dummy; -} ClockLitStorage; - /* * Prototypes of module functions. */ @@ -366,9 +362,15 @@ MODULE_SCOPE Tcl_Obj * ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); MODULE_SCOPE Tcl_Obj * ClockMCGetListIdxDict(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE Tcl_Obj * + ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); /* tclClockFmt.c module declarations */ +MODULE_SCOPE Tcl_Obj* + ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, + Tcl_Obj *objPtr); + MODULE_SCOPE ClockFmtScnStorage * Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 1115999..3944173 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -51,6 +51,8 @@ static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, @@ -98,6 +100,7 @@ static const EnsembleImplMap implementationMap[] = { {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, + {"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, @@ -142,7 +145,7 @@ typedef struct Dict { * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ - size_t refCount; /* Reference counter (see above) */ + int refcount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ @@ -392,7 +395,7 @@ DupDictInternalRep( newDict->epoch = 0; newDict->chain = NULL; - newDict->refCount = 1; + newDict->refcount = 1; /* * Store in the object. @@ -427,7 +430,8 @@ FreeDictInternalRep( { Dict *dict = DICT(dictPtr); - if (dict->refCount-- <= 1) { + dict->refcount--; + if (dict->refcount <= 0) { DeleteDict(dict); } dictPtr->typePtr = NULL; @@ -712,7 +716,7 @@ SetDictFromAny( TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; - dict->refCount = 1; + dict->refcount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; @@ -1116,7 +1120,7 @@ Tcl_DictObjFirst( searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; - dict->refCount++; + dict->refcount++; if (keyPtrPtr != NULL) { *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); } @@ -1230,7 +1234,8 @@ Tcl_DictObjDone( if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; - if (dict->refCount-- <= 1) { + dict->refcount--; + if (dict->refcount <= 0) { DeleteDict(dict); } } @@ -1382,7 +1387,7 @@ Tcl_NewDictObj(void) InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refCount = 1; + dict->refcount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1432,7 +1437,7 @@ Tcl_DbNewDictObj( InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refCount = 1; + dict->refcount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1957,6 +1962,77 @@ DictSizeCmd( /* *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_DictObjSmartRef( + Tcl_Interp *interp, + Tcl_Obj *dictPtr) +{ + Tcl_Obj *result; + Dict *dict; + + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } + + dict = DICT(dictPtr); + + result = Tcl_NewObj(); + DICT(result) = dict; + dict->refcount++; + result->internalRep.twoPtrValue.ptr2 = NULL; + result->typePtr = &tclDictType; + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DictSmartRefCmd -- + * + * This function implements the "dict smartref" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictSmartRefCmd( + ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Tcl_Obj *result; + Dict *dict; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); + return TCL_ERROR; + } + + result = Tcl_DictObjSmartRef(interp, objv[1]); + if (result == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, result); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- * * DictExistsCmd -- * @@ -2280,7 +2356,7 @@ DictAppendCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; - int allocatedDict = 0; + int i, allocatedDict = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); @@ -2305,33 +2381,15 @@ DictAppendCmd( if ((objc > 3) || (valuePtr == NULL)) { /* Only go through append activites when something will change. */ - Tcl_Obj *appendObjPtr = NULL; - - if (objc > 3) { - /* Something to append */ - - if (objc == 4) { - appendObjPtr = objv[3]; - } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, - objc-3, objv+3, &appendObjPtr)) { - return TCL_ERROR; - } - } - if (appendObjPtr == NULL) { - /* => (objc == 3) => (valuePtr == NULL) */ + if (valuePtr == NULL) { TclNewObj(valuePtr); - } else if (valuePtr == NULL) { - valuePtr = appendObjPtr; - appendObjPtr = NULL; + } else if (Tcl_IsShared(valuePtr)) { + valuePtr = Tcl_DuplicateObj(valuePtr); } - if (appendObjPtr) { - if (Tcl_IsShared(valuePtr)) { - valuePtr = Tcl_DuplicateObj(valuePtr); - } - - Tcl_AppendObjToObj(valuePtr, appendObjPtr); + for (i=3 ; i Date: Tue, 10 Jan 2017 22:30:24 +0000 Subject: improve LocalizeFormat, internal caching of localized formats inside msgcat for locale and format objects smart reference introduced in dict (smart pointer with 0 object reference but increase dict-reference, provide changeable locale dict) code review --- generic/tclClock.c | 98 +------------------- generic/tclClockFmt.c | 229 ++++++++++++++++++++++++++++++---------------- generic/tclDate.h | 52 ++++++++++- library/clock.tcl | 19 ++-- tests-perf/clock.perf.tcl | 6 +- 5 files changed, 214 insertions(+), 190 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e066812..08bc6ef 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -42,53 +42,7 @@ static const int daysInPriorMonths[2][13] = { * Enumeration of the string literals used in [clock] */ -typedef enum ClockLiteral { - LIT__NIL, - LIT__DEFAULT_FORMAT, - LIT_BCE, LIT_C, - LIT_CANNOT_USE_GMT_AND_TIMEZONE, - LIT_CE, - LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, - LIT_ERA, LIT_GMT, LIT_GREGORIAN, - LIT_INTEGER_VALUE_TOO_LARGE, - LIT_ISO8601WEEK, LIT_ISO8601YEAR, - LIT_JULIANDAY, LIT_LOCALSECONDS, - LIT_MONTH, - LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, - LIT_YEAR, - LIT_TZDATA, - LIT_GETSYSTEMTIMEZONE, - LIT_SETUPTIMEZONE, - LIT_MCGET, LIT_TCL_CLOCK, - LIT_LOCALIZE_FORMAT, -#if 0 - LIT_FREESCAN, -#endif - LIT__END -} ClockLiteral; -static const char *const Literals[] = { - "", - "%a %b %d %H:%M:%S %Z %Y", - "BCE", "C", - "cannot use -gmt and -timezone in same call", - "CE", - "dayOfMonth", "dayOfWeek", "dayOfYear", - "era", ":GMT", "gregorian", - "integer value too large to represent", - "iso8601Week", "iso8601Year", - "julianDay", "localSeconds", - "month", - "seconds", "tzName", "tzOffset", - "year", - "::tcl::clock::TZData", - "::tcl::clock::GetSystemTimeZone", - "::tcl::clock::SetupTimeZone", - "::msgcat::mcget", "::tcl::clock", - "::tcl::clock::LocalizeFormat" -#if 0 - "::tcl::clock::FreeScan" -#endif -}; +CLOCK_LITERAL_ARRAY(Literals); /* Msgcat literals for exact match (mcKey) */ CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, ""); @@ -634,56 +588,6 @@ ClockMCGetListIdxDict( return valObj; } -MODULE_SCOPE Tcl_Obj * -ClockLocalizeFormat( - ClockFmtScnCmdArgs *opts) -{ - ClockClientData *dataPtr = opts->clientData; - Tcl_Obj *valObj, *keyObj; - - keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); - - if (opts->mcDictObj == NULL) { - ClockMCDict(opts); - if (opts->mcDictObj == NULL) - return NULL; - } - - /* try to find in cache within mc-catalog */ - if (Tcl_DictObjGet(NULL, opts->mcDictObj, - keyObj, &valObj) != TCL_OK) { - return NULL; - } - if (valObj == NULL) { - Tcl_Obj *callargs[4]; - /* call LocalizeFormat locale format fmtkey */ - callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; - callargs[1] = opts->localeObj; - callargs[2] = opts->formatObj; - callargs[3] = keyObj; - Tcl_IncrRefCount(keyObj); - if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK - ) { - Tcl_DecrRefCount(keyObj); - return NULL; - } - - valObj = Tcl_GetObjResult(opts->interp); - - if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, - keyObj, valObj) != TCL_OK - ) { - Tcl_DecrRefCount(keyObj); - return NULL; - } - - Tcl_DecrRefCount(keyObj); - Tcl_ResetResult(opts->interp); - } - - return (opts->formatObj = valObj); -} - /* *---------------------------------------------------------------------- */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 184b52a..daedb26 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -233,65 +233,6 @@ static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; /* - *---------------------------------------------------------------------- - */ - -static ClockFmtScnStorage * -FindOrCreateFmtScnStorage( - Tcl_Interp *interp, - const char *strFmt) -{ - ClockFmtScnStorage *fss = NULL; - int new; - Tcl_HashEntry *hPtr; - - Tcl_MutexLock(&ClockFmtMutex); - - /* if not yet initialized */ - if (!initialized) { - /* initialize type */ - memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); - ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; - ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; - - /* initialize hash table */ - Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, - &ClockFmtScnStorageHashKeyType); - - initialized = 1; - Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL); - } - - /* get or create entry (and alocate storage) */ - hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); - if (hPtr != NULL) { - - fss = FmtScn4HashEntry(hPtr); - - #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 - /* unlink if it is currently in GC */ - if (new == 0 && fss->objRefCount == 0) { - ClockFmtScnStorage_GC_Out(fss); - } - #endif - - /* new reference, so increment in lock right now */ - fss->objRefCount++; - } - - Tcl_MutexUnlock(&ClockFmtMutex); - - if (fss == NULL && interp != NULL) { - Tcl_AppendResult(interp, "retrieve clock format failed \"", - strFmt ? strFmt : "", "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); - } - - return fss; -} - - -/* * Type definition. */ @@ -303,20 +244,11 @@ Tcl_ObjType ClockFmtObjType = { ClockFmtObj_SetFromAny /* setFromAnyProc */ }; -#define SetObjClockFmtScn(objPtr, fss) \ - objPtr->internalRep.twoPtrValue.ptr1 = fss #define ObjClockFmtScn(objPtr) \ - (ClockFmtScnStorage *)objPtr->internalRep.twoPtrValue.ptr1; + (*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1)) -#define SetObjLocFmtKey(objPtr, key) \ - Tcl_InitObjRef((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2, key) #define ObjLocFmtKey(objPtr) \ - ((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2) - -#define ClockFmtObj_SetObjIntRep(objPtr, fss, key) \ - objPtr->internalRep.twoPtrValue.ptr1 = fss; \ - Tcl_InitObjRef((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr2, key); \ - objPtr->typePtr = &ClockFmtObjType; + (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2)) /* *---------------------------------------------------------------------- @@ -334,7 +266,15 @@ ClockFmtObj_DupInternalRep(srcPtr, copyPtr) Tcl_MutexUnlock(&ClockFmtMutex); } - ClockFmtObj_SetObjIntRep(copyPtr, fss, ObjLocFmtKey(srcPtr)); + ObjClockFmtScn(copyPtr) = fss; + /* regards special case - format not localizable */ + if (ObjLocFmtKey(srcPtr) != srcPtr) { + Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr)); + } else { + ObjLocFmtKey(copyPtr) = copyPtr; + } + copyPtr->typePtr = &ClockFmtObjType; + /* if no format representation, dup string representation */ if (fss == NULL) { @@ -365,8 +305,12 @@ ClockFmtObj_FreeInternalRep(objPtr) } Tcl_MutexUnlock(&ClockFmtMutex); } - SetObjClockFmtScn(objPtr, NULL); - Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); + ObjClockFmtScn(objPtr) = NULL; + if (ObjLocFmtKey(objPtr) != objPtr) { + Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); + } else { + ObjLocFmtKey(objPtr) = NULL; + } objPtr->typePtr = NULL; }; /* @@ -385,8 +329,8 @@ ClockFmtObj_SetFromAny(interp, objPtr) objPtr->typePtr->freeIntRepProc(objPtr); /* initial state of format object */ - objPtr->internalRep.twoPtrValue.ptr1 = NULL; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; + ObjClockFmtScn(objPtr) = NULL; + ObjLocFmtKey(objPtr) = NULL; objPtr->typePtr = &ClockFmtObjType; return TCL_OK; @@ -435,13 +379,74 @@ ClockFrmObjGetLocFmtKey( } keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr)); - SetObjLocFmtKey(objPtr, keyObj); + Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj); return keyObj; } /* *---------------------------------------------------------------------- + */ + +static ClockFmtScnStorage * +FindOrCreateFmtScnStorage( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + const char *strFmt = TclGetString(objPtr); + ClockFmtScnStorage *fss = NULL; + int new; + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&ClockFmtMutex); + + /* if not yet initialized */ + if (!initialized) { + /* initialize type */ + memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); + ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; + ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; + + /* initialize hash table */ + Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, + &ClockFmtScnStorageHashKeyType); + + initialized = 1; + Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL); + } + + /* get or create entry (and alocate storage) */ + hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); + if (hPtr != NULL) { + + fss = FmtScn4HashEntry(hPtr); + + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* unlink if it is currently in GC */ + if (new == 0 && fss->objRefCount == 0) { + ClockFmtScnStorage_GC_Out(fss); + } + #endif + + /* new reference, so increment in lock right now */ + fss->objRefCount++; + + ObjClockFmtScn(objPtr) = fss; + } + + Tcl_MutexUnlock(&ClockFmtMutex); + + if (fss == NULL && interp != NULL) { + Tcl_AppendResult(interp, "retrieve clock format failed \"", + strFmt ? strFmt : "", "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- * * Tcl_GetClockFrmScnFromObj -- * @@ -475,8 +480,7 @@ Tcl_GetClockFrmScnFromObj( fss = ObjClockFmtScn(objPtr); if (fss == NULL) { - const char *strFmt = TclGetString(objPtr); - fss = FindOrCreateFmtScnStorage(interp, strFmt); + fss = FindOrCreateFmtScnStorage(interp, objPtr); } return fss; @@ -772,7 +776,7 @@ ClockGetOrParseScanFormat( fss = ObjClockFmtScn(formatObj); if (fss == NULL) { - fss = FindOrCreateFmtScnStorage(interp, TclGetString(formatObj)); + fss = FindOrCreateFmtScnStorage(interp, formatObj); if (fss == NULL) { return NULL; } @@ -898,6 +902,72 @@ done: return fss->scnTok; } +MODULE_SCOPE Tcl_Obj * +ClockLocalizeFormat( + ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *valObj = NULL, *keyObj; + + keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); + + /* special case - format object is not localizable */ + if (keyObj == opts->formatObj) { + return opts->formatObj; + } + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to find in cache within locale mc-catalog */ + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + keyObj, &valObj) != TCL_OK) { + return NULL; + } + + /* call LocalizeFormat locale format fmtkey */ + if (valObj == NULL) { + Tcl_Obj *callargs[4]; + callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; + callargs[1] = opts->localeObj; + callargs[2] = opts->formatObj; + callargs[3] = keyObj; + Tcl_IncrRefCount(keyObj); + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + ) { + goto clean; + } + + valObj = Tcl_GetObjResult(opts->interp); + + /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + keyObj, valObj) != TCL_OK + ) { + valObj = NULL; + goto clean; + } + + /* check special case - format object is not localizable */ + if (valObj == opts->formatObj) { + /* mark it as unlocalizable, by setting self as key (without refcount incr) */ + if (opts->formatObj->typePtr == &ClockFmtObjType) { + Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj)); + ObjLocFmtKey(opts->formatObj) = opts->formatObj; + } + } +clean: + + Tcl_UnsetObjRef(keyObj); + Tcl_ResetResult(opts->interp); + } + + return (opts->formatObj = valObj); +} + /* *---------------------------------------------------------------------- */ @@ -917,7 +987,6 @@ ClockScan( int ret = TCL_ERROR; /* get localized format */ - if (ClockLocalizeFormat(opts) == NULL) { return TCL_ERROR; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 62fa693..9f65b1b 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -37,6 +37,53 @@ /* + * Enumeration of the string literals used in [clock] + */ + +typedef enum ClockLiteral { + LIT__NIL, + LIT__DEFAULT_FORMAT, + LIT_BCE, LIT_C, + LIT_CANNOT_USE_GMT_AND_TIMEZONE, + LIT_CE, + LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, + LIT_ERA, LIT_GMT, LIT_GREGORIAN, + LIT_INTEGER_VALUE_TOO_LARGE, + LIT_ISO8601WEEK, LIT_ISO8601YEAR, + LIT_JULIANDAY, LIT_LOCALSECONDS, + LIT_MONTH, + LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, + LIT_YEAR, + LIT_TZDATA, + LIT_GETSYSTEMTIMEZONE, + LIT_SETUPTIMEZONE, + LIT_MCGET, LIT_TCL_CLOCK, + LIT_LOCALIZE_FORMAT, + LIT__END +} ClockLiteral; + +#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ + "", \ + "%a %b %d %H:%M:%S %Z %Y", \ + "BCE", "C", \ + "cannot use -gmt and -timezone in same call", \ + "CE", \ + "dayOfMonth", "dayOfWeek", "dayOfYear", \ + "era", ":GMT", "gregorian", \ + "integer value too large to represent", \ + "iso8601Week", "iso8601Year", \ + "julianDay", "localSeconds", \ + "month", \ + "seconds", "tzName", "tzOffset", \ + "year", \ + "::tcl::clock::TZData", \ + "::tcl::clock::GetSystemTimeZone", \ + "::tcl::clock::SetupTimeZone", \ + "::msgcat::mcget", "::tcl::clock", \ + "::tcl::clock::LocalizeFormat" \ +} + +/* * Enumeration of the msgcat literals used in [clock] */ @@ -362,8 +409,6 @@ MODULE_SCOPE Tcl_Obj * ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); MODULE_SCOPE Tcl_Obj * ClockMCGetListIdxDict(ClockFmtScnCmdArgs *opts, int mcKey); -MODULE_SCOPE Tcl_Obj * - ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); /* tclClockFmt.c module declarations */ @@ -374,7 +419,8 @@ MODULE_SCOPE Tcl_Obj* MODULE_SCOPE ClockFmtScnStorage * Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); - +MODULE_SCOPE Tcl_Obj * + ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); diff --git a/library/clock.tcl b/library/clock.tcl index 4173174..a532c0d 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -2365,18 +2365,23 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { dict set LocaleFormats $locale MLST $mlst } - # translate: - set locfmt [string map $mlst $format] - - # Save original format as long as possible, because of internal representation (performance) - if {$locfmt eq $format} { - set locfmt $format - } + # translate copy of format (don't use format object here, because otherwise + # it can lose its internal representation (string map - convert to unicode) + set locfmt [string map $mlst [string range " $format" 1 end]] # cache it: dict set LocaleFormats $locale $fmtkey $locfmt } + # Save original format as long as possible, because of internal + # representation (performance). + # Note that in this case such format will be never localized (also + # using another locales). To prevent this return a duplicate (but + # it may be slower). + if {$locfmt eq $format} { + set locfmt $format + } + return $locfmt } diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index a005648..3c69414 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -132,9 +132,6 @@ proc test-scan {{reptime 1000}} { # Scan : date-time (system time zone without base) {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"} - # Scan : dynamic format (cacheable) - {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} - # Scan : julian day in gmt {clock scan 2451545 -format %J -gmt 1} # Scan : julian day in system TZ @@ -153,6 +150,9 @@ proc test-scan {{reptime 1000}} { # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} + # Scan : dynamic format (cacheable) + {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} + break # Scan : zone only -- cgit v0.12 From f6b32c8442a436357885e7193724581862452a11 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:30:49 +0000 Subject: list index logic optimized regarding greedy search (don't stop by first found - try to find longest) --- generic/tclClockFmt.c | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index daedb26..09cbfa4 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -514,7 +514,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, int minLen, int maxLen) { Tcl_Obj **lstv; - int lstc, i, l; + int lstc, i, l, lf = -1; const char *s; Tcl_Obj *valObj; @@ -536,16 +536,27 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, if ( l >= minLen && l <= maxLen && strncasecmp(yyInput, s, l) == 0 ) { + /* found, try to find longest value (greedy search) */ + if (l < maxLen && minLen != maxLen) { + lf = i; + minLen = l + 1; + continue; + } *val = i; yyInput += l; break; } } - /* if not found */ + /* if found */ if (i < lstc) { return TCL_OK; } + if (lf >= 0) { + *val = lf; + yyInput += minLen - 1; + return TCL_OK; + } return TCL_RETURN; } -- cgit v0.12 From 767da780e6fab9b52c9cbe460f6b3101910367e9 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:31:12 +0000 Subject: seconds token (%s) take precedence over all other tokens --- generic/tclClockFmt.c | 56 ++++++++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 25 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 09cbfa4..ba924fd 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1147,41 +1147,47 @@ ClockScan( goto not_match; } - /* invalidate result */ - if (flags & CLF_DATE) { + /* + * Invalidate result + */ + + /* seconds token (%s) take precedence over all other tokens */ + if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { + if (flags & CLF_DATE) { - if (!(flags & CLF_JULIANDAY)) { - info->flags |= CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY; + if (!(flags & CLF_JULIANDAY)) { + info->flags |= CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY; - if (yyYear < 100) { - if (!(flags & CLF_CENTURY)) { - if (yyYear >= dataPtr->yearOfCenturySwitch) { - yyYear -= 100; + if (yyYear < 100) { + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; } - yyYear += dataPtr->currentYearCentury; - } else { - yyYear += info->dateCentury * 100; } + yydate.era = CE; + } + /* if date but no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + info->flags |= CLF_INVALIDATE_SECONDS; + yydate.localSeconds = 0; } - yydate.era = CE; } - /* if date but no time - reset time */ - if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + + if (flags & CLF_TIME) { + info->flags |= CLF_INVALIDATE_SECONDS; + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + } else + if (!(flags & CLF_LOCALSEC)) { info->flags |= CLF_INVALIDATE_SECONDS; - yydate.localSeconds = 0; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; } } - if (flags & CLF_TIME) { - info->flags |= CLF_INVALIDATE_SECONDS; - yySeconds = ToSeconds(yyHour, yyMinutes, - yySeconds, yyMeridian); - } else - if (!(flags & CLF_LOCALSEC)) { - info->flags |= CLF_INVALIDATE_SECONDS; - yySeconds = yydate.localSeconds % SECONDS_PER_DAY; - } - ret = TCL_OK; goto done; -- cgit v0.12 From 8fb97e54a5d09f6cb6faab31efe48b7dd0670467 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:31:43 +0000 Subject: %j token as day of year; clear flags implemented (to provide last-wins functionality) --- generic/tclClock.c | 86 ++++++++++++++++++++++++++++++++++++++------------- generic/tclClockFmt.c | 48 +++++++++++++++------------- generic/tclDate.h | 22 +++++++------ 3 files changed, 103 insertions(+), 53 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 08bc6ef..ef0e46b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2313,7 +2313,47 @@ GetJulianDayFromEraYearMonthDay( + ym1o4; } } +/* + *---------------------------------------------------------------------- + */ +static void +GetJulianDayFromEraYearDay( + TclDateFields *fields, /* Date to convert */ + int changeover) /* Gregorian transition date as a Julian Day */ +{ + int year, ym1; + + /* Get absolute year number from the civil year */ + if (fields->era == BCE) { + year = 1 - fields->year; + } else { + year = fields->year; + } + + ym1 = year - 1; + + /* Try the Gregorian calendar first. */ + fields->gregorian = 1; + fields->julianDay = + 1721425 + + fields->dayOfYear + + ( 365 * ym1 ) + + ( ym1 / 4 ) + - ( ym1 / 100 ) + + ( ym1 / 400 ); + + /* If the date is before the Gregorian change, use the Julian calendar. */ + + if ( fields->julianDay < changeover ) { + fields->gregorian = 0; + fields->julianDay = + 1721423 + + fields->dayOfYear + + ( 365 * ym1 ) + + ( ym1 / 4 ); + } +} /* *---------------------------------------------------------------------- * @@ -2906,9 +2946,13 @@ ClockScanObjCmd( goto done; } - /* If needed assemble julianDay using new year, month, etc. */ - if (info->flags & CLF_INVALIDATE_JULIANDAY) { - GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + /* If needed assemble julianDay using year, month, etc. */ + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { + if ((info->flags & CLF_DAYOFMONTH) || !(info->flags & CLF_DAYOFYEAR)) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + } else { + GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + } } /* some overflow checks, if not extended */ @@ -2924,7 +2968,7 @@ ClockScanObjCmd( /* Local seconds to UTC (stored in yydate.seconds) */ - if (info->flags & (CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY)) { + if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY)) { yydate.localSeconds = -210866803200L + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) @@ -3007,7 +3051,7 @@ ClockFreeScan( if (yyHaveTime == 0) { yyHaveTime = -1; } - info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; } /* @@ -3032,7 +3076,7 @@ ClockFreeScan( // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; } /* @@ -3041,13 +3085,13 @@ ClockFreeScan( if (yyHaveTime == -1) { yySeconds = 0; - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; } else if (yyHaveTime) { yySeconds = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; } else if ( (yyHaveDay && !yyHaveDate) @@ -3057,7 +3101,7 @@ ClockFreeScan( || yyRelDay != 0 ) ) ) { yySeconds = 0; - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; } else { yySeconds = yydate.localSeconds % SECONDS_PER_DAY; @@ -3084,11 +3128,11 @@ repeat_rel: int m, h; /* if needed extract year, month, etc. again */ - if (info->flags & CLF_INVALIDATE_DATE) { + if (info->flags & CLF_ASSEMBLE_DATE) { GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); GetMonthDay(&yydate); GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_INVALIDATE_DATE; + info->flags &= ~CLF_ASSEMBLE_DATE; } /* add the requisite number of months */ @@ -3104,7 +3148,7 @@ repeat_rel: } /* on demand (lazy) assemble julianDay using new year, month, etc. */ - info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; yyRelMonth = 0; } @@ -3113,14 +3157,14 @@ repeat_rel: if (yyRelDay) { /* assemble julianDay using new year, month, etc. */ - if (info->flags & CLF_INVALIDATE_JULIANDAY) { + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_INVALIDATE_JULIANDAY; + info->flags &= ~CLF_ASSEMBLE_JULIANDAY; } yydate.julianDay += yyRelDay; /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ - info->flags |= CLF_INVALIDATE_DATE|CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; yyRelDay = 0; } @@ -3150,11 +3194,11 @@ repeat_rel: int monthDiff; /* if needed extract year, month, etc. again */ - if (info->flags & CLF_INVALIDATE_DATE) { + if (info->flags & CLF_ASSEMBLE_DATE) { GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); GetMonthDay(&yydate); GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_INVALIDATE_DATE; + info->flags &= ~CLF_ASSEMBLE_DATE; } if (yyMonthOrdinalIncr > 0) { @@ -3177,7 +3221,7 @@ repeat_rel: yyRelMonth += monthDiff; yyHaveOrdinalMonth = 0; - info->flags |= CLF_INVALIDATE_JULIANDAY|CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; goto repeat_rel; } @@ -3189,9 +3233,9 @@ repeat_rel: if (yyHaveDay && !yyHaveDate) { /* if needed assemble julianDay now */ - if (info->flags & CLF_INVALIDATE_JULIANDAY) { + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); - info->flags &= ~CLF_INVALIDATE_JULIANDAY; + info->flags &= ~CLF_ASSEMBLE_JULIANDAY; } yydate.era = CE; @@ -3200,7 +3244,7 @@ repeat_rel: if (yyDayOrdinal > 0) { yydate.julianDay -= 7; } - info->flags |= CLF_INVALIDATE_DATE|CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; } /* Free scanning completed - date ready */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index ba924fd..2c1dfc1 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -678,40 +678,43 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, static const char *ScnSTokenMapIndex = - "dmbyYHMSJCs"; + "dmbyYHMSJjCs"; static ClockScanTokenMap ScnSTokenMap[] = { /* %d %e */ - {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + {CTOKT_DIGIT, CLF_DATE | CLF_DAYOFMONTH, CLF_DAYOFYEAR, 1, 2, TclOffset(DateInfo, date.dayOfMonth), NULL}, /* %m */ - {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.month), + {CTOKT_DIGIT, CLF_DATE, CLF_DAYOFYEAR, 1, 2, TclOffset(DateInfo, date.month), NULL}, /* %b %B %h */ - {CTOKT_PARSER, CLF_DATE, 0, 0, 0, + {CTOKT_PARSER, CLF_DATE, CLF_DAYOFYEAR, 0, 0, 0, ClockScnToken_Month_Proc}, /* %y */ - {CTOKT_DIGIT, CLF_DATE, 1, 2, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_DATE, 0, 1, 2, TclOffset(DateInfo, date.year), NULL}, /* %Y */ - {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 1, 4, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 0, 1, 4, TclOffset(DateInfo, date.year), NULL}, /* %H */ - {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.hour), + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), NULL}, /* %M */ - {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.minutes), + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes), NULL}, /* %S */ - {CTOKT_DIGIT, CLF_TIME, 1, 2, TclOffset(DateInfo, date.secondOfDay), + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay), NULL}, /* %J */ - {CTOKT_DIGIT, CLF_DATE | CLF_JULIANDAY, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + {CTOKT_DIGIT, CLF_DATE | CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + NULL}, + /* %j */ + {CTOKT_DIGIT, CLF_DATE | CLF_DAYOFYEAR, CLF_DAYOFMONTH, 1, 3, TclOffset(DateInfo, date.dayOfYear), NULL}, /* %C */ - {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 1, 2, TclOffset(DateInfo, dateCentury), + {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), NULL}, /* %s */ - {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), NULL}, }; static const char *ScnSTokenWrapMapIndex[2] = { @@ -733,10 +736,10 @@ static const char *ScnOTokenMapIndex = "dm"; static ClockScanTokenMap ScnOTokenMap[] = { /* %Od %Oe */ - {CTOKT_PARSER, CLF_DATE, 0, 0, TclOffset(DateInfo, date.dayOfMonth), + {CTOKT_PARSER, CLF_DATE | CLF_DAYOFMONTH, CLF_DAYOFYEAR, 0, 0, TclOffset(DateInfo, date.dayOfMonth), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Om */ - {CTOKT_PARSER, CLF_DATE, 0, 0, TclOffset(DateInfo, date.month), + {CTOKT_PARSER, CLF_DATE, CLF_DAYOFYEAR, 0, 0, TclOffset(DateInfo, date.month), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *ScnOTokenWrapMapIndex[2] = { @@ -747,12 +750,12 @@ static const char *ScnOTokenWrapMapIndex[2] = { static const char *ScnSpecTokenMapIndex = " "; static ClockScanTokenMap ScnSpecTokenMap[] = { - {CTOKT_SPACE, 0, 1, 0xffff, 0, + {CTOKT_SPACE, 0, 0, 1, 0xffff, 0, NULL}, }; static ClockScanTokenMap ScnWordTokenMap = { - CTOKT_WORD, 0, 1, 0, 0, + CTOKT_WORD, 0, 0, 1, 0, 0, NULL }; @@ -1095,7 +1098,7 @@ ClockScan( } p = x; } - flags |= map->flags; + flags = (flags & ~map->clearFlags) | map->flags; } break; case CTOKT_PARSER: @@ -1110,7 +1113,7 @@ ClockScan( break; }; p = yyInput; - flags |= map->flags; + flags = (flags & ~map->clearFlags) | map->flags; break; case CTOKT_SPACE: /* at least one space in strict mode */ @@ -1150,13 +1153,14 @@ ClockScan( /* * Invalidate result */ + info->flags |= flags; /* seconds token (%s) take precedence over all other tokens */ if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { if (flags & CLF_DATE) { if (!(flags & CLF_JULIANDAY)) { - info->flags |= CLF_INVALIDATE_SECONDS|CLF_INVALIDATE_JULIANDAY; + info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; if (yyYear < 100) { if (!(flags & CLF_CENTURY)) { @@ -1172,18 +1176,18 @@ ClockScan( } /* if date but no time - reset time */ if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; yydate.localSeconds = 0; } } if (flags & CLF_TIME) { - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; yySeconds = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); } else if (!(flags & CLF_LOCALSEC)) { - info->flags |= CLF_INVALIDATE_SECONDS; + info->flags |= CLF_ASSEMBLE_SECONDS; yySeconds = yydate.localSeconds % SECONDS_PER_DAY; } } diff --git a/generic/tclDate.h b/generic/tclDate.h index 9f65b1b..23fe5b3 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -30,10 +30,18 @@ #define ONE_YEAR 365 /* days */ +#define CLF_DATE (1 << 2) +#define CLF_JULIANDAY (1 << 3) +#define CLF_TIME (1 << 4) +#define CLF_LOCALSEC (1 << 5) +#define CLF_CENTURY (1 << 6) +#define CLF_DAYOFMONTH (1 << 7) +#define CLF_DAYOFYEAR (1 << 8) +#define CLF_SIGNED (1 << 15) /* On demand (lazy) assemble flags */ -#define CLF_INVALIDATE_DATE (1 << 6) /* assemble year, month, etc. using julianDay */ -#define CLF_INVALIDATE_JULIANDAY (1 << 7) /* assemble julianDay using year, month, etc. */ -#define CLF_INVALIDATE_SECONDS (1 << 8) /* assemble localSeconds (and seconds at end) */ +#define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */ +#define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ +#define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ /* @@ -339,13 +347,6 @@ typedef int ClockScanTokenProc( ClockScanToken *tok); -#define CLF_DATE (1 << 2) -#define CLF_JULIANDAY (1 << 3) -#define CLF_TIME (1 << 4) -#define CLF_LOCALSEC (1 << 5) -#define CLF_CENTURY (1 << 6) -#define CLF_SIGNED (1 << 8) - typedef enum _CLCKTOK_TYPE { CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD } CLCKTOK_TYPE; @@ -359,6 +360,7 @@ typedef struct ClockFormatToken { typedef struct ClockScanTokenMap { unsigned short int type; unsigned short int flags; + unsigned short int clearFlags; unsigned short int minSize; unsigned short int maxSize; unsigned short int offs; -- cgit v0.12 From 6795fcaa4965863daab7cdaa16fff4b551044586 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:32:46 +0000 Subject: scan format: several tokens implemented, bug fixing and code review; precedence yyyymmdd over yyyyddd was changed (and re-covered in test-cases also), see http://core.tcl.tk/tcl/tktview/e7a722cd3573fedda5d1e528f95902776f996e06 --- generic/tclClock.c | 25 +-- generic/tclClockFmt.c | 384 +++++++++++++++++++++++++++++++++++++++------- generic/tclDate.h | 21 ++- library/clock.tcl | 37 ++++- library/msgcat/msgcat.tcl | 5 + tests/clock.test | 66 ++++---- 6 files changed, 436 insertions(+), 102 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index ef0e46b..1a5141b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -473,13 +473,12 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) } if (opts->mcDictObj == NULL) { - Tcl_Obj *callargs[3]; - /* get msgcat dictionary - ::msgcat::mcget ::tcl::clock locale */ + Tcl_Obj *callargs[2]; + /* get msgcat dictionary - ::tcl::clock::mcget locale */ callargs[0] = dataPtr->literals[LIT_MCGET]; - callargs[1] = dataPtr->literals[LIT_TCL_CLOCK]; - callargs[2] = opts->localeObj; + callargs[1] = opts->localeObj; - if (Tcl_EvalObjv(opts->interp, 3, callargs, 0) != TCL_OK) { + if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) { return NULL; } @@ -823,7 +822,7 @@ ClockGetSystemTimeZone( /* *---------------------------------------------------------------------- */ -static Tcl_Obj * +MODULE_SCOPE Tcl_Obj * ClockSetupTimeZone( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ @@ -2948,7 +2947,11 @@ ClockScanObjCmd( /* If needed assemble julianDay using year, month, etc. */ if (info->flags & CLF_ASSEMBLE_JULIANDAY) { - if ((info->flags & CLF_DAYOFMONTH) || !(info->flags & CLF_DAYOFYEAR)) { + if ((info->flags & CLF_ISO8601)) { + GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + } + else + if (!(info->flags & CLF_DAYOFYEAR)) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); } else { GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); @@ -3065,11 +3068,11 @@ ClockFreeScan( int dstFlag = 1 - yyDSTmode; tzObjStor = ClockFormatNumericTimeZone( 60 * minEast + 3600 * dstFlag); - + Tcl_IncrRefCount(tzObjStor); + opts->timezoneObj = ClockSetupTimeZone(clientData, interp, tzObjStor); - if (tzObjStor != opts->timezoneObj) { - Tcl_DecrRefCount(tzObjStor); - } + + Tcl_DecrRefCount(tzObjStor); if (opts->timezoneObj == NULL) { goto done; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 2c1dfc1..f965a17 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -508,27 +508,14 @@ void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, } } -static int -LocaleListSearch(ClockFmtScnCmdArgs *opts, - DateInfo *info, int mcKey, int *val, +inline int +ObjListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int *val, + Tcl_Obj **lstv, int lstc, int minLen, int maxLen) { - Tcl_Obj **lstv; - int lstc, i, l, lf = -1; + int i, l, lf = -1; const char *s; - Tcl_Obj *valObj; - - /* get msgcat value */ - valObj = ClockMCGet(opts, mcKey); - if (valObj == NULL) { - return TCL_ERROR; - } - - /* is a list */ - if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { - return TCL_ERROR; - } - /* search in list */ for (i = 0; i < lstc; i++) { s = TclGetString(lstv[i]); @@ -561,6 +548,31 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } static int +LocaleListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int mcKey, int *val, + int minLen, int maxLen) +{ + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + /* get msgcat value */ + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + return TCL_ERROR; + } + + /* is a list */ + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + } + + /* search in list */ + return ObjListSearch(opts, info, val, lstv, lstc, + minLen, maxLen); +} + +static int StaticListSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, const char **lst, int *val) { @@ -631,8 +643,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, */ int ret, val; - int minLen; - int maxLen; + int minLen, maxLen; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -653,15 +664,115 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, return TCL_OK; } + +static int +ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + char curTok = *tok->tokWord.start; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* %u %w %Ou %Ow */ + if ( curTok != 'a' && curTok != 'A' + && ((minLen <= 1 && maxLen >= 1) || (int)tok->map->data) + ) { + + val = -1; + + if (!(int)tok->map->data) { + if (*yyInput >= '0' && *yyInput <= '9') { + val = *yyInput - '0'; + } + } else { + int ret = LocaleListSearch(opts, info, (int)tok->map->data, &val, + minLen, maxLen); + if (ret == TCL_ERROR) { + return ret; + } + } + + if (val != -1) { + if (val == 0) { + val = 7; + } + if (val > 7 && curTok != 'a' && curTok != 'A') { + Tcl_SetResult(opts->interp, "day of week is greater than 7", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); + return TCL_ERROR; + } + info->date.dayOfWeek = val; + yyInput++; + return TCL_OK; + } + + + return TCL_RETURN; + } + + /* %a %A */ + ret = LocaleListSearch(opts, info, MCLIT_DAYS_OF_WEEK_FULL, &val, + minLen, maxLen); + if (ret != TCL_OK) { + /* if not found */ + if (ret == TCL_RETURN) { + ret = LocaleListSearch(opts, info, MCLIT_DAYS_OF_WEEK_ABBREV, &val, + minLen, maxLen); + } + if (ret != TCL_OK) { + return ret; + } + } + + if (val == 0) { + val = 7; + } + info->date.dayOfWeek = val; + return TCL_OK; + +} + +static int +ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + Tcl_Obj *amPmObj[2]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + amPmObj[0] = ClockMCGet(opts, MCLIT_AM); + amPmObj[1] = ClockMCGet(opts, MCLIT_PM); + + if (amPmObj[0] == NULL || amPmObj == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, amPmObj, 2, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val == 0) { + yyMeridian = MERam; + } else { + yyMeridian = MERpm; + } + return TCL_OK; +} static int ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int ret, val; - int minLen; - int maxLen; + int minLen, maxLen; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -675,27 +786,106 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, return TCL_OK; } + +static int +ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + int len = 0; + register const char *p = yyInput; + Tcl_Obj *tzObjStor = NULL; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* numeric timezone */ + if (*p == '+' || *p == '-') { + /* max chars in numeric zone = "+00:00:00" */ + #define MAX_ZONE_LEN 9 + char buf[MAX_ZONE_LEN + 1]; + char *bp = buf; + *bp++ = *p++; len++; + if (maxLen > MAX_ZONE_LEN) + maxLen = MAX_ZONE_LEN; + /* cumulate zone into buf without ':' */ + while (len + 1 < maxLen) { + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (len + 2 < maxLen) { + if (*p == ':') { + *p++; len++; + } + } + } + *bp = '\0'; + + if (len < minLen) { + return TCL_RETURN; + } + #undef MAX_ZONE_LEN + + /* timezone */ + tzObjStor = Tcl_NewStringObj(buf, bp-buf); + } else { + /* legacy (alnum) timezone like CEST, etc. */ + if (maxLen > 4) + maxLen = 4; + while (len < maxLen) { + if ( (*p & 0x80) + || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p))) + ) { /* INTL: ISO only. */ + break; + } + p++; len++; + } + if (len < minLen) { + return TCL_RETURN; + } + + /* timezone */ + tzObjStor = Tcl_NewStringObj(yyInput, p-yyInput); + + /* convert using dict */ + } + + /* try to apply new time zone */ + Tcl_IncrRefCount(tzObjStor); + + opts->timezoneObj = ClockSetupTimeZone(opts->clientData, opts->interp, + tzObjStor); + + Tcl_DecrRefCount(tzObjStor); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } + + yyInput += len; + return TCL_OK; +} + static const char *ScnSTokenMapIndex = - "dmbyYHMSJjCs"; + "dmbyYHMSpJjCgGVazs"; static ClockScanTokenMap ScnSTokenMap[] = { /* %d %e */ - {CTOKT_DIGIT, CLF_DATE | CLF_DAYOFMONTH, CLF_DAYOFYEAR, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + {CTOKT_DIGIT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth), NULL}, /* %m */ - {CTOKT_DIGIT, CLF_DATE, CLF_DAYOFYEAR, 1, 2, TclOffset(DateInfo, date.month), + {CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), NULL}, /* %b %B %h */ - {CTOKT_PARSER, CLF_DATE, CLF_DAYOFYEAR, 0, 0, 0, + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, 0, ClockScnToken_Month_Proc}, /* %y */ - {CTOKT_DIGIT, CLF_DATE, 0, 1, 2, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), NULL}, /* %Y */ - {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 0, 1, 4, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 1, 4, TclOffset(DateInfo, date.year), NULL}, - /* %H */ + /* %H %k %I %l */ {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), NULL}, /* %M */ @@ -704,22 +894,40 @@ static ClockScanTokenMap ScnSTokenMap[] = { /* %S */ {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay), NULL}, + /* %p %P */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + ClockScnToken_amPmInd_Proc, NULL}, /* %J */ - {CTOKT_DIGIT, CLF_DATE | CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + {CTOKT_DIGIT, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), NULL}, /* %j */ - {CTOKT_DIGIT, CLF_DATE | CLF_DAYOFYEAR, CLF_DAYOFMONTH, 1, 3, TclOffset(DateInfo, date.dayOfYear), + {CTOKT_DIGIT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear), NULL}, /* %C */ - {CTOKT_DIGIT, CLF_DATE | CLF_CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), + {CTOKT_DIGIT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), + NULL}, + /* %g */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year), + NULL}, + /* %G */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 1, 4, TclOffset(DateInfo, date.iso8601Year), NULL}, + /* %V */ + {CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), + NULL}, + /* %a %A %u %w */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + ClockScnToken_DayOfWeek_Proc, NULL}, + /* %z %Z */ + {CTOKT_PARSER, 0, 0, 0, 0, 0, + ClockScnToken_TimeZone_Proc, NULL}, /* %s */ {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), NULL}, }; static const char *ScnSTokenWrapMapIndex[2] = { - "eNBh", - "dmbb" + "eNBhkIlPAuwZ", + "dmbbHHHpaaaz" }; static const char *ScnETokenMapIndex = @@ -733,18 +941,33 @@ static const char *ScnETokenWrapMapIndex[2] = { }; static const char *ScnOTokenMapIndex = - "dm"; + "dmyHMSu"; static ClockScanTokenMap ScnOTokenMap[] = { /* %Od %Oe */ - {CTOKT_PARSER, CLF_DATE | CLF_DAYOFMONTH, CLF_DAYOFYEAR, 0, 0, TclOffset(DateInfo, date.dayOfMonth), + {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0, TclOffset(DateInfo, date.dayOfMonth), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Om */ - {CTOKT_PARSER, CLF_DATE, CLF_DAYOFYEAR, 0, 0, TclOffset(DateInfo, date.month), + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, TclOffset(DateInfo, date.month), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CTOKT_PARSER, CLF_YEAR, 0, 0, 0, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok %OI %Ol */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.hour), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.minutes), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.secondOfDay), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou Ow */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *ScnOTokenWrapMapIndex[2] = { - "e", - "d" + "ekIlw", + "dHHHu" }; static const char *ScnSpecTokenMapIndex = @@ -1153,7 +1376,6 @@ ClockScan( /* * Invalidate result */ - info->flags |= flags; /* seconds token (%s) take precedence over all other tokens */ if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { @@ -1162,23 +1384,78 @@ ClockScan( if (!(flags & CLF_JULIANDAY)) { info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; - if (yyYear < 100) { - if (!(flags & CLF_CENTURY)) { - if (yyYear >= dataPtr->yearOfCenturySwitch) { - yyYear -= 100; + /* dd precedence below ddd */ + switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { + case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* miss month: ddd over dd (without month) */ + flags &= ~CLF_DAYOFMONTH; + case (CLF_DAYOFYEAR): + /* ddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* both available: mmdd over ddd */ + flags &= ~CLF_DAYOFYEAR; + case (CLF_MONTH|CLF_DAYOFMONTH): + case (CLF_DAYOFMONTH): + /* mmdd / dd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + } + + /* YearWeekDay below YearMonthDay */ + if ( (flags & CLF_ISO8601) + && ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR) + || (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH) + ) + ) { + /* yy precedence below yyyy */ + if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) { + /* normally precedence of ISO is higher, but no century - so put it down */ + flags &= ~CLF_ISO8601; + } + else + /* yymmdd or yyddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + } + + if (!(flags & CLF_ISO8601)) { + if (yyYear < 100) { + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; + } + } + } else { + if (info->date.iso8601Year < 100) { + if (!(flags & CLF_ISO8601CENTURY)) { + if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) { + info->date.iso8601Year -= 100; + } + info->date.iso8601Year += dataPtr->currentYearCentury; + } else { + info->date.iso8601Year += info->dateCentury * 100; } - yyYear += dataPtr->currentYearCentury; - } else { - yyYear += info->dateCentury * 100; } } yydate.era = CE; } - /* if date but no time - reset time */ - if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { - info->flags |= CLF_ASSEMBLE_SECONDS; - yydate.localSeconds = 0; - } + } + + /* if no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yydate.localSeconds = 0; } if (flags & CLF_TIME) { @@ -1192,6 +1469,9 @@ ClockScan( } } + /* tell caller which flags were set */ + info->flags |= flags; + ret = TCL_OK; goto done; diff --git a/generic/tclDate.h b/generic/tclDate.h index 23fe5b3..fc922cb 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -30,19 +30,26 @@ #define ONE_YEAR 365 /* days */ -#define CLF_DATE (1 << 2) #define CLF_JULIANDAY (1 << 3) #define CLF_TIME (1 << 4) #define CLF_LOCALSEC (1 << 5) #define CLF_CENTURY (1 << 6) #define CLF_DAYOFMONTH (1 << 7) #define CLF_DAYOFYEAR (1 << 8) +#define CLF_MONTH (1 << 9) +#define CLF_YEAR (1 << 10) +#define CLF_ISO8601YEAR (1 << 12) +#define CLF_ISO8601 (1 << 13) +#define CLF_ISO8601CENTURY (1 << 14) #define CLF_SIGNED (1 << 15) /* On demand (lazy) assemble flags */ #define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */ #define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ #define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ +#define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ + CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | CLF_ISO8601) + /* * Enumeration of the string literals used in [clock] @@ -87,7 +94,7 @@ typedef enum ClockLiteral { "::tcl::clock::TZData", \ "::tcl::clock::GetSystemTimeZone", \ "::tcl::clock::SetupTimeZone", \ - "::msgcat::mcget", "::tcl::clock", \ + "::tcl::clock::mcget", "::tcl::clock", \ "::tcl::clock::LocalizeFormat" \ } @@ -96,13 +103,19 @@ typedef enum ClockLiteral { */ typedef enum ClockMsgCtLiteral { + MCLIT__NIL, /* placeholder */ MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, + MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, + MCLIT_AM, MCLIT_PM, MCLIT_LOCALE_NUMERALS, MCLIT__END } ClockMsgCtLiteral; #define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ + pref "", \ pref "MONTHS_FULL", pref "MONTHS_ABBREV", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", \ + pref "AM", pref "PM", \ pref "LOCALE_NUMERALS", \ } @@ -406,6 +419,10 @@ MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); /* tclClock.c module declarations */ MODULE_SCOPE Tcl_Obj * + ClockSetupTimeZone(ClientData clientData, + Tcl_Interp *interp, Tcl_Obj *timezoneObj); + +MODULE_SCOPE Tcl_Obj * ClockMCDict(ClockFmtScnCmdArgs *opts); MODULE_SCOPE Tcl_Obj * ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); diff --git a/library/clock.tcl b/library/clock.tcl index a532c0d..d4e29d5 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -629,15 +629,17 @@ proc ::tcl::clock::Initialize {} { # Caches - variable LocaleFormats {}; # Dictionary with localized formats + variable LocaleFormats \ + [dict create]; # Dictionary with localized formats - variable LocaleNumeralCache {}; # Dictionary whose keys are locale + variable LocaleNumeralCache \ + [dict create]; # Dictionary whose keys are locale # names and whose values are pairs # comprising regexes matching numerals # in the given locales and dictionaries # mapping the numerals to their numeric # values. - variable TimeZoneBad {}; # Dictionary whose keys are time zone + variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone # names and whose values are 1 if # the time zone is unknown and 0 # if it is known. @@ -653,6 +655,17 @@ proc ::tcl::clock::Initialize {} { ::tcl::clock::Initialize #---------------------------------------------------------------------- + +proc mcget {locale args} { + switch -- $locale system { + set locale [GetSystemLocale] + } current { + set locale [mclocale] + } + msgcat::mcget ::tcl::clock $locale {*}$args +} + +#---------------------------------------------------------------------- # # clock format -- # @@ -2938,7 +2951,7 @@ proc ::tcl::clock::ConvertLegacyTimeZone { tzname } { # #---------------------------------------------------------------------- -proc ::tcl::clock::SetupTimeZone { timezone } { +proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { variable TZData if {! [info exists TZData($timezone)] } { @@ -3005,6 +3018,19 @@ proc ::tcl::clock::SetupTimeZone { timezone } { } } else { + + variable LegacyTimeZone + + # Check may be a legacy zone: + if { $alias eq {} && ![catch { + set tzname [dict get $LegacyTimeZone [string tolower $timezone]] + }] } { + set tzname [::tcl::clock::SetupTimeZone $tzname $timezone] + set TZData($timezone) $TZData($tzname) + # tell backend - timezone is initialized and return shared timezone object: + return [configure -setup-tz $timezone] + } + # We couldn't parse this as a POSIX time zone. Try again with a # time zone file - this time without a colon @@ -4472,6 +4498,9 @@ proc ::tcl::clock::ClearCaches {} { # tell backend - should invalidate: configure -clear + # clear msgcat cache: + msgcat::ClearCaches ::tcl::clock + foreach p [info procs [namespace current]::scanproc'*] { rename $p {} } diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index a25f6c8..e6452d2 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -951,6 +951,11 @@ proc msgcat::Merge {ns locales} { return [dict smartref $mrgcat] } +proc msgcat::ClearCaches {ns} { + variable Merged + dict unset Merged $ns +} + # msgcat::Invoke -- # # Invoke a set of registered callbacks. diff --git a/tests/clock.test b/tests/clock.test index 22b5bc1..e96dec6 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -21070,78 +21070,78 @@ test clock-10.10 {julian day takes precedence over ccyyddd} { # BEGIN testcases11 -# Test precedence among yyyymmdd and yyyyddd +# Test precedence yyyymmdd over yyyyddd -test clock-11.1 {precedence of ccyyddd and ccyymmdd} { +test clock-11.1 {precedence of ccyymmdd over ccyyddd} { clock scan 19700101002 -format %Y%m%d%j -gmt 1 -} 86400 -test clock-11.2 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.2 {precedence of ccyymmdd over ccyyddd} { clock scan 01197001002 -format %m%Y%d%j -gmt 1 -} 86400 -test clock-11.3 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.3 {precedence of ccyymmdd over ccyyddd} { clock scan 01197001002 -format %d%Y%m%j -gmt 1 -} 86400 -test clock-11.4 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.4 {precedence of ccyymmdd over ccyyddd} { clock scan 00219700101 -format %j%Y%m%d -gmt 1 } 0 -test clock-11.5 {precedence of ccyyddd and ccyymmdd} { +test clock-11.5 {precedence of ccyymmdd over ccyyddd} { clock scan 19700100201 -format %Y%m%j%d -gmt 1 } 0 -test clock-11.6 {precedence of ccyyddd and ccyymmdd} { +test clock-11.6 {precedence of ccyymmdd over ccyyddd} { clock scan 01197000201 -format %m%Y%j%d -gmt 1 } 0 -test clock-11.7 {precedence of ccyyddd and ccyymmdd} { +test clock-11.7 {precedence of ccyymmdd over ccyyddd} { clock scan 01197000201 -format %d%Y%j%m -gmt 1 } 0 -test clock-11.8 {precedence of ccyyddd and ccyymmdd} { +test clock-11.8 {precedence of ccyymmdd over ccyyddd} { clock scan 00219700101 -format %j%Y%d%m -gmt 1 } 0 -test clock-11.9 {precedence of ccyyddd and ccyymmdd} { +test clock-11.9 {precedence of ccyymmdd over ccyyddd} { clock scan 19700101002 -format %Y%d%m%j -gmt 1 -} 86400 -test clock-11.10 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.10 {precedence of ccyymmdd over ccyyddd} { clock scan 01011970002 -format %m%d%Y%j -gmt 1 -} 86400 -test clock-11.11 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.11 {precedence of ccyymmdd over ccyyddd} { clock scan 01011970002 -format %d%m%Y%j -gmt 1 -} 86400 -test clock-11.12 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.12 {precedence of ccyymmdd over ccyyddd} { clock scan 00201197001 -format %j%m%Y%d -gmt 1 } 0 -test clock-11.13 {precedence of ccyyddd and ccyymmdd} { +test clock-11.13 {precedence of ccyymmdd over ccyyddd} { clock scan 19700100201 -format %Y%d%j%m -gmt 1 } 0 -test clock-11.14 {precedence of ccyyddd and ccyymmdd} { +test clock-11.14 {precedence of ccyymmdd over ccyyddd} { clock scan 01010021970 -format %m%d%j%Y -gmt 1 -} 86400 -test clock-11.15 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.15 {precedence of ccyymmdd over ccyyddd} { clock scan 01010021970 -format %d%m%j%Y -gmt 1 -} 86400 -test clock-11.16 {precedence of ccyyddd and ccyymmdd} { +} 0 +test clock-11.16 {precedence of ccyymmdd over ccyyddd} { clock scan 00201011970 -format %j%m%d%Y -gmt 1 } 0 -test clock-11.17 {precedence of ccyyddd and ccyymmdd} { +test clock-11.17 {precedence of ccyymmdd over ccyyddd} { clock scan 19700020101 -format %Y%j%m%d -gmt 1 } 0 -test clock-11.18 {precedence of ccyyddd and ccyymmdd} { +test clock-11.18 {precedence of ccyymmdd over ccyyddd} { clock scan 01002197001 -format %m%j%Y%d -gmt 1 } 0 -test clock-11.19 {precedence of ccyyddd and ccyymmdd} { +test clock-11.19 {precedence of ccyymmdd over ccyyddd} { clock scan 01002197001 -format %d%j%Y%m -gmt 1 } 0 -test clock-11.20 {precedence of ccyyddd and ccyymmdd} { +test clock-11.20 {precedence of ccyymmdd over ccyyddd} { clock scan 00201197001 -format %j%d%Y%m -gmt 1 } 0 -test clock-11.21 {precedence of ccyyddd and ccyymmdd} { +test clock-11.21 {precedence of ccyymmdd over ccyyddd} { clock scan 19700020101 -format %Y%j%d%m -gmt 1 } 0 -test clock-11.22 {precedence of ccyyddd and ccyymmdd} { +test clock-11.22 {precedence of ccyymmdd over ccyyddd} { clock scan 01002011970 -format %m%j%d%Y -gmt 1 } 0 -test clock-11.23 {precedence of ccyyddd and ccyymmdd} { +test clock-11.23 {precedence of ccyymmdd over ccyyddd} { clock scan 01002011970 -format %d%j%m%Y -gmt 1 } 0 -test clock-11.24 {precedence of ccyyddd and ccyymmdd} { +test clock-11.24 {precedence of ccyymmdd over ccyyddd} { clock scan 00201011970 -format %j%d%m%Y -gmt 1 } 0 # END testcases11 -- cgit v0.12 From 590e25c971a4f7a6663c82a6c901500c72012cea Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:33:41 +0000 Subject: repaired system/current locale caching (also for legacy clock format) and legacy timezone cached as last --- generic/tclClock.c | 80 ++++++++++++++++++++++++++++++++++++++++++++------- generic/tclClockFmt.c | 4 ++- generic/tclDate.h | 16 +++++------ library/clock.tcl | 24 +++++++++------- 4 files changed, 93 insertions(+), 31 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1a5141b..a84300a 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -383,16 +383,52 @@ NormTimezoneObj( /* *---------------------------------------------------------------------- */ +inline Tcl_Obj * +ClockGetSystemLocale( + ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) { + return NULL; + } + + return Tcl_GetObjResult(interp); +} +/* + *---------------------------------------------------------------------- + */ +inline Tcl_Obj * +ClockGetCurrentLocale( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) { + return NULL; + } + + Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp)); + Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict); + + return dataPtr->CurrentLocale; +} +/* + *---------------------------------------------------------------------- + */ static Tcl_Obj * NormLocaleObj( - ClockClientData *dataPtr, /* Client data containing literal pool */ + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *localeObj, Tcl_Obj **mcDictObj) { const char *loc; if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale - || localeObj == dataPtr->literals[LIT_C] + || localeObj == dataPtr->literals[LIT_C] + || localeObj == dataPtr->literals[LIT_CURRENT] ) { + if (dataPtr->CurrentLocale == NULL) { + ClockGetCurrentLocale(dataPtr, interp); + } *mcDictObj = dataPtr->CurrentLocaleDict; return dataPtr->CurrentLocale; } @@ -404,19 +440,23 @@ NormLocaleObj( } loc = TclGetString(localeObj); - if (dataPtr->CurrentLocale != NULL && - (localeObj == dataPtr->CurrentLocale - || strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0 + if ( dataPtr->CurrentLocale != NULL + && ( localeObj == dataPtr->CurrentLocale + || (localeObj->length == dataPtr->CurrentLocale->length + && strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0 ) + ) ) { *mcDictObj = dataPtr->CurrentLocaleDict; localeObj = dataPtr->CurrentLocale; } else - if (dataPtr->LastUsedLocale != NULL && - (localeObj == dataPtr->LastUsedLocale - || strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0 + if ( dataPtr->LastUsedLocale != NULL + && ( localeObj == dataPtr->LastUsedLocale + || (localeObj->length == dataPtr->LastUsedLocale->length + && strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0 ) + ) ) { *mcDictObj = dataPtr->LastUsedLocaleDict; Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj); @@ -424,12 +464,28 @@ NormLocaleObj( } else if ( - strcmp(loc, Literals[LIT_C]) == 0 + (localeObj->length == 1 /* C */ + && strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0) + || (localeObj->length == 7 /* current */ + && strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0) ) { + if (dataPtr->CurrentLocale == NULL) { + ClockGetCurrentLocale(dataPtr, interp); + } *mcDictObj = dataPtr->CurrentLocaleDict; localeObj = dataPtr->CurrentLocale; } else + if ( + (localeObj->length == 6 /* system */ + && strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0) + ) { + Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj); + localeObj = ClockGetSystemLocale(dataPtr, interp); + Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj); + *mcDictObj = NULL; + } + else { *mcDictObj = NULL; } @@ -450,7 +506,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) /* if locale was not yet used */ if ( !(opts->flags & CLF_LOCALE_USED) ) { - opts->localeObj = NormLocaleObj(opts->clientData, + opts->localeObj = NormLocaleObj(opts->clientData, opts->interp, opts->localeObj, &opts->mcDictObj); if (opts->localeObj == NULL) { @@ -490,6 +546,8 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) } if ( opts->localeObj == dataPtr->CurrentLocale ) { Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj); + } else if ( opts->localeObj == dataPtr->LastUsedLocale ) { + Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj); } else { Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj); Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale); @@ -2717,7 +2775,7 @@ _ClockParseFmtScnArgs( if ((saw & (1 << CLOCK_FORMAT_GMT)) && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { - Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); + Tcl_SetResult(interp, "cannot use -gmt and -timezone in same call", TCL_STATIC); Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index f965a17..5d3dcaf 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1199,7 +1199,9 @@ ClockLocalizeFormat( clean: Tcl_UnsetObjRef(keyObj); - Tcl_ResetResult(opts->interp); + if (valObj) { + Tcl_ResetResult(opts->interp); + } } return (opts->formatObj = valObj); diff --git a/generic/tclDate.h b/generic/tclDate.h index fc922cb..e78d4f8 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -58,9 +58,8 @@ typedef enum ClockLiteral { LIT__NIL, LIT__DEFAULT_FORMAT, - LIT_BCE, LIT_C, - LIT_CANNOT_USE_GMT_AND_TIMEZONE, - LIT_CE, + LIT_SYSTEM, LIT_CURRENT, + LIT_BCE, LIT_C, LIT_CE, LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, LIT_ERA, LIT_GMT, LIT_GREGORIAN, LIT_INTEGER_VALUE_TOO_LARGE, @@ -72,7 +71,8 @@ typedef enum ClockLiteral { LIT_TZDATA, LIT_GETSYSTEMTIMEZONE, LIT_SETUPTIMEZONE, - LIT_MCGET, LIT_TCL_CLOCK, + LIT_MCGET, + LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE, LIT_LOCALIZE_FORMAT, LIT__END } ClockLiteral; @@ -80,9 +80,8 @@ typedef enum ClockLiteral { #define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ "", \ "%a %b %d %H:%M:%S %Z %Y", \ - "BCE", "C", \ - "cannot use -gmt and -timezone in same call", \ - "CE", \ + "system", "current", \ + "BCE", "C", "CE", \ "dayOfMonth", "dayOfWeek", "dayOfYear", \ "era", ":GMT", "gregorian", \ "integer value too large to represent", \ @@ -94,7 +93,8 @@ typedef enum ClockLiteral { "::tcl::clock::TZData", \ "::tcl::clock::GetSystemTimeZone", \ "::tcl::clock::SetupTimeZone", \ - "::tcl::clock::mcget", "::tcl::clock", \ + "::tcl::clock::mcget", \ + "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ "::tcl::clock::LocalizeFormat" \ } diff --git a/library/clock.tcl b/library/clock.tcl index d4e29d5..f874e4d 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -2352,7 +2352,7 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { }] } { # message catalog dictionary: - set mcd [::msgcat::mcget ::tcl::clock $locale] + set mcd [mcget $locale] # Handle locale-dependent format groups by mapping them out of the format # string. Note that the order of the [string map] operations is @@ -3021,21 +3021,23 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { variable LegacyTimeZone - # Check may be a legacy zone: - if { $alias eq {} && ![catch { - set tzname [dict get $LegacyTimeZone [string tolower $timezone]] - }] } { - set tzname [::tcl::clock::SetupTimeZone $tzname $timezone] - set TZData($timezone) $TZData($tzname) - # tell backend - timezone is initialized and return shared timezone object: - return [configure -setup-tz $timezone] - } - # We couldn't parse this as a POSIX time zone. Try again with a # time zone file - this time without a colon if { [catch { LoadTimeZoneFile $timezone }] && [catch { LoadZoneinfoFile $timezone } - opts] } { + + # Check may be a legacy zone: + + if { $alias eq {} && ![catch { + set tzname [dict get $LegacyTimeZone [string tolower $timezone]] + }] } { + set tzname [::tcl::clock::SetupTimeZone $tzname $timezone] + set TZData($timezone) $TZData($tzname) + # tell backend - timezone is initialized and return shared timezone object: + return [configure -setup-tz $timezone] + } + dict unset opts -errorinfo dict set TimeZoneBad $timezone 1 return -options $opts "time zone $timezone not found" -- cgit v0.12 From 33212a94d6d0cfef22ff3aced4795edba0932540 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:34:11 +0000 Subject: bug fix by match word token (FindWordEnd fixed); repaired current locale switch --- generic/tclClockFmt.c | 6 +++--- library/clock.tcl | 8 ++++++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 5d3dcaf..a10d05d 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -609,12 +609,12 @@ FindWordEnd( return ++p; } /* multi-char word */ - while (*p++ == *x++) { - if (x >= tok->tokWord.end || p >= end) { + do + if (*p++ != *x++) { /* no match -> error */ return NULL; } - }; + while (x <= tok->tokWord.end && p < end); return p; } diff --git a/library/clock.tcl b/library/clock.tcl index f874e4d..ca12f4a 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -739,7 +739,7 @@ proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { # Map away the locale-dependent composite format groups - EnterLocale $locale + set locale [EnterLocale $locale] # Change locale if a fresh locale has been given on the command line. @@ -2189,6 +2189,7 @@ proc ::tcl::clock::EnterLocale { locale } { } # Select the locale, eventually load it mcpackagelocale set $locale + return $locale } #---------------------------------------------------------------------- @@ -3028,7 +3029,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { && [catch { LoadZoneinfoFile $timezone } - opts] } { # Check may be a legacy zone: - + if { $alias eq {} && ![catch { set tzname [dict get $LegacyTimeZone [string tolower $timezone]] }] } { @@ -4460,6 +4461,9 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } { #---------------------------------------------------------------------- proc ::tcl::clock::ChangeCurrentLocale {args} { + + configure -default-locale [lindex $args 0] + variable FormatProc variable LocaleNumeralCache -- cgit v0.12 From d17c6cb7e751f5a0c41dc3c759ab5d62ef034aa0 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:34:42 +0000 Subject: clock scan almost ready (currently test-case covered tokens only), test cases passed; todo - check other tokens from "clock.tcl" --- generic/tclClockFmt.c | 54 ++++++++++++++++++++++++++++++++++++++++++++++----- generic/tclDate.h | 16 ++++++++++----- 2 files changed, 60 insertions(+), 10 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index a10d05d..c8158cc 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -748,7 +748,7 @@ ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, amPmObj[0] = ClockMCGet(opts, MCLIT_AM); amPmObj[1] = ClockMCGet(opts, MCLIT_PM); - if (amPmObj[0] == NULL || amPmObj == NULL) { + if (amPmObj[0] == NULL || amPmObj[1] == NULL) { return TCL_ERROR; } @@ -768,6 +768,44 @@ ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, } static int +ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + ClockClientData *dataPtr = opts->clientData; + + int ret, val; + int minLen, maxLen; + Tcl_Obj *eraObj[6]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + eraObj[0] = ClockMCGet(opts, MCLIT_BCE); + eraObj[1] = ClockMCGet(opts, MCLIT_CE); + eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2]; + eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2]; + eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3]; + eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3]; + + if (eraObj[0] == NULL || eraObj[1] == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, eraObj, 6, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val & 1) { + yydate.era = CE; + } else { + yydate.era = BCE; + } + + return TCL_OK; +} + +static int ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { @@ -782,7 +820,9 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, return ret; } - *(time_t *)(((char *)info) + tok->map->offs) = val; + if (tok->map->offs > 0) { + *(time_t *)(((char *)info) + tok->map->offs) = val; + } return TCL_OK; } @@ -931,9 +971,14 @@ static const char *ScnSTokenWrapMapIndex[2] = { }; static const char *ScnETokenMapIndex = - ""; + "Ey"; static ClockScanTokenMap ScnETokenMap[] = { - {0, 0, 0} + /* %EE */ + {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ey */ + {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *ScnETokenWrapMapIndex[2] = { "", @@ -1450,7 +1495,6 @@ ClockScan( } } } - yydate.era = CE; } } diff --git a/generic/tclDate.h b/generic/tclDate.h index e78d4f8..020fa64 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -58,8 +58,8 @@ typedef enum ClockLiteral { LIT__NIL, LIT__DEFAULT_FORMAT, - LIT_SYSTEM, LIT_CURRENT, - LIT_BCE, LIT_C, LIT_CE, + LIT_SYSTEM, LIT_CURRENT, LIT_C, + LIT_BCE, LIT_CE, LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, LIT_ERA, LIT_GMT, LIT_GREGORIAN, LIT_INTEGER_VALUE_TOO_LARGE, @@ -80,8 +80,8 @@ typedef enum ClockLiteral { #define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ "", \ "%a %b %d %H:%M:%S %Z %Y", \ - "system", "current", \ - "BCE", "C", "CE", \ + "system", "current", "C", \ + "BCE", "CE", \ "dayOfMonth", "dayOfWeek", "dayOfYear", \ "era", ":GMT", "gregorian", \ "integer value too large to represent", \ @@ -107,6 +107,9 @@ typedef enum ClockMsgCtLiteral { MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_AM, MCLIT_PM, + MCLIT_BCE, MCLIT_CE, + MCLIT_BCE2, MCLIT_CE2, + MCLIT_BCE3, MCLIT_CE3, MCLIT_LOCALE_NUMERALS, MCLIT__END } ClockMsgCtLiteral; @@ -115,7 +118,10 @@ typedef enum ClockMsgCtLiteral { pref "", \ pref "MONTHS_FULL", pref "MONTHS_ABBREV", \ pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", \ - pref "AM", pref "PM", \ + pref "AM", pref "PM", \ + pref "BCE", pref "CE", \ + pref "b.c.e.", pref "c.e.", \ + pref "b.c.", pref "a.d.", \ pref "LOCALE_NUMERALS", \ } -- cgit v0.12 From 24889011ab71db02d158f21843b71cc3767859fd Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:35:14 +0000 Subject: small optimization (determine min/max length, end distance, etc.) --- generic/tclClockFmt.c | 34 ++++++++++++++++++++++++++++++---- generic/tclDate.h | 3 ++- 2 files changed, 32 insertions(+), 5 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index c8158cc..2873ff7 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -498,13 +498,24 @@ void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, { register const char*p = yyInput; *minLen = 0; - *maxLen = info->dateEnd - p; + /* max length to the end regarding distance to end (min-width of following tokens) */ + *maxLen = info->dateEnd - p - tok->endDistance; /* if no tokens anymore */ if (!(tok+1)->map) { /* should match to end or first space */ while (!isspace(UCHAR(*p)) && ++p < info->dateEnd) {}; *minLen = p - yyInput; + } else + /* next token is a word */ + if ((tok+1)->map->type == CTOKT_WORD) { + /* should match at least to the first char of this word */ + while (*p != *((tok+1)->tokWord.start) && ++p < info->dateEnd) {}; + *minLen = p - yyInput; + } + + if (*minLen > *maxLen) { + *maxLen = *minLen; } } @@ -1018,7 +1029,7 @@ static const char *ScnOTokenWrapMapIndex[2] = { static const char *ScnSpecTokenMapIndex = " "; static ClockScanTokenMap ScnSpecTokenMap[] = { - {CTOKT_SPACE, 0, 0, 1, 0xffff, 0, + {CTOKT_SPACE, 0, 0, 0, 0xffff, 0, NULL}, }; @@ -1131,9 +1142,9 @@ ClockGetOrParseScanFormat( tok->map = &scnMap[cp - mapIndex]; tok->tokWord.start = p; /* calculate look ahead value by standing together tokens */ - if (tok > fss->scnTok) { - ClockScanToken *prevTok = tok - 1; + if (tok > fss->scnTok && tok->map->minSize) { unsigned int lookAhead = tok->map->minSize; + ClockScanToken *prevTok = tok - 1; while (prevTok >= fss->scnTok) { if (prevTok->map->type != tok->map->type) { @@ -1177,6 +1188,21 @@ word_tok: continue; } + /* calculate end distance value for each tokens */ + if (tok > fss->scnTok) { + unsigned int endDist = 0; + ClockScanToken *prevTok = tok-1; + + while (prevTok >= fss->scnTok) { + prevTok->endDistance = endDist; + if (prevTok->map->type != CTOKT_WORD) { + endDist += prevTok->map->minSize; + } else { + endDist += prevTok->tokWord.end - prevTok->tokWord.start + 1; + } + prevTok--; + } + } done: Tcl_MutexUnlock(&ClockFmtMutex); } diff --git a/generic/tclDate.h b/generic/tclDate.h index 020fa64..00bd234 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -389,7 +389,8 @@ typedef struct ClockScanTokenMap { typedef struct ClockScanToken { ClockScanTokenMap *map; - unsigned int lookAhead; + unsigned short int lookAhead; + unsigned short int endDistance; struct { const char *start; const char *end; -- cgit v0.12 From ca7dcb3b5163da655a13b5935c987b3a38067996 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:35:34 +0000 Subject: estimate token count by % char and format length (don't use fix TOK_CHAIN_BLOCK_SIZE by creation, minimized memory usage) --- generic/tclClockFmt.c | 26 +++++++++++++++++++++----- generic/tclDate.h | 2 +- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 2873ff7..ac34e68 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1080,14 +1080,30 @@ ClockGetOrParseScanFormat( const char *strFmt; register const char *p, *e, *cp; + e = strFmt = HashEntry4FmtScn(fss)->key.string; + e += strlen(strFmt); + + /* estimate token count by % char and format length */ + fss->scnTokC = 0; + p = strFmt; + while (p != e) { + if (*p++ == '%') fss->scnTokC++; + } + p = strFmt + fss->scnTokC * 2; + if (p < e) { + if ((e - p) < fss->scnTokC) { + fss->scnTokC += (e - p); + } else { + fss->scnTokC += fss->scnTokC; + } + } + fss->scnTokC++; + Tcl_MutexLock(&ClockFmtMutex); - fss->scnTokC = CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; - fss->scnTok = - tok = ckalloc(sizeof(*tok) * CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE); + fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); memset(tok, 0, sizeof(*(tok))); - strFmt = HashEntry4FmtScn(fss)->key.string; - for (e = p = strFmt, e += strlen(strFmt); p != e; p++) { + for (p = strFmt; p != e; p++) { switch (*p) { case '%': if (1) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 00bd234..9e1c506 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -355,7 +355,7 @@ typedef enum _MERIDIAN { #define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 -#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 12 +#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2 typedef struct ClockScanToken ClockScanToken; -- cgit v0.12 From 6a0616f572c4e550427bf6b6e80b874166c5e3fe Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:36:19 +0000 Subject: cacheable conversions Local2UTC / UTC2Local fixed (some TZ switches time seconds bound) and optimized (last period ranges saved); prepare to back-port clock format --- generic/tclClock.c | 265 +++++++++++++++++++++++++++++++++------------- generic/tclClockFmt.c | 287 +++++++++++++++++++++++++++++++++++++++++++++++++- generic/tclDate.h | 28 ++++- library/clock.tcl | 14 --- 4 files changed, 502 insertions(+), 92 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a84300a..0c08391 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -72,19 +72,21 @@ TCL_DECLARE_MUTEX(clockMutex) static int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt rangesVal[2]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt rangesVal[2]); 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 *); + int, Tcl_Obj *const *, Tcl_WideInt rangesVal[2]); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -1432,6 +1434,7 @@ ConvertLocalToUTC( Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + Tcl_WideInt seconds; /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) { @@ -1442,17 +1445,37 @@ ConvertLocalToUTC( /* * Check cacheable conversion could be used - * (last-minute Local2UTC cache with the same TZ) + * (last-period Local2UTC cache within the same TZ) */ + seconds = fields->localSeconds - dataPtr->Local2UTC.tzOffset; if ( timezoneObj == dataPtr->Local2UTC.timezoneObj && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds - || fields->localSeconds / 60 == dataPtr->Local2UTC.localSeconds / 60 + || ( seconds >= dataPtr->Local2UTC.rangesVal[0] + && seconds < dataPtr->Local2UTC.rangesVal[1]) ) && changeover == dataPtr->Local2UTC.changeover ) { /* the same time zone and offset (UTC time inside the last minute) */ fields->tzOffset = dataPtr->Local2UTC.tzOffset; - fields->seconds = fields->localSeconds - fields->tzOffset; + fields->seconds = seconds; + return TCL_OK; + } + + /* + * Check cacheable back-conversion could be used + * (last-period UTC2Local cache within the same TZ) + */ + seconds = fields->localSeconds - dataPtr->UTC2Local.tzOffset; + if ( timezoneObj == dataPtr->UTC2Local.timezoneObj + && ( seconds == dataPtr->UTC2Local.seconds + || ( seconds >= dataPtr->UTC2Local.rangesVal[0] + && seconds < dataPtr->UTC2Local.rangesVal[1]) + ) + && changeover == dataPtr->UTC2Local.changeover + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = dataPtr->UTC2Local.tzOffset; + fields->seconds = seconds; return TCL_OK; } @@ -1475,11 +1498,15 @@ ConvertLocalToUTC( */ if (rowc == 0) { + dataPtr->Local2UTC.rangesVal[0] = 0; + dataPtr->Local2UTC.rangesVal[1] = 0; + if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { return TCL_ERROR; }; } else { - if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv) != TCL_OK) { + if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, + dataPtr->Local2UTC.rangesVal) != TCL_OK) { return TCL_ERROR; }; } @@ -1516,7 +1543,8 @@ ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ int rowc, /* Number of points at which time changes */ - Tcl_Obj *const rowv[]) /* Points at which time changes */ + Tcl_Obj *const rowv[], /* Points at which time changes */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { Tcl_Obj *row; int cellc; @@ -1540,7 +1568,8 @@ ConvertLocalToUTCUsingTable( fields->tzOffset = 0; fields->seconds = fields->localSeconds; while (!found) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, + rangesVal); if ((row == NULL) || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK @@ -1730,11 +1759,12 @@ ConvertUTCToLocal( /* * Check cacheable conversion could be used - * (last-minute UTC2Local cache with the same TZ) + * (last-period UTC2Local cache within the same TZ) */ if ( timezoneObj == dataPtr->UTC2Local.timezoneObj && ( fields->seconds == dataPtr->UTC2Local.seconds - || fields->seconds / 60 == dataPtr->UTC2Local.seconds / 60 + || ( fields->seconds >= dataPtr->UTC2Local.rangesVal[0] + && fields->seconds < dataPtr->UTC2Local.rangesVal[1]) ) && changeover == dataPtr->UTC2Local.changeover ) { @@ -1764,11 +1794,15 @@ ConvertUTCToLocal( */ if (rowc == 0) { + dataPtr->UTC2Local.rangesVal[0] = 0; + dataPtr->UTC2Local.rangesVal[1] = 0; + if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { return TCL_ERROR; } } else { - if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv) != TCL_OK) { + if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, + dataPtr->UTC2Local.rangesVal) != TCL_OK) { return TCL_ERROR; } } @@ -1806,7 +1840,8 @@ ConvertUTCToLocalUsingTable( TclDateFields *fields, /* Fields of the date */ int rowc, /* Number of rows in the conversion table * (>= 1) */ - Tcl_Obj *const rowv[]) /* Rows of the conversion table */ + Tcl_Obj *const rowv[], /* Rows of the conversion table */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { Tcl_Obj *row; /* Row containing the current information */ int cellc; /* Count of cells in the row (must be 4) */ @@ -1816,7 +1851,7 @@ ConvertUTCToLocalUsingTable( * Look up the nearest transition time. */ - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal); if (row == NULL || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -1943,12 +1978,13 @@ LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ int rowc, /* Number of rows of tzdata */ - Tcl_Obj *const *rowv) /* Rows in tzdata */ + Tcl_Obj *const *rowv, /* Rows in tzdata */ + Tcl_WideInt rangesVal[2]) /* Return bounds for time period */ { - int l; + int l = 0; int u; Tcl_Obj *compObj; - Tcl_WideInt compVal; + Tcl_WideInt compVal, fromVal = tick, toVal = tick; /* * Examine the first row to make sure we're in bounds. @@ -1965,14 +2001,13 @@ LookupLastTransition( */ if (tick < compVal) { - return rowv[0]; + goto done; } /* * Binary-search to find the transition. */ - l = 0; u = rowc-1; while (l < u) { int m = (l + u + 1) / 2; @@ -1983,10 +2018,19 @@ LookupLastTransition( } if (tick >= compVal) { l = m; + fromVal = compVal; } else { u = m-1; + toVal = compVal; } } + +done: + + if (rangesVal) { + rangesVal[0] = fromVal; + rangesVal[1] = toVal; + } return rowv[l]; } @@ -2713,7 +2757,7 @@ _ClockParseFmtScnArgs( Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ - ClockFmtScnCmdArgs *resOpts, /* Result vector: format, locale, timezone... */ + ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ int forScan /* Flag to differentiate between format and scan */ ) { ClockClientData *dataPtr = clientData; @@ -2739,7 +2783,7 @@ _ClockParseFmtScnArgs( * Extract values for the keywords. */ - memset(resOpts, 0, sizeof(*resOpts)); + memset(opts, 0, sizeof(*opts)); for (i = 2; i < objc; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options[forScan], "option", 0, &optionIndex) != TCL_OK) { @@ -2749,7 +2793,7 @@ _ClockParseFmtScnArgs( } switch (optionIndex) { case CLOCK_FORMAT_FORMAT: - resOpts->formatObj = objv[i+1]; + opts->formatObj = objv[i+1]; break; case CLOCK_FORMAT_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ @@ -2757,13 +2801,13 @@ _ClockParseFmtScnArgs( } break; case CLOCK_FORMAT_LOCALE: - resOpts->localeObj = objv[i+1]; + opts->localeObj = objv[i+1]; break; case CLOCK_FORMAT_TIMEZONE: - resOpts->timezoneObj = objv[i+1]; + opts->timezoneObj = objv[i+1]; break; case CLOCK_FORMAT_BASE: - resOpts->baseObj = objv[i+1]; + opts->baseObj = objv[i+1]; break; } saw |= 1 << optionIndex; @@ -2780,11 +2824,30 @@ _ClockParseFmtScnArgs( return TCL_ERROR; } if (gmtFlag) { - resOpts->timezoneObj = litPtr[LIT_GMT]; + opts->timezoneObj = litPtr[LIT_GMT]; + } + + opts->clientData = clientData; + opts->interp = interp; + + /* If time zone not specified use system time zone */ + + if ( opts->timezoneObj == NULL + || TclGetString(opts->timezoneObj) == NULL + || opts->timezoneObj->length == 0 + ) { + opts->timezoneObj = ClockGetSystemTimeZone(clientData, interp); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } } - resOpts->clientData = clientData; - resOpts->interp = interp; + /* Setup timezone (normalize object if needed and load TZ on demand) */ + + opts->timezoneObj = ClockSetupTimeZone(clientData, interp, opts->timezoneObj); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } return TCL_OK; } @@ -2816,7 +2879,7 @@ ClockParseformatargsObjCmd( { ClockClientData *dataPtr = clientData; Tcl_Obj **literals = dataPtr->literals; - ClockFmtScnCmdArgs resOpts; /* Format, locale and timezone */ + ClockFmtScnCmdArgs opts; /* Format, locale and timezone */ Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int ret; @@ -2837,7 +2900,7 @@ ClockParseformatargsObjCmd( */ ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, - &resOpts, 0); + &opts, 0); if (ret != TCL_OK) { return ret; } @@ -2849,18 +2912,110 @@ ClockParseformatargsObjCmd( if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { return TCL_ERROR; } - if (resOpts.formatObj == NULL) - resOpts.formatObj = literals[LIT__DEFAULT_FORMAT]; - if (resOpts.localeObj == NULL) - resOpts.localeObj = literals[LIT_C]; - if (resOpts.timezoneObj == NULL) - resOpts.timezoneObj = literals[LIT__NIL]; + if (opts.formatObj == NULL) + opts.formatObj = literals[LIT__DEFAULT_FORMAT]; + if (opts.localeObj == NULL) + opts.localeObj = literals[LIT_C]; + if (opts.timezoneObj == NULL) + opts.timezoneObj = literals[LIT__NIL]; /* * Return options as a list. */ - Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&resOpts.formatObj)); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&opts.formatObj)); + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockFormatObjCmd - + * + *---------------------------------------------------------------------- + */ + +int +ClockFormatObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = clientData; + + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + Tcl_WideInt clockVal; /* Time, expressed in seconds from the Epoch */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, "string " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + /* + * Extract values for the keywords. + */ + + ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, + &opts, 0); + if (ret != TCL_OK) { + return ret; + } + + ret = TCL_ERROR; + + if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { + return TCL_ERROR; + } + + + ClockInitDateInfo(info); + yydate.tzName = NULL; + + /* + * Extract year, month and day from the base time for the parser to use as + * defaults + */ + + /* check base fields already cached (by TZ, last-second cache) */ + if ( dataPtr->lastBase.timezoneObj == opts.timezoneObj + && dataPtr->lastBase.Date.seconds == clockVal) { + memcpy(&yydate, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); + } else { + /* extact fields from base */ + yydate.seconds = clockVal; + if (ClockGetDateFields(clientData, interp, &yydate, opts.timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { + goto done; + } + /* cache last base */ + memcpy(&dataPtr->lastBase.Date, &yydate, ClockCacheableDateFieldsSize); + Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts.timezoneObj); + } + + /* Default format */ + if (opts.formatObj == NULL) { + opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT]; + } + + /* Use compiled version of Format - */ + + ret = ClockFormat(clientData, interp, info, &opts); + +done: + + Tcl_UnsetObjRef(yydate.tzName); + + if (ret != TCL_OK) { + return ret; + } + return TCL_OK; } @@ -2879,7 +3034,6 @@ ClockScanObjCmd( Tcl_Obj *const objv[]) /* Parameter values */ { ClockClientData *dataPtr = clientData; - Tcl_Obj **literals = dataPtr->literals; int ret; ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ @@ -2919,29 +3073,9 @@ ClockScanObjCmd( baseVal = (Tcl_WideInt) now.sec; } - /* If time zone not specified use system time zone */ - if ( opts.timezoneObj == NULL - || TclGetString(opts.timezoneObj) == NULL - || opts.timezoneObj->length == 0 - ) { - opts.timezoneObj = ClockGetSystemTimeZone(clientData, interp); - if (opts.timezoneObj == NULL) { - return TCL_ERROR; - } - } - - /* Setup timezone (normalize object id needed and load TZ on demand) */ - - opts.timezoneObj = ClockSetupTimeZone(clientData, interp, opts.timezoneObj); - if (opts.timezoneObj == NULL) { - return TCL_ERROR; - } - ClockInitDateInfo(info); yydate.tzName = NULL; - // Tcl_SetObjRef(yydate.tzName, opts.timezoneObj); - /* * Extract year, month and day from the base time for the parser to use as * defaults @@ -2979,20 +3113,6 @@ ClockScanObjCmd( } ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); } -#if 0 - else - if (1) { - /* TODO: Tcled Scan proc - */ - int ret; - Tcl_Obj *callargs[10]; - memcpy(callargs, objv, objc * sizeof(*objv)); - callargs[0] = Tcl_NewStringObj("::tcl::clock::__org_scan", -1); - Tcl_IncrRefCount(callargs[0]); - ret = Tcl_EvalObjv(interp, objc, callargs, 0); - Tcl_DecrRefCount(callargs[0]); - return ret; - } -#endif else { /* Use compiled version of Scan - */ @@ -3073,7 +3193,6 @@ ClockFreeScan( ClockFmtScnCmdArgs *opts) /* Command options */ { ClockClientData *dataPtr = clientData; - // Tcl_Obj **literals = dataPtr->literals; int ret = TCL_ERROR; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index ac34e68..5469ee1 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1091,7 +1091,7 @@ ClockGetOrParseScanFormat( } p = strFmt + fss->scnTokC * 2; if (p < e) { - if ((e - p) < fss->scnTokC) { + if ((unsigned int)(e - p) < fss->scnTokC) { fss->scnTokC += (e - p); } else { fss->scnTokC += fss->scnTokC; @@ -1581,6 +1581,291 @@ done: return ret; } +/* + *---------------------------------------------------------------------- + */ +int +ClockFormat( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + register DateInfo *info, /* Date fields used for parsing & converting */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockClientData *dataPtr = clientData; + ClockFormatToken *tok; + ClockFormatTokenMap *map; + + /* get localized format */ + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + +/* if ((tok = ClockGetOrParseFmtFormat(interp, opts->formatObj)) == NULL) { + return TCL_ERROR; + } +*/ +#if 0 + /* prepare parsing */ + + yyMeridian = MER24; + + p = TclGetString(strObj); + end = p + strObj->length; + /* in strict mode - bypass spaces at begin / end only (not between tokens) */ + if (opts->flags & CLF_STRICT) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } + } + info->dateStart = yyInput = p; + info->dateEnd = end; + + /* parse string */ + for (; tok->map != NULL; tok++) { + map = tok->map; + /* bypass spaces at begin of input before parsing each token */ + if ( !(opts->flags & CLF_STRICT) + && (map->type != CTOKT_SPACE && map->type != CTOKT_WORD) + ) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } + } + yyInput = p; + switch (map->type) + { + case CTOKT_DIGIT: + if (1) { + int size = map->maxSize; + int sign = 1; + if (map->flags & CLF_SIGNED) { + if (*p == '+') { yyInput = ++p; } + else + if (*p == '-') { yyInput = ++p; sign = -1; }; + } + /* greedy find digits (look for forward digits consider spaces), + * corresponding pre-calculated lookAhead */ + if (size != map->minSize && tok->lookAhead) { + int spcnt = 0; + const char *pe; + size += tok->lookAhead; + x = p + size; if (x > end) { x = end; }; + pe = x; + while (p < x) { + if (isspace(UCHAR(*p))) { + if (pe > p) { pe = p; }; + if (x < end) x++; + p++; + spcnt++; + continue; + } + if (isdigit(UCHAR(*p))) { + p++; + continue; + } + break; + } + /* consider reserved (lookAhead) for next tokens */ + p -= tok->lookAhead + spcnt; + if (p > pe) { + p = pe; + } + } else { + x = p + size; if (x > end) { x = end; }; + while (isdigit(UCHAR(*p)) && p < x) { p++; }; + } + size = p - yyInput; + if (size < map->minSize) { + /* missing input -> error */ + goto not_match; + } + /* string 2 number, put number into info structure by offset */ + p = yyInput; x = p + size; + if (!(map->flags & CLF_LOCALSEC)) { + if (_str2int((time_t *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } + flags = (flags & ~map->clearFlags) | map->flags; + } + break; + case CTOKT_PARSER: + switch (map->parser(opts, info, tok)) { + case TCL_OK: + break; + case TCL_RETURN: + goto not_match; + break; + default: + goto done; + break; + }; + p = yyInput; + flags = (flags & ~map->clearFlags) | map->flags; + break; + case CTOKT_SPACE: + /* at least one space in strict mode */ + if (opts->flags & CLF_STRICT) { + if (!isspace(UCHAR(*p))) { + /* unmatched -> error */ + goto not_match; + } + p++; + } + while (p < end && isspace(UCHAR(*p))) { + p++; + } + break; + case CTOKT_WORD: + x = FindWordEnd(tok, p, end); + if (!x) { + /* no match -> error */ + goto not_match; + } + p = x; + continue; + break; + } + } + + /* ignore spaces at end */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + /* check end was reached */ + if (p < end) { + /* something after last token - wrong format */ + goto not_match; + } + + /* + * Invalidate result + */ + + /* seconds token (%s) take precedence over all other tokens */ + if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { + if (flags & CLF_DATE) { + + if (!(flags & CLF_JULIANDAY)) { + info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; + + /* dd precedence below ddd */ + switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { + case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* miss month: ddd over dd (without month) */ + flags &= ~CLF_DAYOFMONTH; + case (CLF_DAYOFYEAR): + /* ddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* both available: mmdd over ddd */ + flags &= ~CLF_DAYOFYEAR; + case (CLF_MONTH|CLF_DAYOFMONTH): + case (CLF_DAYOFMONTH): + /* mmdd / dd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + } + + /* YearWeekDay below YearMonthDay */ + if ( (flags & CLF_ISO8601) + && ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR) + || (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH) + ) + ) { + /* yy precedence below yyyy */ + if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) { + /* normally precedence of ISO is higher, but no century - so put it down */ + flags &= ~CLF_ISO8601; + } + else + /* yymmdd or yyddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + } + + if (!(flags & CLF_ISO8601)) { + if (yyYear < 100) { + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; + } + } + } else { + if (info->date.iso8601Year < 100) { + if (!(flags & CLF_ISO8601CENTURY)) { + if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) { + info->date.iso8601Year -= 100; + } + info->date.iso8601Year += dataPtr->currentYearCentury; + } else { + info->date.iso8601Year += info->dateCentury * 100; + } + } + } + } + } + + /* if no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yydate.localSeconds = 0; + } + + if (flags & CLF_TIME) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + } else + if (!(flags & CLF_LOCALSEC)) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + } + } + + /* tell caller which flags were set */ + info->flags |= flags; + + ret = TCL_OK; + goto done; + +overflow: + + Tcl_SetResult(interp, "requested date too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); + goto done; + +not_match: + + Tcl_SetResult(interp, "input string does not match supplied format", + TCL_STATIC); + Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); + +done: + + return ret; +#endif +} + MODULE_SCOPE void ClockFrmScnClearCaches(void) diff --git a/generic/tclDate.h b/generic/tclDate.h index 9e1c506..112ed31 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -2,7 +2,7 @@ * tclDate.h -- * * This header file handles common usage of clock primitives - * between tclDate.c (yacc) and tclClock.c. + * between tclDate.c (yacc), tclClock.c and tclClockFmt.c. * * Copyright (c) 2014 Serg G. Brester (aka sebres) * @@ -317,22 +317,24 @@ typedef struct ClockClientData { Tcl_Obj *timezoneObj; TclDateFields Date; } lastBase; - /* Las-minute cache for fast UTC2Local conversion */ + /* Las-period cache for fast UTC2Local conversion */ struct { /* keys */ Tcl_Obj *timezoneObj; int changeover; Tcl_WideInt seconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ /* values */ time_t tzOffset; Tcl_Obj *tzName; } UTC2Local; - /* Las-minute cache for fast Local2UTC conversion */ + /* Las-period cache for fast Local2UTC conversion */ struct { /* keys */ Tcl_Obj *timezoneObj; int changeover; Tcl_WideInt localSeconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ /* values */ time_t tzOffset; } Local2UTC; @@ -372,8 +374,22 @@ typedef enum _CLCKTOK_TYPE { typedef struct ClockFmtScnStorage ClockFmtScnStorage; +typedef struct ClockFormatTokenMap { + unsigned short int type; + unsigned short int flags; + unsigned short int clearFlags; + unsigned short int minSize; + unsigned short int maxSize; + unsigned short int offs; + ClockScanTokenProc *parser; + void *data; +} ClockFormatTokenMap; typedef struct ClockFormatToken { - CLCKTOK_TYPE type; + ClockFormatTokenMap *map; + struct { + const char *start; + const char *end; + } tokWord; } ClockFormatToken; typedef struct ClockScanTokenMap { @@ -447,10 +463,14 @@ MODULE_SCOPE ClockFmtScnStorage * Tcl_Obj *objPtr); MODULE_SCOPE Tcl_Obj * ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); + MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); +MODULE_SCOPE int ClockFormat(ClientData clientData, Tcl_Interp *interp, + register DateInfo *info, ClockFmtScnCmdArgs *opts); + MODULE_SCOPE void ClockFrmScnClearCaches(void); /* diff --git a/library/clock.tcl b/library/clock.tcl index ca12f4a..c4e698c 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -685,20 +685,6 @@ proc ::tcl::clock::format { args } { set locale [string tolower $locale] set clockval [lindex $args 0] - # Get the data for time changes in the given zone - - if {$timezone eq ""} { - if {[set timezone [configure -system-tz]] eq ""} { - set timezone [GetSystemTimeZone] - } - } - if {![info exists TZData($timezone)]} { - if {[catch {set timezone [SetupTimeZone $timezone]} retval opts]} { - dict unset opts -errorinfo - return -options $opts $retval - } - } - # Build a procedure to format the result. Cache the built procedure's name # in the 'FormatProc' array to avoid losing its internal representation, # which contains the name resolution. -- cgit v0.12 From 2561cb41c0da4522531af13b664373518e0b8008 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:37:40 +0000 Subject: string index tree for fast greedy search of the string (index) by unique string prefix as key; clock scan rewritten to use string index tries search; --- generic/tclClock.c | 74 ++++--- generic/tclClockFmt.c | 444 ++++++++++++++++------------------------- generic/tclDate.h | 22 +- generic/tclStrIdxTree.c | 519 ++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStrIdxTree.h | 134 +++++++++++++ unix/Makefile.in | 4 + win/Makefile.in | 1 + win/makefile.vc | 1 + 8 files changed, 865 insertions(+), 334 deletions(-) create mode 100644 generic/tclStrIdxTree.c create mode 100644 generic/tclStrIdxTree.h diff --git a/generic/tclClock.c b/generic/tclClock.c index 0c08391..e52b2e7 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -15,6 +15,7 @@ */ #include "tclInt.h" +#include "tclStrIdxTree.h" #include "tclDate.h" /* @@ -140,6 +141,10 @@ static unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); +static int ClockTestObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); + /* * Structure containing description of "native" clock commands to create. */ @@ -169,6 +174,7 @@ static const struct ClockCommand clockCommands[] = { { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, { "ParseFormatArgs", ClockParseformatargsObjCmd }, + { "_test", TclStrIdxTreeTestObjCmd }, { NULL, NULL } }; @@ -584,7 +590,7 @@ ClockMCGet( } MODULE_SCOPE Tcl_Obj * -ClockMCGetListIdxDict( +ClockMCGetIdx( ClockFmtScnCmdArgs *opts, int mcKey) { @@ -598,53 +604,45 @@ ClockMCGetListIdxDict( return NULL; } - /* try to get indices dictionray, - * if not available - create from list */ + /* try to get indices object */ + if (dataPtr->mcLitIdxs == NULL) { + return NULL; + } if (Tcl_DictObjGet(NULL, opts->mcDictObj, dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK ) { - Tcl_Obj **lstv, *intObj; - int i, lstc; + return NULL; + } - if (dataPtr->mcLitIdxs == NULL) { - dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); - for (i = 0; i < MCLIT__END; ++i) { - Tcl_InitObjRef(dataPtr->mcLitIdxs[i], - Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); - } - } + return valObj; +} - if (Tcl_DictObjGet(opts->interp, opts->mcDictObj, - dataPtr->mcLiterals[mcKey], &valObj) != TCL_OK) { - return NULL; - }; - if (TclListObjGetElements(opts->interp, valObj, - &lstc, &lstv) != TCL_OK) { - return NULL; - }; +MODULE_SCOPE int +ClockMCSetIdx( + ClockFmtScnCmdArgs *opts, + int mcKey, Tcl_Obj *valObj) +{ + ClockClientData *dataPtr = opts->clientData; - valObj = Tcl_NewDictObj(); - for (i = 0; i < lstc; i++) { - intObj = Tcl_NewIntObj(i); - if (Tcl_DictObjPut(opts->interp, valObj, - lstv[i], intObj) != TCL_OK - ) { - Tcl_DecrRefCount(valObj); - Tcl_DecrRefCount(intObj); - return NULL; - } - }; + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return TCL_ERROR; + } - if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, - dataPtr->mcLitIdxs[mcKey], valObj) != TCL_OK - ) { - Tcl_DecrRefCount(valObj); - return NULL; + /* if literal storage for indices not yet created */ + if (dataPtr->mcLitIdxs == NULL) { + int i; + dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < MCLIT__END; ++i) { + Tcl_InitObjRef(dataPtr->mcLitIdxs[i], + Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); } - }; + } - return valObj; + return Tcl_DictObjPut(opts->interp, opts->mcDictObj, + dataPtr->mcLitIdxs[mcKey], valObj); } /* diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 5469ee1..e66c525 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -11,6 +11,7 @@ */ #include "tclInt.h" +#include "tclStrIdxTree.h" #include "tclDate.h" /* @@ -33,6 +34,9 @@ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); static void ClockFrmScnFinalize(ClientData clientData); +/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); + /* * Clock scan and format facilities. */ @@ -583,6 +587,139 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, minLen, maxLen); } +static TclStrIdxTree * +ClockMCGetListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + goto done; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +static TclStrIdxTree * +ClockMCGetMultiListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey, + int *mcKeys) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + while (*mcKeys) { + + valObj = ClockMCGet(opts, *mcKeys); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + goto done; + } + mcKeys++; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +inline int +ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, TclStrIdxTree *idxTree, int *val, + int minLen, int maxLen) +{ + const char *f; + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(NULL, &foundItem, idxTree, + yyInput, yyInput + maxLen); + + if (f <= yyInput || (f - yyInput) < minLen) { + /* not found */ + return TCL_RETURN; + } + if (foundItem->value == -1) { + /* ambigous */ + return TCL_RETURN; + } + + *val = foundItem->value; + + /* shift input pointer */ + yyInput = f; + + return TCL_OK; +} + static int StaticListSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, const char **lst, int *val) @@ -612,21 +749,19 @@ FindWordEnd( register const char * p, const char * end) { register const char *x = tok->tokWord.start; - if (x == tok->tokWord.end) { /* single char word */ - if (*p != *x) { - /* no match -> error */ - return NULL; + const char *pfnd; + if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */ + if (*p == *x) { + return ++p; } - return ++p; } /* multi-char word */ - do - if (*p++ != *x++) { - /* no match -> error */ - return NULL; - } - while (x <= tok->tokWord.end && p < end); - return p; + x = TclUtfFindEqualNC(x, tok->tokWord.end, p, end, &pfnd); + if (x < tok->tokWord.end) { + /* no match -> error */ + return NULL; + } + return pfnd; } static int @@ -822,11 +957,18 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, { int ret, val; int minLen, maxLen; + TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); - ret = LocaleListSearch(opts, info, (int)tok->map->data, &val, - minLen, maxLen); + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetListIdxTree(opts, (int)tok->map->data /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -1120,7 +1262,8 @@ ClockGetOrParseScanFormat( /* begin new word token - don't join with previous word token, * because current mapping should be "...%%..." -> "...%..." */ tok->map = &ScnWordTokenMap; - tok->tokWord.start = tok->tokWord.end = p; + tok->tokWord.start = p; + tok->tokWord.end = p+1; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); continue; break; @@ -1190,7 +1333,7 @@ word_tok: if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { wordTok = tok-1; } - wordTok->tokWord.end = p; + wordTok->tokWord.end = p+1; if (wordTok == tok) { wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; @@ -1214,7 +1357,7 @@ word_tok: if (prevTok->map->type != CTOKT_WORD) { endDist += prevTok->map->minSize; } else { - endDist += prevTok->tokWord.end - prevTok->tokWord.start + 1; + endDist += prevTok->tokWord.end - prevTok->tokWord.start; } prevTok--; } @@ -1325,6 +1468,11 @@ ClockScan( yyMeridian = MER24; + /* lower case given string into new object */ + strObj = Tcl_NewStringObj(TclGetString(strObj), strObj->length); + Tcl_IncrRefCount(strObj); + strObj->length = Tcl_UtfToLower(TclGetString(strObj)); + p = TclGetString(strObj); end = p + strObj->length; /* in strict mode - bypass spaces at begin / end only (not between tokens) */ @@ -1578,6 +1726,8 @@ not_match: done: + Tcl_DecrRefCount(strObj); + return ret; } @@ -1604,266 +1754,6 @@ ClockFormat( return TCL_ERROR; } */ -#if 0 - /* prepare parsing */ - - yyMeridian = MER24; - - p = TclGetString(strObj); - end = p + strObj->length; - /* in strict mode - bypass spaces at begin / end only (not between tokens) */ - if (opts->flags & CLF_STRICT) { - while (p < end && isspace(UCHAR(*p))) { - p++; - } - } - info->dateStart = yyInput = p; - info->dateEnd = end; - - /* parse string */ - for (; tok->map != NULL; tok++) { - map = tok->map; - /* bypass spaces at begin of input before parsing each token */ - if ( !(opts->flags & CLF_STRICT) - && (map->type != CTOKT_SPACE && map->type != CTOKT_WORD) - ) { - while (p < end && isspace(UCHAR(*p))) { - p++; - } - } - yyInput = p; - switch (map->type) - { - case CTOKT_DIGIT: - if (1) { - int size = map->maxSize; - int sign = 1; - if (map->flags & CLF_SIGNED) { - if (*p == '+') { yyInput = ++p; } - else - if (*p == '-') { yyInput = ++p; sign = -1; }; - } - /* greedy find digits (look for forward digits consider spaces), - * corresponding pre-calculated lookAhead */ - if (size != map->minSize && tok->lookAhead) { - int spcnt = 0; - const char *pe; - size += tok->lookAhead; - x = p + size; if (x > end) { x = end; }; - pe = x; - while (p < x) { - if (isspace(UCHAR(*p))) { - if (pe > p) { pe = p; }; - if (x < end) x++; - p++; - spcnt++; - continue; - } - if (isdigit(UCHAR(*p))) { - p++; - continue; - } - break; - } - /* consider reserved (lookAhead) for next tokens */ - p -= tok->lookAhead + spcnt; - if (p > pe) { - p = pe; - } - } else { - x = p + size; if (x > end) { x = end; }; - while (isdigit(UCHAR(*p)) && p < x) { p++; }; - } - size = p - yyInput; - if (size < map->minSize) { - /* missing input -> error */ - goto not_match; - } - /* string 2 number, put number into info structure by offset */ - p = yyInput; x = p + size; - if (!(map->flags & CLF_LOCALSEC)) { - if (_str2int((time_t *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; - } - p = x; - } else { - if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; - } - p = x; - } - flags = (flags & ~map->clearFlags) | map->flags; - } - break; - case CTOKT_PARSER: - switch (map->parser(opts, info, tok)) { - case TCL_OK: - break; - case TCL_RETURN: - goto not_match; - break; - default: - goto done; - break; - }; - p = yyInput; - flags = (flags & ~map->clearFlags) | map->flags; - break; - case CTOKT_SPACE: - /* at least one space in strict mode */ - if (opts->flags & CLF_STRICT) { - if (!isspace(UCHAR(*p))) { - /* unmatched -> error */ - goto not_match; - } - p++; - } - while (p < end && isspace(UCHAR(*p))) { - p++; - } - break; - case CTOKT_WORD: - x = FindWordEnd(tok, p, end); - if (!x) { - /* no match -> error */ - goto not_match; - } - p = x; - continue; - break; - } - } - - /* ignore spaces at end */ - while (p < end && isspace(UCHAR(*p))) { - p++; - } - /* check end was reached */ - if (p < end) { - /* something after last token - wrong format */ - goto not_match; - } - - /* - * Invalidate result - */ - - /* seconds token (%s) take precedence over all other tokens */ - if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { - if (flags & CLF_DATE) { - - if (!(flags & CLF_JULIANDAY)) { - info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; - - /* dd precedence below ddd */ - switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { - case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): - /* miss month: ddd over dd (without month) */ - flags &= ~CLF_DAYOFMONTH; - case (CLF_DAYOFYEAR): - /* ddd over naked weekday */ - if (!(flags & CLF_ISO8601YEAR)) { - flags &= ~CLF_ISO8601; - } - break; - case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH): - /* both available: mmdd over ddd */ - flags &= ~CLF_DAYOFYEAR; - case (CLF_MONTH|CLF_DAYOFMONTH): - case (CLF_DAYOFMONTH): - /* mmdd / dd over naked weekday */ - if (!(flags & CLF_ISO8601YEAR)) { - flags &= ~CLF_ISO8601; - } - break; - } - - /* YearWeekDay below YearMonthDay */ - if ( (flags & CLF_ISO8601) - && ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR) - || (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH) - ) - ) { - /* yy precedence below yyyy */ - if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) { - /* normally precedence of ISO is higher, but no century - so put it down */ - flags &= ~CLF_ISO8601; - } - else - /* yymmdd or yyddd over naked weekday */ - if (!(flags & CLF_ISO8601YEAR)) { - flags &= ~CLF_ISO8601; - } - } - - if (!(flags & CLF_ISO8601)) { - if (yyYear < 100) { - if (!(flags & CLF_CENTURY)) { - if (yyYear >= dataPtr->yearOfCenturySwitch) { - yyYear -= 100; - } - yyYear += dataPtr->currentYearCentury; - } else { - yyYear += info->dateCentury * 100; - } - } - } else { - if (info->date.iso8601Year < 100) { - if (!(flags & CLF_ISO8601CENTURY)) { - if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) { - info->date.iso8601Year -= 100; - } - info->date.iso8601Year += dataPtr->currentYearCentury; - } else { - info->date.iso8601Year += info->dateCentury * 100; - } - } - } - } - } - - /* if no time - reset time */ - if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { - info->flags |= CLF_ASSEMBLE_SECONDS; - yydate.localSeconds = 0; - } - - if (flags & CLF_TIME) { - info->flags |= CLF_ASSEMBLE_SECONDS; - yySeconds = ToSeconds(yyHour, yyMinutes, - yySeconds, yyMeridian); - } else - if (!(flags & CLF_LOCALSEC)) { - info->flags |= CLF_ASSEMBLE_SECONDS; - yySeconds = yydate.localSeconds % SECONDS_PER_DAY; - } - } - - /* tell caller which flags were set */ - info->flags |= flags; - - ret = TCL_OK; - goto done; - -overflow: - - Tcl_SetResult(interp, "requested date too large to represent", - TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); - goto done; - -not_match: - - Tcl_SetResult(interp, "input string does not match supplied format", - TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); - -done: - - return ret; -#endif } diff --git a/generic/tclDate.h b/generic/tclDate.h index 112ed31..2728dd3 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -126,24 +126,6 @@ typedef enum ClockMsgCtLiteral { } /* - * Primitives to safe set, reset and free references. - */ - -#define Tcl_UnsetObjRef(obj) \ - if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } -#define Tcl_InitObjRef(obj, val) \ - obj = val; if (obj) { Tcl_IncrRefCount(obj); } -#define Tcl_SetObjRef(obj, val) \ -if (1) { \ - Tcl_Obj *nval = val; \ - if (obj != nval) { \ - Tcl_Obj *prev = obj; \ - Tcl_InitObjRef(obj, nval); \ - if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ - } \ -} - -/* * Structure containing the fields used in [clock format] and [clock scan] */ @@ -450,7 +432,9 @@ MODULE_SCOPE Tcl_Obj * MODULE_SCOPE Tcl_Obj * ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); MODULE_SCOPE Tcl_Obj * - ClockMCGetListIdxDict(ClockFmtScnCmdArgs *opts, int mcKey); + ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey, + Tcl_Obj *valObj); /* tclClockFmt.c module declarations */ diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c new file mode 100644 index 0000000..f078c7a --- /dev/null +++ b/generic/tclStrIdxTree.c @@ -0,0 +1,519 @@ +/* + * tclStrIdxTree.c -- + * + * Contains the routines for managing string index tries in Tcl. + * + * This code is back-ported from the tclSE engine, by Serg G. Brester. + * + * Copyright (c) 2016 by Sergey G. Brester aka sebres. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * ----------------------------------------------------------------------- + * + * String index tries are prepaired structures used for fast greedy search of the string + * (index) by unique string prefix as key. + * + * Index tree build for two lists together can be explained in the following datagram + * + * Lists: + * + * {Januar Februar Maerz April Mai Juni Juli August September Oktober November Dezember} + * {Jnr Fbr Mrz Apr Mai Jni Jli Agt Spt Okt Nvb Dzb} + * + * Index-Tree: + * + * j -1 * ... + * anuar 0 * + * u -1 * a -1 + * ni 5 * pril 3 + * li 6 * ugust 7 + * n -1 * gt 7 + * r 0 * s 8 + * i 5 * eptember 8 + * li 6 * pt 8 + * f 1 * oktober 9 + * ebruar 1 * n 10 + * br 1 * ovember 10 + * m -1 * vb 10 + * a -1 * d 11 + * erz 2 * ezember 11 + * i 4 * zb 11 + * rz 2 * + * ... + * + * Thereby value -1 shows pure group items (corresponding ambigous matches). + * + * StrIdxTree's are very fast, so: + * build of above-mentioned tree takes about 10 microseconds. + * search of string index in this tree takes fewer as 0.1 microseconds. + * + */ + +#include "tclInt.h" +#include "tclStrIdxTree.h" + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeSearch -- + * + * Find largest part of string "start" in indexed tree (case sensitive). + * + * Also used for building of string index tree. + * + * Results: + * Return position of UTF character in start after last equal character + * and found item (with parent). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE const char* +TclStrIdxTreeSearch( + TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */ + TclStrIdx **foundItem, /* Return value of found item */ + TclStrIdxTree *tree, /* Index tree will be browsed */ + const char *start, /* UTF string to find in tree */ + const char *end) /* End of string */ +{ + TclStrIdxTree *parent = tree, *prevParent = tree; + TclStrIdx *item = tree->firstPtr, *prevItem = NULL; + const char *s = start, *e, *cin, *preve; + int offs = 0; + + if (item == NULL) { + goto done; + } + + /* search in tree */ + do { + cin = TclGetString(item->key) + offs; + e = TclUtfFindEqual(s, end, cin, cin + item->length); + /* if something was found */ + if (e > s) { + /* if whole string was found */ + if (e >= end) { + start = e; + goto done; + }; + /* set new offset and shift start string */ + offs += (e - s); + s = e; + /* if match item, go deeper as long as possible */ + if (offs >= item->length && item->childTree.firstPtr) { + /* save previuosly found item (if not ambigous) for + * possible fallback (few greedy match) */ + if (item->value != -1) { + preve = e; + prevItem = item; + prevParent = parent; + } + parent = &item->childTree; + item = item->childTree.firstPtr; + continue; + } + /* no children - return this item and current chars found */ + start = e; + goto done; + } + + item = item->nextPtr; + + } while (item != NULL); + + /* fallback (few greedy match) not ambigous (has a value) */ + if (prevItem != NULL) { + item = prevItem; + parent = prevParent; + start = preve; + } + +done: + + if (foundParent) + *foundParent = parent; + if (foundItem) + *foundItem = item; + return start; +} + +MODULE_SCOPE void +TclStrIdxTreeFree( + TclStrIdx *tree) +{ + while (tree != NULL) { + TclStrIdx *t; + Tcl_DecrRefCount(tree->key); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreeFree(tree->childTree.firstPtr); + } + t = tree, tree = tree->nextPtr; + ckfree(t); + } +} + +/* + * Several bidirectional list primitives + */ +inline void +TclStrIdxTreeInsertBranch( + TclStrIdxTree *parent, + register TclStrIdx *item, + register TclStrIdx *child) +{ + if (parent->firstPtr == child) + parent->firstPtr = item; + if (parent->lastPtr == child) + parent->lastPtr = item; + if (item->nextPtr = child->nextPtr) { + item->nextPtr->prevPtr = item; + child->nextPtr = NULL; + } + if (item->prevPtr = child->prevPtr) { + item->prevPtr->nextPtr = item; + child->prevPtr = NULL; + } + item->childTree.firstPtr = child; + item->childTree.lastPtr = child; +} + +inline void +TclStrIdxTreeAppend( + register TclStrIdxTree *parent, + register TclStrIdx *item) +{ + if (parent->lastPtr != NULL) { + parent->lastPtr->nextPtr = item; + } + item->prevPtr = parent->lastPtr; + item->nextPtr = NULL; + parent->lastPtr = item; + if (parent->firstPtr == NULL) { + parent->firstPtr = item; + } +} + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeBuildFromList -- + * + * Build or extend string indexed tree from tcl list. + * + * Important: by multiple lists, optimal tree can be created only if list with + * larger strings used firstly. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TclStrIdxTreeBuildFromList( + TclStrIdxTree *idxTree, + int lstc, + Tcl_Obj **lstv) +{ + Tcl_Obj **lwrv; + int i, ret = TCL_ERROR; + const char *s, *e, *f; + TclStrIdx *item; + + /* create lowercase reflection of the list keys */ + + lwrv = ckalloc(sizeof(Tcl_Obj*) * lstc); + if (lwrv == NULL) { + return TCL_ERROR; + } + for (i = 0; i < lstc; i++) { + lwrv[i] = Tcl_DuplicateObj(lstv[i]); + if (lwrv[i] == NULL) { + return TCL_ERROR; + } + Tcl_IncrRefCount(lwrv[i]); + lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i])); + } + + /* build index tree of the list keys */ + for (i = 0; i < lstc; i++) { + TclStrIdxTree *foundParent = idxTree; + e = s = TclGetString(lwrv[i]); + e += lwrv[i]->length; + + /* ignore empty values (impossible to index it) */ + if (lwrv[i]->length == 0) continue; + + item = NULL; + if (idxTree->firstPtr != NULL) { + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(&foundParent, &foundItem, + idxTree, s, e); + /* if common prefix was found */ + if (f > s) { + /* ignore element if fulfilled or ambigous */ + if (f == e) { + continue; + } + /* if shortest key was found with the same value, + * just replace its current key with longest key */ + if ( foundItem->value == i + && foundItem->length < lwrv[i]->length + && foundItem->childTree.firstPtr == NULL + ) { + Tcl_SetObjRef(foundItem->key, lwrv[i]); + foundItem->length = lwrv[i]->length; + continue; + } + /* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) ) + * but don't split by fulfilled child of found item ( ii->iii->iiii ) */ + if (foundItem->length != (f - s)) { + /* first split found item (insert one between parent and found + new one) */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + Tcl_InitObjRef(item->key, foundItem->key); + item->length = f - s; + /* set value or mark as ambigous if not the same value of both */ + item->value = (foundItem->value == i) ? i : -1; + /* insert group item between foundParent and foundItem */ + TclStrIdxTreeInsertBranch(foundParent, item, foundItem); + foundParent = &item->childTree; + } else { + /* the new item should be added as child of found item */ + foundParent = &foundItem->childTree; + } + } + } + /* append item at end of found parent */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + item->childTree.lastPtr = item->childTree.firstPtr = NULL; + Tcl_InitObjRef(item->key, lwrv[i]); + item->length = lwrv[i]->length; + item->value = i; + TclStrIdxTreeAppend(foundParent, item); + }; + + ret = TCL_OK; + +done: + + if (lwrv != NULL) { + for (i = 0; i < lstc; i++) { + Tcl_DecrRefCount(lwrv[i]); + } + ckfree(lwrv); + } + + if (ret != TCL_OK) { + if (idxTree->firstPtr != NULL) { + TclStrIdxTreeFree(idxTree->firstPtr); + } + } + + return ret; +} + + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr); +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr); + +Tcl_ObjType StrIdxTreeObjType = { + "str-idx-tree", /* name */ + StrIdxTreeObj_FreeIntRepProc, /* freeIntRepProc */ + StrIdxTreeObj_DupIntRepProc, /* dupIntRepProc */ + StrIdxTreeObj_UpdateStringProc, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +MODULE_SCOPE Tcl_Obj* +TclStrIdxTreeNewObj() +{ + Tcl_Obj *objPtr = Tcl_NewObj(); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &StrIdxTreeObjType; + /* return tree root in internal representation */ + return objPtr; +} + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) +{ + /* follow links (smart pointers) */ + if ( srcPtr->internalRep.twoPtrValue.ptr1 != NULL + && srcPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1; + } + /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ + Tcl_InitObjRef(((Tcl_Obj *)copyPtr->internalRep.twoPtrValue.ptr1), + srcPtr); + copyPtr->internalRep.twoPtrValue.ptr2 = NULL; + copyPtr->typePtr = &StrIdxTreeObjType; +} + +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr) +{ + /* follow links (smart pointers) */ + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + /* is a link */ + Tcl_UnsetObjRef(((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1)); + } else { + /* is a tree */ + TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; + if (tree->firstPtr != NULL) { + TclStrIdxTreeFree(tree->firstPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + } + objPtr->typePtr = NULL; +}; + +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr) +{ + /* currently only dummy empty string possible */ + objPtr->length = 0; + objPtr->bytes = tclEmptyStringRep; +}; + +MODULE_SCOPE TclStrIdxTree * +TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) { + /* follow links (smart pointers) */ + if (objPtr->typePtr != &StrIdxTreeObjType) { + return NULL; + } + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1; + } + /* return tree root in internal representation */ + return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; +} + +/* + * Several debug primitives + */ +#if 1 + +void +TclStrIdxTreePrint( + Tcl_Interp *interp, + TclStrIdx *tree, + int offs) +{ + Tcl_Obj *obj[2]; + const char *s; + Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1)); + while (tree != NULL) { + s = TclGetString(tree->key) + offs; + Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d", + offs, "", tree->length - offs, s, tree->value)); + Tcl_PutsObjCmd(NULL, interp, 2, obj); + Tcl_UnsetObjRef(obj[1]); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length); + } + tree = tree->nextPtr; + } + Tcl_UnsetObjRef(obj[0]); +} + + +MODULE_SCOPE int +TclStrIdxTreeTestObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + const char *cs, *cin, *ret; + + static const char *const options[] = { + "index", "puts-index", "findequal", + NULL + }; + enum optionInd { + O_INDEX, O_PUTS_INDEX, O_FINDEQUAL + }; + int optionIndex; + + if (objc < 2) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], options, + "option", 0, &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[1]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case O_FINDEQUAL: + if (objc < 4) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + cs = TclGetString(objv[2]); + cin = TclGetString(objv[3]); + ret = TclUtfFindEqual( + cs, cs + objv[1]->length, cin, cin + objv[2]->length); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); + break; + case O_INDEX: + case O_PUTS_INDEX: + + if (1) { + Tcl_Obj **lstv; + int i, lstc; + TclStrIdxTree idxTree = {NULL, NULL}; + i = 1; + while (++i < objc) { + if (TclListObjGetElements(interp, objv[i], + &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + }; + TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv); + } + if (optionIndex == O_PUTS_INDEX) { + TclStrIdxTreePrint(interp, idxTree.firstPtr, 0); + } + TclStrIdxTreeFree(idxTree.firstPtr); + } + break; + } + + return TCL_OK; +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h new file mode 100644 index 0000000..e80d3db --- /dev/null +++ b/generic/tclStrIdxTree.h @@ -0,0 +1,134 @@ +/* + * tclStrIdxTree.h -- + * + * Declarations of string index tries and other primitives currently + * back-ported from tclSE. + * + * Copyright (c) 2016 Serg G. Brester (aka sebres) + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLSTRIDXTREE_H +#define _TCLSTRIDXTREE_H + + +/* + * Main structures declarations of index tree and entry + */ + +typedef struct TclStrIdxTree { + struct TclStrIdx *firstPtr; + struct TclStrIdx *lastPtr; +} TclStrIdxTree; + +typedef struct TclStrIdx { + struct TclStrIdxTree childTree; + struct TclStrIdx *nextPtr; + struct TclStrIdx *prevPtr; + Tcl_Obj *key; + int length; + int value; +} TclStrIdx; + + +/* + *---------------------------------------------------------------------- + * + * TclUtfFindEqual, TclUtfFindEqualNC -- + * + * Find largest part of string cs in string cin (case sensitive and not). + * + * Results: + * Return position of UTF character in cs after last equal character. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +inline const char * +TclUtfFindEqual( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine) /* End of cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) break; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +inline const char * +TclUtfFindEqualNC( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +/* + * Primitives to safe set, reset and free references. + */ + +#define Tcl_UnsetObjRef(obj) \ + if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } +#define Tcl_InitObjRef(obj, val) \ + obj = val; if (obj) { Tcl_IncrRefCount(obj); } +#define Tcl_SetObjRef(obj, val) \ +if (1) { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + Tcl_InitObjRef(obj, nval); \ + if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ + } \ +} + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE const char* + TclStrIdxTreeSearch(TclStrIdxTree **foundParent, + TclStrIdx **foundItem, TclStrIdxTree *tree, + const char *start, const char *end); + +MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, + int lstc, Tcl_Obj **lstv); + +MODULE_SCOPE Tcl_Obj* + TclStrIdxTreeNewObj(); + +MODULE_SCOPE TclStrIdxTree* + TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); + +#if 1 + +MODULE_SCOPE int TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *, + int, Tcl_Obj *const objv[]); +#endif + +#endif /* _TCLSTRIDXTREE_H */ diff --git a/unix/Makefile.in b/unix/Makefile.in index b220139..19ab6ec 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -451,6 +451,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ + $(GENERIC_DIR)/tclStrIdxTree.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestObj.c \ @@ -1305,6 +1306,9 @@ tclScan.o: $(GENERIC_DIR)/tclScan.c tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c +tclStrIdxTree.o: $(GENERIC_DIR)/tclStrIdxTree.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrIdxTree.c + tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c diff --git a/win/Makefile.in b/win/Makefile.in index 82e5516..478bbb9 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -291,6 +291,7 @@ GENERIC_OBJS = \ tclResult.$(OBJEXT) \ tclScan.$(OBJEXT) \ tclStringObj.$(OBJEXT) \ + tclStrIdxTree.$(OBJEXT) \ tclStrToD.$(OBJEXT) \ tclStubInit.$(OBJEXT) \ tclThread.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index d6dbf85..48bacbc 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -333,6 +333,7 @@ COREOBJS = \ $(TMP_DIR)\tclResult.obj \ $(TMP_DIR)\tclScan.obj \ $(TMP_DIR)\tclStringObj.obj \ + $(TMP_DIR)\tclStrIdxTree.obj \ $(TMP_DIR)\tclStrToD.obj \ $(TMP_DIR)\tclStubInit.obj \ $(TMP_DIR)\tclThread.obj \ -- cgit v0.12 From fb0ed853e7c49ff24e17f4cb633876d0780b64b5 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:38:22 +0000 Subject: lowercase on demand, string index tree can search any-case now, clock scan considered utf-8 char length in words by format parsing --- generic/tclClockFmt.c | 17 +++++++---------- generic/tclStrIdxTree.c | 20 ++++++++++---------- generic/tclStrIdxTree.h | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 52 insertions(+), 20 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index e66c525..92040d8 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1245,7 +1245,7 @@ ClockGetOrParseScanFormat( fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); memset(tok, 0, sizeof(*(tok))); - for (p = strFmt; p != e; p++) { + for (p = strFmt; p < e;) { switch (*p) { case '%': if (1) { @@ -1265,6 +1265,7 @@ ClockGetOrParseScanFormat( tok->tokWord.start = p; tok->tokWord.end = p+1; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + p++; continue; break; case 'E': @@ -1315,6 +1316,8 @@ ClockGetOrParseScanFormat( } /* next token */ AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + p++; + continue; } break; case ' ': @@ -1325,6 +1328,8 @@ ClockGetOrParseScanFormat( } tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + p++; + continue; break; default: word_tok: @@ -1339,12 +1344,11 @@ word_tok: wordTok->map = &ScnWordTokenMap; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); } - continue; } break; } - continue; + p = TclUtfNext(p); } /* calculate end distance value for each tokens */ @@ -1468,11 +1472,6 @@ ClockScan( yyMeridian = MER24; - /* lower case given string into new object */ - strObj = Tcl_NewStringObj(TclGetString(strObj), strObj->length); - Tcl_IncrRefCount(strObj); - strObj->length = Tcl_UtfToLower(TclGetString(strObj)); - p = TclGetString(strObj); end = p + strObj->length; /* in strict mode - bypass spaces at begin / end only (not between tokens) */ @@ -1726,8 +1725,6 @@ not_match: done: - Tcl_DecrRefCount(strObj); - return ret; } diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index f078c7a..afb53e5 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -84,7 +84,7 @@ TclStrIdxTreeSearch( { TclStrIdxTree *parent = tree, *prevParent = tree; TclStrIdx *item = tree->firstPtr, *prevItem = NULL; - const char *s = start, *e, *cin, *preve; + const char *s = start, *f, *cin, *cinf, *prevf; int offs = 0; if (item == NULL) { @@ -94,23 +94,23 @@ TclStrIdxTreeSearch( /* search in tree */ do { cin = TclGetString(item->key) + offs; - e = TclUtfFindEqual(s, end, cin, cin + item->length); + f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf); /* if something was found */ - if (e > s) { + if (f > s) { /* if whole string was found */ - if (e >= end) { - start = e; + if (f >= end) { + start = f; goto done; }; /* set new offset and shift start string */ - offs += (e - s); - s = e; + offs += cinf - cin; + s = f; /* if match item, go deeper as long as possible */ if (offs >= item->length && item->childTree.firstPtr) { /* save previuosly found item (if not ambigous) for * possible fallback (few greedy match) */ if (item->value != -1) { - preve = e; + prevf = f; prevItem = item; prevParent = parent; } @@ -119,7 +119,7 @@ TclStrIdxTreeSearch( continue; } /* no children - return this item and current chars found */ - start = e; + start = f; goto done; } @@ -131,7 +131,7 @@ TclStrIdxTreeSearch( if (prevItem != NULL) { item = prevItem; parent = prevParent; - start = preve; + start = prevf; } done: diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index e80d3db..d2d6f0b 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -89,6 +89,41 @@ TclUtfFindEqualNC( return ret; } +inline const char * +TclUtfFindEqualNCInLwr( + register const char *cs, /* UTF string (in anycase) to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string (in lowercase) will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +inline char * +TclUtfNext( + register const char *src) /* The current location in the string. */ +{ + if (((unsigned char) *(src)) < 0xC0) { + return ++src; + } else { + Tcl_UniChar ch; + return src + TclUtfToUniChar(src, &ch); + } +} + + /* * Primitives to safe set, reset and free references. */ -- cgit v0.12 From 9487f2cdcd7045ccc7f540099755acc0d2b36244 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:38:56 +0000 Subject: locale months scan switched to from list seek to index tree; bug fixing --- generic/tclClockFmt.c | 23 +++++++++++++---------- generic/tclDate.h | 4 ++-- generic/tclStrIdxTree.h | 2 +- tests/clock.test | 24 ++++++++++++++++++++++++ 4 files changed, 40 insertions(+), 13 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 92040d8..478941b 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -682,6 +682,7 @@ ClockMCGetMultiListIdxTree( } ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; }; done: @@ -788,22 +789,24 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, return TCL_OK; */ + static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; + int ret, val; int minLen, maxLen; + TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); - ret = LocaleListSearch(opts, info, MCLIT_MONTHS_FULL, &val, - minLen, maxLen); + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { - /* if not found */ - if (ret == TCL_RETURN) { - ret = LocaleListSearch(opts, info, MCLIT_MONTHS_ABBREV, &val, - minLen, maxLen); - } - if (ret != TCL_OK) { - return ret; - } + return ret; } yyMonth = val + 1; diff --git a/generic/tclDate.h b/generic/tclDate.h index 2728dd3..85bcd35 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -104,7 +104,7 @@ typedef enum ClockLiteral { typedef enum ClockMsgCtLiteral { MCLIT__NIL, /* placeholder */ - MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, + MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB, MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_AM, MCLIT_PM, MCLIT_BCE, MCLIT_CE, @@ -116,7 +116,7 @@ typedef enum ClockMsgCtLiteral { #define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ pref "", \ - pref "MONTHS_FULL", pref "MONTHS_ABBREV", \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", \ pref "AM", pref "PM", \ pref "BCE", pref "CE", \ diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index d2d6f0b..934e28f 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -111,7 +111,7 @@ TclUtfFindEqualNCInLwr( return ret; } -inline char * +inline const char * TclUtfNext( register const char *src) /* The current location in the string. */ { diff --git a/tests/clock.test b/tests/clock.test index e96dec6..1d02f39 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18564,6 +18564,30 @@ test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true } 2 +test clock-6.12 {input of unambiguous short locale token (%b)} { + list [clock scan "12 Ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ + [clock scan "12 Au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] +} {979257600 997574400} +test clock-6.13 {input of lowercase locale token (%b)} { + list [clock scan "12 ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ + [clock scan "12 au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] +} {979257600 997574400} +test clock-6.14 {input of uppercase locale token (%b)} { + list [clock scan "12 JA 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ + [clock scan "12 AU 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] +} {979257600 997574400} +test clock-6.15 {input of ambiguous short locale token (%b)} { + list [catch { + clock scan "12 J 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1 + } result] $result $errorCode +} {1 {input string does not match supplied format} {CLOCK badInputString}} +test clock-6.16 {input of ambiguous short locale token (%b)} { + list [catch { + clock scan "12 Ju 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1 + } result] $result $errorCode +} {1 {input string does not match supplied format} {CLOCK badInputString}} + + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true } -210866803200 -- cgit v0.12 From 61be8dc3b8493311781e3fec5575cb85161d16ab Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:39:45 +0000 Subject: other locale scan token switched from list seek to index tree + list search case insensitive now --- generic/tclClockFmt.c | 44 +++++++++++++++++++++++++++----------------- generic/tclDate.h | 8 ++++---- 2 files changed, 31 insertions(+), 21 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 478941b..999f191 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -530,20 +530,26 @@ ObjListSearch(ClockFmtScnCmdArgs *opts, int minLen, int maxLen) { int i, l, lf = -1; - const char *s; + const char *s, *f, *sf; /* search in list */ for (i = 0; i < lstc; i++) { s = TclGetString(lstv[i]); l = lstv[i]->length; - if ( l >= minLen && l <= maxLen - && strncasecmp(yyInput, s, l) == 0 + + if ( l >= minLen + && (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput ) { + l = f - yyInput; + if (l < minLen) { + continue; + } /* found, try to find longest value (greedy search) */ if (l < maxLen && minLen != maxLen) { lf = i; minLen = l + 1; continue; } + /* max possible - end of search */ *val = i; yyInput += l; break; @@ -818,9 +824,12 @@ static int ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { + static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0}; + int ret, val; int minLen, maxLen; char curTok = *tok->tokWord.start; + TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -836,9 +845,13 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, val = *yyInput - '0'; } } else { - int ret = LocaleListSearch(opts, info, (int)tok->map->data, &val, - minLen, maxLen); - if (ret == TCL_ERROR) { + idxTree = ClockMCGetListIdxTree(opts, (int)tok->map->data /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { return ret; } } @@ -847,7 +860,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, if (val == 0) { val = 7; } - if (val > 7 && curTok != 'a' && curTok != 'A') { + if (val > 7) { Tcl_SetResult(opts->interp, "day of week is greater than 7", TCL_STATIC); Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); @@ -863,17 +876,14 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, } /* %a %A */ - ret = LocaleListSearch(opts, info, MCLIT_DAYS_OF_WEEK_FULL, &val, - minLen, maxLen); + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_DAYS_OF_WEEK_COMB, dowKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { - /* if not found */ - if (ret == TCL_RETURN) { - ret = LocaleListSearch(opts, info, MCLIT_DAYS_OF_WEEK_ABBREV, &val, - minLen, maxLen); - } - if (ret != TCL_OK) { - return ret; - } + return ret; } if (val == 0) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 85bcd35..fe38436 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -105,8 +105,8 @@ typedef enum ClockLiteral { typedef enum ClockMsgCtLiteral { MCLIT__NIL, /* placeholder */ MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB, - MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, - MCLIT_AM, MCLIT_PM, + MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB, + MCLIT_AM, MCLIT_PM, MCLIT_BCE, MCLIT_CE, MCLIT_BCE2, MCLIT_CE2, MCLIT_BCE3, MCLIT_CE3, @@ -117,8 +117,8 @@ typedef enum ClockMsgCtLiteral { #define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ pref "", \ pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ - pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", \ - pref "AM", pref "PM", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ + pref "AM", pref "PM", \ pref "BCE", pref "CE", \ pref "b.c.e.", pref "c.e.", \ pref "b.c.", pref "a.d.", \ -- cgit v0.12 From bc93c0f3ab88c29a0985e463ccd73fafaddddbc9 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:40:16 +0000 Subject: min length of %Y token (year with century) is 4, optional tokens possibility (zone), test cases extended --- generic/tclClockFmt.c | 40 ++++++++++++++++++++++++++++++---------- generic/tclDate.h | 1 + tests-perf/clock.perf.tcl | 7 +++++++ tests/clock.test | 12 ++++++++++++ 4 files changed, 50 insertions(+), 10 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 999f191..9211481 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1089,7 +1089,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), NULL}, /* %Y */ - {CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 1, 4, TclOffset(DateInfo, date.year), + {CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year), NULL}, /* %H %k %I %l */ {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), @@ -1116,7 +1116,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year), NULL}, /* %G */ - {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 1, 4, TclOffset(DateInfo, date.iso8601Year), + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year), NULL}, /* %V */ {CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), @@ -1125,7 +1125,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, ClockScnToken_DayOfWeek_Proc, NULL}, /* %z %Z */ - {CTOKT_PARSER, 0, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0, 0, ClockScnToken_TimeZone_Proc, NULL}, /* %s */ {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), @@ -1508,6 +1508,10 @@ ClockScan( } } yyInput = p; + /* end of input string */ + if (p >= end) { + break; + } switch (map->type) { case CTOKT_DIGIT: @@ -1553,6 +1557,10 @@ ClockScan( size = p - yyInput; if (size < map->minSize) { /* missing input -> error */ + if ((map->flags & CLF_OPTIONAL)) { + yyInput = p; + continue; + } goto not_match; } /* string 2 number, put number into info structure by offset */ @@ -1578,6 +1586,10 @@ ClockScan( case TCL_OK: break; case TCL_RETURN: + if ((map->flags & CLF_OPTIONAL)) { + yyInput = p; + continue; + } goto not_match; break; default: @@ -1611,15 +1623,23 @@ ClockScan( break; } } - - /* ignore spaces at end */ - while (p < end && isspace(UCHAR(*p))) { - p++; - } /* check end was reached */ if (p < end) { - /* something after last token - wrong format */ - goto not_match; + /* ignore spaces at end */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + if (p < end) { + /* something after last token - wrong format */ + goto not_match; + } + } + /* end of string, check only optional tokens at end, otherwise - not match */ + if (tok->map != NULL) { + if ( !(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE) + || (tok->map->flags & CLF_OPTIONAL)) { + goto not_match; + } } /* diff --git a/generic/tclDate.h b/generic/tclDate.h index fe38436..64135d3 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -30,6 +30,7 @@ #define ONE_YEAR 365 /* days */ +#define CLF_OPTIONAL (1 << 0) /* token is non mandatory */ #define CLF_JULIANDAY (1 << 3) #define CLF_TIME (1 << 4) #define CLF_LOCALSEC (1 << 5) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 3c69414..41cc9e1 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -150,6 +150,13 @@ proc test-scan {{reptime 1000}} { # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} + # Scan : ISO date-time (CEST) + {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} + # Scan : ISO date-time (UTC) + {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"} + # Scan : dynamic format (cacheable) {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} diff --git a/tests/clock.test b/tests/clock.test index 1d02f39..a4641c6 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18587,6 +18587,18 @@ test clock-6.16 {input of ambiguous short locale token (%b)} { } result] $result $errorCode } {1 {input string does not match supplied format} {CLOCK badInputString}} +test clock-6.17 {spaces are always optional in non-strict mode (default)} { + list [clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00 +02:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S %z" -timezone CET] \ + [clock scan "2009-06-30T18:30:00 Z" -format "%Y-%m-%dT%H:%M:%S %z" -timezone CET] +} {1246379400 1246379400 1246386600 1246386600} + +test clock-6.18 {zone token (%z) is optional} { + list [clock scan "2009-06-30T18:30:00 -01:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ + [clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ +} {1246390200 1246386600 1246386600} test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true -- cgit v0.12 From ae0148ee3925f838692b0f69aef337675e32881b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:41:18 +0000 Subject: [temp-commit]: format almost ready (missing some tokens) --- generic/tclClock.c | 28 +- generic/tclClockFmt.c | 711 +++++++++++++++++++++++++++++++++++++++++--------- generic/tclDate.h | 75 ++++-- library/clock.tcl | 2 +- library/init.tcl | 2 +- tests/clock.test | 5 + 6 files changed, 651 insertions(+), 172 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e52b2e7..935a347 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -129,6 +129,9 @@ static int ClockParseformatargsObjCmd( static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockFormatObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int ClockScanObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -164,6 +167,7 @@ static const struct ClockCommand clockCommands[] = { { "microseconds", ClockMicrosecondsObjCmd }, { "milliseconds", ClockMillisecondsObjCmd }, { "seconds", ClockSecondsObjCmd }, + { "format", ClockFormatObjCmd }, { "scan", ClockScanObjCmd }, { "configure", ClockConfigureObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, @@ -2944,8 +2948,7 @@ ClockFormatObjCmd( int ret; ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ Tcl_WideInt clockVal; /* Time, expressed in seconds from the Epoch */ - DateInfo yy; /* Common structure used for parsing */ - DateInfo *info = &yy; + DateFormat dateFmt; /* Common structure used for formatting */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, "string " @@ -2972,9 +2975,7 @@ ClockFormatObjCmd( return TCL_ERROR; } - - ClockInitDateInfo(info); - yydate.tzName = NULL; + memset(&dateFmt, 0, sizeof(dateFmt)); /* * Extract year, month and day from the base time for the parser to use as @@ -2984,16 +2985,16 @@ ClockFormatObjCmd( /* check base fields already cached (by TZ, last-second cache) */ if ( dataPtr->lastBase.timezoneObj == opts.timezoneObj && dataPtr->lastBase.Date.seconds == clockVal) { - memcpy(&yydate, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); + memcpy(&dateFmt.date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); } else { /* extact fields from base */ - yydate.seconds = clockVal; - if (ClockGetDateFields(clientData, interp, &yydate, opts.timezoneObj, + dateFmt.date.seconds = clockVal; + if (ClockGetDateFields(clientData, interp, &dateFmt.date, opts.timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) { goto done; } /* cache last base */ - memcpy(&dataPtr->lastBase.Date, &yydate, ClockCacheableDateFieldsSize); + memcpy(&dataPtr->lastBase.Date, &dateFmt.date, ClockCacheableDateFieldsSize); Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts.timezoneObj); } @@ -3004,11 +3005,11 @@ ClockFormatObjCmd( /* Use compiled version of Format - */ - ret = ClockFormat(clientData, interp, info, &opts); + ret = ClockFormat(&dateFmt, &opts); done: - Tcl_UnsetObjRef(yydate.tzName); + Tcl_UnsetObjRef(dateFmt.date.tzName); if (ret != TCL_OK) { return ret; @@ -3072,8 +3073,7 @@ ClockScanObjCmd( } ClockInitDateInfo(info); - yydate.tzName = NULL; - + /* * Extract year, month and day from the base time for the parser to use as * defaults @@ -3114,7 +3114,7 @@ ClockScanObjCmd( else { /* Use compiled version of Scan - */ - ret = ClockScan(clientData, interp, info, objv[1], &opts); + ret = ClockScan(info, objv[1], &opts); } if (ret != TCL_OK) { diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 9211481..b46b7bf 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -490,6 +490,74 @@ Tcl_GetClockFrmScnFromObj( return fss; } +MODULE_SCOPE Tcl_Obj * +ClockLocalizeFormat( + ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *valObj = NULL, *keyObj; + + keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); + + /* special case - format object is not localizable */ + if (keyObj == opts->formatObj) { + return opts->formatObj; + } + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to find in cache within locale mc-catalog */ + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + keyObj, &valObj) != TCL_OK) { + return NULL; + } + + /* call LocalizeFormat locale format fmtkey */ + if (valObj == NULL) { + Tcl_Obj *callargs[4]; + callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; + callargs[1] = opts->localeObj; + callargs[2] = opts->formatObj; + callargs[3] = keyObj; + Tcl_IncrRefCount(keyObj); + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + ) { + goto clean; + } + + valObj = Tcl_GetObjResult(opts->interp); + + /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + keyObj, valObj) != TCL_OK + ) { + valObj = NULL; + goto clean; + } + + /* check special case - format object is not localizable */ + if (valObj == opts->formatObj) { + /* mark it as unlocalizable, by setting self as key (without refcount incr) */ + if (opts->formatObj->typePtr == &ClockFmtObjType) { + Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj)); + ObjLocFmtKey(opts->formatObj) = opts->formatObj; + } + } +clean: + + Tcl_UnsetObjRef(keyObj); + if (valObj) { + Tcl_ResetResult(opts->interp); + } + } + + return (opts->formatObj = valObj); +} + /* * DetermineGreedySearchLen -- * @@ -1131,7 +1199,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), NULL}, }; -static const char *ScnSTokenWrapMapIndex[2] = { +static const char *ScnSTokenMapAliasIndex[2] = { "eNBhkIlPAuwZ", "dmbbHHHpaaaz" }; @@ -1146,7 +1214,7 @@ static ClockScanTokenMap ScnETokenMap[] = { {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; -static const char *ScnETokenWrapMapIndex[2] = { +static const char *ScnETokenMapAliasIndex[2] = { "", "" }; @@ -1176,7 +1244,7 @@ static ClockScanTokenMap ScnOTokenMap[] = { {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; -static const char *ScnOTokenWrapMapIndex[2] = { +static const char *ScnOTokenMapAliasIndex[2] = { "ekIlw", "dHHHu" }; @@ -1194,6 +1262,29 @@ static ClockScanTokenMap ScnWordTokenMap = { }; +inline unsigned int +EstimateTokenCount( + register const char *fmt, + register const char *end) +{ + register const char *p = fmt; + unsigned int tokcnt; + /* estimate token count by % char and format length */ + tokcnt = 0; + while (p <= end) { + if (*p++ == '%') tokcnt++; + } + p = fmt + tokcnt * 2; + if (p < end) { + if ((unsigned int)(end - p) < tokcnt) { + tokcnt += (end - p); + } else { + tokcnt += tokcnt; + } + } + return ++tokcnt; +} + #define AllocTokenInChain(tok, chain, tokCnt) \ if (++(tok) >= (chain) + (tokCnt)) { \ (char *)(chain) = ckrealloc((char *)(chain), \ @@ -1215,56 +1306,32 @@ ClockGetOrParseScanFormat( ClockFmtScnStorage *fss; ClockScanToken *tok; - if (formatObj->typePtr != &ClockFmtObjType) { - if (ClockFmtObj_SetFromAny(interp, formatObj) != TCL_OK) { - return NULL; - } - } - - fss = ObjClockFmtScn(formatObj); - + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); if (fss == NULL) { - fss = FindOrCreateFmtScnStorage(interp, formatObj); - if (fss == NULL) { - return NULL; - } + return NULL; } /* if first time scanning - tokenize format */ if (fss->scnTok == NULL) { - const char *strFmt; register const char *p, *e, *cp; - e = strFmt = HashEntry4FmtScn(fss)->key.string; - e += strlen(strFmt); + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); /* estimate token count by % char and format length */ - fss->scnTokC = 0; - p = strFmt; - while (p != e) { - if (*p++ == '%') fss->scnTokC++; - } - p = strFmt + fss->scnTokC * 2; - if (p < e) { - if ((unsigned int)(e - p) < fss->scnTokC) { - fss->scnTokC += (e - p); - } else { - fss->scnTokC += fss->scnTokC; - } - } - fss->scnTokC++; + fss->scnTokC = EstimateTokenCount(p, e); Tcl_MutexLock(&ClockFmtMutex); fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); memset(tok, 0, sizeof(*(tok))); - for (p = strFmt; p < e;) { + while (p < e) { switch (*p) { case '%': if (1) { ClockScanTokenMap * scnMap = ScnSTokenMap; const char *mapIndex = ScnSTokenMapIndex, - **wrapIndex = ScnSTokenWrapMapIndex; + **aliasIndex = ScnSTokenMapAliasIndex; if (p+1 >= e) { goto word_tok; } @@ -1284,13 +1351,13 @@ ClockGetOrParseScanFormat( case 'E': scnMap = ScnETokenMap, mapIndex = ScnETokenMapIndex, - wrapIndex = ScnETokenWrapMapIndex; + aliasIndex = ScnETokenMapAliasIndex; p++; break; case 'O': scnMap = ScnOTokenMap, mapIndex = ScnOTokenMapIndex, - wrapIndex = ScnOTokenWrapMapIndex; + aliasIndex = ScnOTokenMapAliasIndex; p++; break; } @@ -1298,17 +1365,17 @@ ClockGetOrParseScanFormat( cp = strchr(mapIndex, *p); if (!cp || *cp == '\0') { /* search wrapper index (multiple chars for same token) */ - cp = strchr(wrapIndex[0], *p); + cp = strchr(aliasIndex[0], *p); if (!cp || *cp == '\0') { - p--; + p--; if (scnMap != ScnSTokenMap) p--; goto word_tok; } - cp = strchr(mapIndex, wrapIndex[1][cp - wrapIndex[0]]); + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); if (!cp || *cp == '\0') { /* unexpected, but ... */ #ifdef DEBUG Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); #endif - p--; + p--; if (scnMap != ScnSTokenMap) p--; goto word_tok; } } @@ -1351,17 +1418,16 @@ word_tok: if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { wordTok = tok-1; } - wordTok->tokWord.end = p+1; if (wordTok == tok) { wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); } + p = TclUtfNext(p); + wordTok->tokWord.end = p; } break; } - - p = TclUtfNext(p); } /* calculate end distance value for each tokens */ @@ -1386,86 +1452,16 @@ done: return fss->scnTok; } -MODULE_SCOPE Tcl_Obj * -ClockLocalizeFormat( - ClockFmtScnCmdArgs *opts) -{ - ClockClientData *dataPtr = opts->clientData; - Tcl_Obj *valObj = NULL, *keyObj; - - keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); - - /* special case - format object is not localizable */ - if (keyObj == opts->formatObj) { - return opts->formatObj; - } - - if (opts->mcDictObj == NULL) { - ClockMCDict(opts); - if (opts->mcDictObj == NULL) - return NULL; - } - - /* try to find in cache within locale mc-catalog */ - if (Tcl_DictObjGet(NULL, opts->mcDictObj, - keyObj, &valObj) != TCL_OK) { - return NULL; - } - - /* call LocalizeFormat locale format fmtkey */ - if (valObj == NULL) { - Tcl_Obj *callargs[4]; - callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; - callargs[1] = opts->localeObj; - callargs[2] = opts->formatObj; - callargs[3] = keyObj; - Tcl_IncrRefCount(keyObj); - if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK - ) { - goto clean; - } - - valObj = Tcl_GetObjResult(opts->interp); - - /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ - if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, - keyObj, valObj) != TCL_OK - ) { - valObj = NULL; - goto clean; - } - - /* check special case - format object is not localizable */ - if (valObj == opts->formatObj) { - /* mark it as unlocalizable, by setting self as key (without refcount incr) */ - if (opts->formatObj->typePtr == &ClockFmtObjType) { - Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj)); - ObjLocFmtKey(opts->formatObj) = opts->formatObj; - } - } -clean: - - Tcl_UnsetObjRef(keyObj); - if (valObj) { - Tcl_ResetResult(opts->interp); - } - } - - return (opts->formatObj = valObj); -} - /* *---------------------------------------------------------------------- */ int ClockScan( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ register DateInfo *info, /* Date fields used for parsing & converting */ Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = clientData; + ClockClientData *dataPtr = opts->clientData; ClockScanToken *tok; ClockScanTokenMap *map; register const char *p, *x, *end; @@ -1477,7 +1473,8 @@ ClockScan( return TCL_ERROR; } - if ((tok = ClockGetOrParseScanFormat(interp, opts->formatObj)) == NULL) { + if ((tok = ClockGetOrParseScanFormat(opts->interp, + opts->formatObj)) == NULL) { return TCL_ERROR; } @@ -1635,11 +1632,14 @@ ClockScan( } } /* end of string, check only optional tokens at end, otherwise - not match */ - if (tok->map != NULL) { - if ( !(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE) - || (tok->map->flags & CLF_OPTIONAL)) { + while (tok->map != NULL) { + if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) { + tok++; + } + if (tok->map != NULL && !(tok->map->flags & CLF_OPTIONAL)) { goto not_match; } + tok++; } /* @@ -1745,33 +1745,377 @@ ClockScan( overflow: - Tcl_SetResult(interp, "requested date too large to represent", + Tcl_SetResult(opts->interp, "requested date too large to represent", TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); goto done; not_match: - Tcl_SetResult(interp, "input string does not match supplied format", + Tcl_SetResult(opts->interp, "input string does not match supplied format", TCL_STATIC); - Tcl_SetErrorCode(interp, "CLOCK", "badInputString", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); done: return ret; } + + +inline int +FrmResultAllocate( + register DateFormat *dateFmt, + int len) +{ + int needed = dateFmt->output + len - dateFmt->resEnd; + if (needed >= 0) { /* >= 0 - regards NTS zero */ + int newsize = dateFmt->resEnd - dateFmt->resMem + + needed + MIN_FMT_RESULT_BLOCK_ALLOC; + char *newRes = ckrealloc(dateFmt->resMem, newsize); + if (newRes == NULL) { + return TCL_ERROR; + } + dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem); + dateFmt->resMem = newRes; + dateFmt->resEnd = newRes + newsize; + } + return TCL_OK; +} + +static int +ClockFmtToken_HourAMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + *val = ( ( ( *val % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1; + return TCL_OK; +} + +static int +ClockFmtToken_AMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if ((*val % 84600) < (84600 / 2)) { + mcObj = ClockMCGet(opts, MCLIT_AM); + } else { + mcObj = ClockMCGet(opts, MCLIT_PM); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + if (*tok->tokWord.start == 'p') { + len = Tcl_UtfToUpper(dateFmt->output); + } + dateFmt->output += len; + *dateFmt->output = '\0'; + + return TCL_OK; +} + +static const char *FmtSTokenMapIndex = + "demNbByYCHMSIklpaAugGjJsnt"; +static ClockFormatTokenMap FmtSTokenMap[] = { + /* %d */ + {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %e */ + {CFMTT_INT, "%2d", 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %m */ + {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %N */ + {CFMTT_INT, "%2d", 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %b %h */ + {CFMTT_INT, NULL, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_ABBREV}, + /* %B */ + {CFMTT_INT, NULL, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_FULL}, + /* %y */ + {CFMTT_INT, "%02d", 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, + /* %Y */ + {CFMTT_INT, "%04d", 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, + /* %C */ + {CFMTT_INT, "%02d", 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, + /* %H */ + {CFMTT_INT, "%02d", 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + /* %M */ + {CFMTT_INT, "%02d", 0, 60, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + /* %S */ + {CFMTT_INT, "%02d", 0, 0, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + /* %I */ + {CFMTT_INT, "%02d", CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %k */ + {CFMTT_INT, "%2d", 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + /* %l */ + {CFMTT_INT, "%2d", CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %p %P */ + {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.localSeconds), + ClockFmtToken_AMPM_Proc, NULL}, + /* %a */ + {CFMTT_INT, NULL, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV}, + /* %A */ + {CFMTT_INT, NULL, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL}, + /* %u */ + {CFMTT_INT, "%1d", 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %g */ + {CFMTT_INT, "%02d", 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %G */ + {CFMTT_INT, "%04d", 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %j */ + {CFMTT_INT, "%03d", 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, + /* %J */ + {CFMTT_INT, "%07d", 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + /* %s */ + {CFMTT_WIDE, "%ld", 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + /* %n */ + {CFMTT_CHAR, "\n", 0, 0, 0, 0, NULL}, + /* %t */ + {CFMTT_CHAR, "\t", 0, 0, 0, 0, NULL}, + +#if 0 + /* %H %k %I %l */ + {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.hour), + NULL}, + /* %M */ + {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.minutes), + NULL}, + /* %S */ + {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.secondOfDay), + NULL}, + /* %p %P */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, + ClockFmtToken_amPmInd_Proc, NULL}, + /* %J */ + {CFMTT_INT, CLF_JULIANDAY, 1, 0xffff, TclOffset(DateFormat, date.julianDay), + NULL}, + /* %j */ + {CFMTT_INT, CLF_DAYOFYEAR, 1, 3, TclOffset(DateFormat, date.dayOfYear), + NULL}, + /* %g */ + {CFMTT_INT, CLF_ISO8601YEAR | CLF_ISO8601, 2, 2, TclOffset(DateFormat, date.iso8601Year), + NULL}, + /* %G */ + {CFMTT_INT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 4, 4, TclOffset(DateFormat, date.iso8601Year), + NULL}, + /* %V */ + {CFMTT_INT, CLF_ISO8601, 1, 2, TclOffset(DateFormat, date.iso8601Week), + NULL}, + /* %a %A %u %w */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, + ClockFmtToken_DayOfWeek_Proc, NULL}, + /* %z %Z */ + {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0, + ClockFmtToken_TimeZone_Proc, NULL}, + /* %s */ + {CFMTT_INT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateFormat, date.localSeconds), + NULL}, +#endif +}; +static const char *FmtSTokenMapAliasIndex[2] = { + "hP", + "bp" +}; + +static const char *FmtETokenMapIndex = +"";// "Ey"; +static ClockFormatTokenMap FmtETokenMap[] = { + {CFMTT_INT, "%02d", 0, 0, 0, 0, NULL}, +#if 0 + /* %EE */ + {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateFormat, date.year), + ClockFmtToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ey */ + {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, +#endif +}; +static const char *FmtETokenMapAliasIndex[2] = { + "", + "" +}; + +static const char *FmtOTokenMapIndex = +"";// "dmyHMSu"; +static ClockFormatTokenMap FmtOTokenMap[] = { + {CFMTT_INT, "%02d", 0, 0, 0, 0, NULL}, +#if 0 + /* %Od %Oe */ + {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, TclOffset(DateFormat, date.month), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CTOKT_PARSER, CLF_YEAR, 0, 0, 0, TclOffset(DateFormat, date.year), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok %OI %Ol */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.hour), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.minutes), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou Ow */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + ClockFmtToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, +#endif +}; +static const char *FmtOTokenMapAliasIndex[2] = { +"", "" +#if 0 + "ekIlw", + "dHHHu" +#endif +}; + +static ClockFormatTokenMap FmtWordTokenMap = { + CTOKT_WORD, NULL, 0, 0, 0, 0, NULL +}; + +/* + *---------------------------------------------------------------------- + */ +ClockFormatToken * +ClockGetOrParseFmtFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockFormatToken *tok; + + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); + if (fss == NULL) { + return NULL; + } + + /* if first time scanning - tokenize format */ + if (fss->fmtTok == NULL) { + register const char *p, *e, *cp; + + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); + + /* estimate token count by % char and format length */ + fss->fmtTokC = EstimateTokenCount(p, e); + + Tcl_MutexLock(&ClockFmtMutex); + + fss->fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC); + memset(tok, 0, sizeof(*(tok))); + while (p < e) { + switch (*p) { + case '%': + if (1) { + ClockFormatTokenMap * fmtMap = FmtSTokenMap; + const char *mapIndex = FmtSTokenMapIndex, + **aliasIndex = FmtSTokenMapAliasIndex; + if (p+1 >= e) { + goto word_tok; + } + p++; + /* try to find modifier: */ + switch (*p) { + case '%': + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &FmtWordTokenMap; + tok->tokWord.start = p; + tok->tokWord.end = p+1; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + p++; + continue; + break; + case 'E': + fmtMap = FmtETokenMap, + mapIndex = FmtETokenMapIndex, + aliasIndex = FmtETokenMapAliasIndex; + p++; + break; + case 'O': + fmtMap = FmtOTokenMap, + mapIndex = FmtOTokenMapIndex, + aliasIndex = FmtOTokenMapAliasIndex; + p++; + break; + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(aliasIndex[0], *p); + if (!cp || *cp == '\0') { + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + } + tok->map = &fmtMap[cp - mapIndex]; + tok->tokWord.start = p; + /* next token */ + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + p++; + continue; + } + break; + default: +word_tok: + if (1) { + ClockFormatToken *wordTok = tok; + if (tok > fss->fmtTok && (tok-1)->map == &FmtWordTokenMap) { + wordTok = tok-1; + } + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &FmtWordTokenMap; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + } + p = TclUtfNext(p); + wordTok->tokWord.end = p; + } + break; + } + } + +done: + Tcl_MutexUnlock(&ClockFmtMutex); + } + + return fss->fmtTok; +} /* *---------------------------------------------------------------------- */ int ClockFormat( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ - register DateInfo *info, /* Date fields used for parsing & converting */ - ClockFmtScnCmdArgs *opts) /* Command options */ + register DateFormat *dateFmt, /* Date fields used for parsing & converting */ + ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = clientData; + ClockClientData *dataPtr = opts->clientData; ClockFormatToken *tok; ClockFormatTokenMap *map; @@ -1780,10 +2124,119 @@ ClockFormat( return TCL_ERROR; } -/* if ((tok = ClockGetOrParseFmtFormat(interp, opts->formatObj)) == NULL) { + if ((tok = ClockGetOrParseFmtFormat(opts->interp, + opts->formatObj)) == NULL) { return TCL_ERROR; } -*/ + + dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); /* result container object */ + if (dateFmt->resMem == NULL) { + return TCL_ERROR; + } + dateFmt->output = dateFmt->resMem; + dateFmt->resEnd = dateFmt->resMem + MIN_FMT_RESULT_BLOCK_ALLOC; + *dateFmt->output = '\0'; + + /* do format each token */ + for (; tok->map != NULL; tok++) { + map = tok->map; + switch (map->type) + { + case CFMTT_INT: + if (1) { + int val = (int)*(time_t *)(((char *)dateFmt) + map->offs); + if (map->fmtproc == NULL) { + if (map->flags & CLFMT_DECR) { + val--; + } + if (map->flags & CLFMT_INCR) { + val++; + } + if (map->divider) { + val /= map->divider; + } + if (map->divmod) { + val %= map->divmod; + } + } else { + if (map->fmtproc(opts, dateFmt, tok, &val) != TCL_OK) { + goto done; + } + /* if not calculate only (output inside fmtproc) */ + if (!(map->flags & CLFMT_CALC)) { + continue; + } + } + if (!(map->flags & CLFMT_LOCALE_INDX)) { + if (FrmResultAllocate(dateFmt, 10) != TCL_OK) { goto error; }; + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } else { + const char *s; + Tcl_Obj * mcObj = ClockMCGet(opts, (int)map->data /* mcKey */); + if (mcObj == NULL) { + goto error; + } + if (Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK) { + goto error; + } + s = TclGetString(mcObj); + if (FrmResultAllocate(dateFmt, mcObj->length) != TCL_OK) { goto error; }; + memcpy(dateFmt->output, s, mcObj->length + 1); + dateFmt->output += mcObj->length; + } + } + break; + case CFMTT_WIDE: + if (1) { + Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs); + if (FrmResultAllocate(dateFmt, 20) != TCL_OK) { goto error; }; + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } + break; + case CFMTT_CHAR: + if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; }; + *dateFmt->output++ = *map->tostr; + *dateFmt->output = '\0'; + break; + case CFMTT_PROC: + if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) { + goto error; + }; + break; + case CTOKT_WORD: + if (1) { + int len = tok->tokWord.end - tok->tokWord.start; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; }; + memcpy(dateFmt->output, tok->tokWord.start, len); + dateFmt->output += len; + *dateFmt->output = '\0'; + } + break; + } + } + + goto done; + +error: + + ckfree(dateFmt->resMem); + dateFmt->resMem = NULL; + +done: + + if (dateFmt->resMem) { + Tcl_Obj * result = Tcl_NewObj(); + result->length = dateFmt->output - dateFmt->resMem; + result->bytes = NULL; + result->bytes = ckrealloc(dateFmt->resMem, result->length+1); + if (result->bytes == NULL) { + result->bytes = dateFmt->resMem; + } + Tcl_SetObjResult(opts->interp, result); + return TCL_OK; + } + + return TCL_ERROR; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 64135d3..141ad60 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -51,7 +51,6 @@ #define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | CLF_ISO8601) - /* * Enumeration of the string literals used in [clock] */ @@ -352,12 +351,11 @@ typedef int ClockScanTokenProc( typedef enum _CLCKTOK_TYPE { - CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD + CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, + CFMTT_INT, CFMTT_WIDE, CFMTT_CHAR, CFMTT_PROC } CLCKTOK_TYPE; -typedef struct ClockFmtScnStorage ClockFmtScnStorage; - -typedef struct ClockFormatTokenMap { +typedef struct ClockScanTokenMap { unsigned short int type; unsigned short int flags; unsigned short int clearFlags; @@ -366,38 +364,62 @@ typedef struct ClockFormatTokenMap { unsigned short int offs; ClockScanTokenProc *parser; void *data; -} ClockFormatTokenMap; -typedef struct ClockFormatToken { - ClockFormatTokenMap *map; +} ClockScanTokenMap; + +typedef struct ClockScanToken { + ClockScanTokenMap *map; + unsigned short int lookAhead; + unsigned short int endDistance; struct { const char *start; const char *end; } tokWord; -} ClockFormatToken; +} ClockScanToken; -typedef struct ClockScanTokenMap { + +#define MIN_FMT_RESULT_BLOCK_ALLOC 200 + +typedef struct DateFormat { + char *resMem; + char *resEnd; + char *output; + + TclDateFields date; +} DateFormat; + +#define CLFMT_INCR (1 << 3) +#define CLFMT_DECR (1 << 4) +#define CLFMT_CALC (1 << 5) +#define CLFMT_LOCALE_INDX (1 << 8) + +typedef struct ClockFormatToken ClockFormatToken; + +typedef int ClockFormatTokenProc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val); + +typedef struct ClockFormatTokenMap { unsigned short int type; + const char *tostr; unsigned short int flags; - unsigned short int clearFlags; - unsigned short int minSize; - unsigned short int maxSize; + unsigned short int divider; + unsigned short int divmod; unsigned short int offs; - ClockScanTokenProc *parser; + ClockFormatTokenProc *fmtproc; void *data; -} ClockScanTokenMap; - -typedef struct ClockScanToken { - ClockScanTokenMap *map; - unsigned short int lookAhead; - unsigned short int endDistance; +} ClockFormatTokenMap; +typedef struct ClockFormatToken { + ClockFormatTokenMap *map; struct { const char *start; const char *end; } tokWord; -} ClockScanToken; +} ClockFormatToken; -#define ClockScnTokenChar(tok) \ - *tok->tokWord.start; + +typedef struct ClockFmtScnStorage ClockFmtScnStorage; typedef struct ClockFmtScnStorage { int objRefCount; /* Reference count shared across threads */ @@ -449,12 +471,11 @@ MODULE_SCOPE ClockFmtScnStorage * MODULE_SCOPE Tcl_Obj * ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); -MODULE_SCOPE int ClockScan(ClientData clientData, Tcl_Interp *interp, - register DateInfo *info, +MODULE_SCOPE int ClockScan(register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); -MODULE_SCOPE int ClockFormat(ClientData clientData, Tcl_Interp *interp, - register DateInfo *info, ClockFmtScnCmdArgs *opts); +MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt, + ClockFmtScnCmdArgs *opts); MODULE_SCOPE void ClockFrmScnClearCaches(void); diff --git a/library/clock.tcl b/library/clock.tcl index c4e698c..06aa10a 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -676,7 +676,7 @@ proc mcget {locale args} { # #---------------------------------------------------------------------- -proc ::tcl::clock::format { args } { +proc ::tcl::clock::__org_format { args } { variable FormatProc variable TZData diff --git a/library/init.tcl b/library/init.tcl index ef0a84a..6f34302 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 LocalizeFormat SetupTimeZone GetSystemTimeZone __org_scan} { + foreach cmd {add LocalizeFormat SetupTimeZone GetSystemTimeZone} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] diff --git a/tests/clock.test b/tests/clock.test index a4641c6..b27d2a3 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18600,6 +18600,11 @@ test clock-6.18 {zone token (%z) is optional} { [clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ } {1246390200 1246386600 1246386600} +test clock-6.19 {no token parsing} { + list [catch { clock scan "%E%O%" -format "%E%O%" }] \ + [catch { clock scan "...%..." -format "...%%..." }] +} {0 0} + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true } -210866803200 -- cgit v0.12 From 76ac8beb0003c05405e55f5abbe17040ff32b2f1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:42:15 +0000 Subject: [temp-commit]: format almost ready (missing some tokens), sprintf replaced with _itoaw (because "sprintf" too slow) --- generic/tclClock.c | 3 +- generic/tclClockFmt.c | 194 +++++++++++++++++++++++++++++++++++++++----------- generic/tclDate.h | 4 ++ 3 files changed, 157 insertions(+), 44 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 935a347..2e2c44b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -93,7 +93,6 @@ static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); -static int IsGregorianLeapYear(TclDateFields *); static int WeekdayOnOrBefore(int, int); static int ClockClicksObjCmd( ClientData clientData, Tcl_Interp *interp, @@ -2471,7 +2470,7 @@ GetJulianDayFromEraYearDay( *---------------------------------------------------------------------- */ -static int +MODULE_SCOPE int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index b46b7bf..f1fdf27 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1762,6 +1762,50 @@ done: } +inline char * +_itoaw( + char *buf, + register int val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + unsigned short int sign = 0; + + /* sign = 1 by negative number */ + if (val < 0) + { + sign = 1; + val = -val; + if (!width) width++; + } + /* check resp. recalculate width (regarding sign) */ + width -= sign; + while (width <= 9 && val >= wrange[width]) { + width++; + } + width += sign; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + *p-- = '0' + (val % 10); + val /= 10; + } while (val > 0); + /* sign by 0 padding */ + if (sign && padchar != '0') { *p-- = '-'; sign = 0; } + /* fulling with pad-char */ + while (p >= buf + sign) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (sign) { *p = '-'; } + + return buf + width; +} + + inline int FrmResultAllocate( register DateFormat *dateFmt, @@ -1789,8 +1833,8 @@ ClockFmtToken_HourAMPM_Proc( ClockFormatToken *tok, int *val) { - *val = ( ( ( *val % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1; - return TCL_OK; + *val = ( ( ( *val % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1; + return TCL_OK; } static int @@ -1819,73 +1863,132 @@ ClockFmtToken_AMPM_Proc( len = Tcl_UtfToUpper(dateFmt->output); } dateFmt->output += len; - *dateFmt->output = '\0'; return TCL_OK; } + +static int +ClockFmtToken_StarDate_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) + { + int fractYear; + /* Get day of year, zero based */ + int doy = dateFmt->date.dayOfYear - 1; + + /* Convert day of year to a fractional year */ + if (IsGregorianLeapYear(&dateFmt->date)) { + fractYear = 1000 * doy / 366; + } else { + fractYear = 1000 * doy / 365; + } + + /* Put together the StarDate as "Stardate %02d%03d.%1d" */ + if (FrmResultAllocate(dateFmt, 20) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, "Stardate ", 9); + dateFmt->output += 9; + dateFmt->output = _itoaw(dateFmt->output, + dateFmt->date.year - RODDENBERRY, '0', 2); + dateFmt->output = _itoaw(dateFmt->output, + fractYear, '0', 3); + *dateFmt->output++ = '.'; + dateFmt->output = _itoaw(dateFmt->output, + dateFmt->date.localSeconds % 86400 / ( 86400 / 10 ), '0', 1); + + return TCL_OK; +} +static int +ClockFmtToken_WeekOfYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int dow = dateFmt->date.dayOfWeek; + if (*tok->tokWord.start == 'U') { + if (dow == 7) { + dow = 0; + } + dow++; + } + *val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7; + return TCL_OK; +} static const char *FmtSTokenMapIndex = - "demNbByYCHMSIklpaAugGjJsnt"; + "demNbByYCHMSIklpaAuwUVgGjJsntQ"; static ClockFormatTokenMap FmtSTokenMap[] = { /* %d */ - {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, /* %e */ - {CFMTT_INT, "%2d", 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, /* %m */ - {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, /* %N */ - {CFMTT_INT, "%2d", 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, /* %b %h */ - {CFMTT_INT, NULL, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), NULL, (void *)MCLIT_MONTHS_ABBREV}, /* %B */ - {CFMTT_INT, NULL, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), NULL, (void *)MCLIT_MONTHS_FULL}, /* %y */ - {CFMTT_INT, "%02d", 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, /* %Y */ - {CFMTT_INT, "%04d", 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, /* %C */ - {CFMTT_INT, "%02d", 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, + {CFMTT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, /* %H */ - {CFMTT_INT, "%02d", 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, /* %M */ - {CFMTT_INT, "%02d", 0, 60, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.localSeconds), NULL}, /* %S */ - {CFMTT_INT, "%02d", 0, 0, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.localSeconds), NULL}, /* %I */ - {CFMTT_INT, "%02d", CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), ClockFmtToken_HourAMPM_Proc, NULL}, /* %k */ - {CFMTT_INT, "%2d", 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, /* %l */ - {CFMTT_INT, "%2d", CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), ClockFmtToken_HourAMPM_Proc, NULL}, /* %p %P */ - {CFMTT_INT, "%02d", 0, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), ClockFmtToken_AMPM_Proc, NULL}, /* %a */ - {CFMTT_INT, NULL, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV}, /* %A */ - {CFMTT_INT, NULL, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL}, /* %u */ - {CFMTT_INT, "%1d", 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + {CFMTT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %w */ + {CFMTT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %U %W */ + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear), + ClockFmtToken_WeekOfYear_Proc, NULL}, + /* %V */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, /* %g */ - {CFMTT_INT, "%02d", 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, /* %G */ - {CFMTT_INT, "%04d", 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, /* %j */ - {CFMTT_INT, "%03d", 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, + {CFMTT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, /* %J */ - {CFMTT_INT, "%07d", 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + {CFMTT_INT, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, /* %s */ - {CFMTT_WIDE, "%ld", 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + {CFMTT_WIDE, "%ld", 0, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, /* %n */ - {CFMTT_CHAR, "\n", 0, 0, 0, 0, NULL}, + {CFMTT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, /* %t */ - {CFMTT_CHAR, "\t", 0, 0, 0, 0, NULL}, + {CFMTT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, + /* %Q */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_StarDate_Proc, NULL}, #if 0 /* %H %k %I %l */ @@ -1927,14 +2030,14 @@ static ClockFormatTokenMap FmtSTokenMap[] = { #endif }; static const char *FmtSTokenMapAliasIndex[2] = { - "hP", - "bp" + "hPW", + "bpU" }; static const char *FmtETokenMapIndex = "";// "Ey"; static ClockFormatTokenMap FmtETokenMap[] = { - {CFMTT_INT, "%02d", 0, 0, 0, 0, NULL}, + {CFMTT_INT, "0", 2, 0, 0, 0, 0, NULL}, #if 0 /* %EE */ {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateFormat, date.year), @@ -1952,7 +2055,7 @@ static const char *FmtETokenMapAliasIndex[2] = { static const char *FmtOTokenMapIndex = "";// "dmyHMSu"; static ClockFormatTokenMap FmtOTokenMap[] = { - {CFMTT_INT, "%02d", 0, 0, 0, 0, NULL}, + {CFMTT_INT, "0", 2, 0, 0, 0, 0, NULL}, #if 0 /* %Od %Oe */ {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), @@ -1986,7 +2089,7 @@ static const char *FmtOTokenMapAliasIndex[2] = { }; static ClockFormatTokenMap FmtWordTokenMap = { - CTOKT_WORD, NULL, 0, 0, 0, 0, NULL + CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL }; /* @@ -2168,8 +2271,12 @@ ClockFormat( } } if (!(map->flags & CLFMT_LOCALE_INDX)) { - if (FrmResultAllocate(dateFmt, 10) != TCL_OK) { goto error; }; - dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { goto error; }; + if (map->width) { + dateFmt->output = _itoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } } else { const char *s; Tcl_Obj * mcObj = ClockMCGet(opts, (int)map->data /* mcKey */); @@ -2189,14 +2296,13 @@ ClockFormat( case CFMTT_WIDE: if (1) { Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs); - if (FrmResultAllocate(dateFmt, 20) != TCL_OK) { goto error; }; + if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; }; dateFmt->output += sprintf(dateFmt->output, map->tostr, val); } break; case CFMTT_CHAR: if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; }; *dateFmt->output++ = *map->tostr; - *dateFmt->output = '\0'; break; case CFMTT_PROC: if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) { @@ -2207,9 +2313,12 @@ ClockFormat( if (1) { int len = tok->tokWord.end - tok->tokWord.start; if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; }; - memcpy(dateFmt->output, tok->tokWord.start, len); - dateFmt->output += len; - *dateFmt->output = '\0'; + if (len == 1) { + *dateFmt->output++ = *tok->tokWord.start; + } else { + memcpy(dateFmt->output, tok->tokWord.start, len); + dateFmt->output += len; + } } break; } @@ -2232,6 +2341,7 @@ done: if (result->bytes == NULL) { result->bytes = dateFmt->resMem; } + result->bytes[result->length] = '\0'; Tcl_SetObjResult(opts->interp, result); return TCL_OK; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 141ad60..c5d7da5 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -29,6 +29,8 @@ #define FOUR_YEARS 1461 /* days */ #define ONE_YEAR 365 /* days */ +#define RODDENBERRY 1946 /* Another epoch (Hi, Jeff!) */ + #define CLF_OPTIONAL (1 << 0) /* token is non mandatory */ #define CLF_JULIANDAY (1 << 3) @@ -403,6 +405,7 @@ typedef int ClockFormatTokenProc( typedef struct ClockFormatTokenMap { unsigned short int type; const char *tostr; + unsigned short int width; unsigned short int flags; unsigned short int divider; unsigned short int divmod; @@ -441,6 +444,7 @@ typedef struct ClockFmtScnStorage { MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); +MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); -- cgit v0.12 From 5d100ec32832dcd2eb49c5e734a2664e1f240c41 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:43:22 +0000 Subject: porting of clock format completed; all clock test cases passed --- generic/tclClock.c | 30 ++- generic/tclClockFmt.c | 511 +++++++++++++++++++++++++++++++++------------- generic/tclDate.h | 9 + tests-perf/clock.perf.tcl | 75 ++++++- 4 files changed, 478 insertions(+), 147 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 2e2c44b..28a484f 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -70,8 +70,6 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ -static int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, - TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, TclDateFields *, int, Tcl_Obj *const[], Tcl_WideInt rangesVal[2]); @@ -86,8 +84,6 @@ 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 *, Tcl_WideInt rangesVal[2]); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -1730,7 +1726,7 @@ ConvertLocalToUTCUsingC( *---------------------------------------------------------------------- */ -static int +MODULE_SCOPE int ConvertUTCToLocal( ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ @@ -1974,7 +1970,7 @@ ConvertUTCToLocalUsingC( *---------------------------------------------------------------------- */ -static Tcl_Obj * +MODULE_SCOPE Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ @@ -2950,7 +2946,7 @@ ClockFormatObjCmd( DateFormat dateFmt; /* Common structure used for formatting */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, "string " + Tcl_WrongNumArgs(interp, 1, objv, "clockval " "?-format string? " "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"); @@ -2974,6 +2970,16 @@ ClockFormatObjCmd( return TCL_ERROR; } + /* + * seconds could be an unsigned number that overflowed. Make sure + * that it isn't. + */ + + if (objv[1]->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + return TCL_ERROR; + } + memset(&dateFmt, 0, sizeof(dateFmt)); /* @@ -3065,6 +3071,16 @@ ClockScanObjCmd( if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { return TCL_ERROR; } + /* + * seconds could be an unsigned number that overflowed. Make sure + * that it isn't. + */ + + if (opts.baseObj->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + return TCL_ERROR; + } + } else { Tcl_Time now; Tcl_GetTime(&now); diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index f1fdf27..55e328c 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -101,6 +101,161 @@ _str2wideInt( return TCL_OK; } +inline char * +_itoaw( + char *buf, + register int val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + while (width <= 9 && val >= wrange[width]) { + width++; + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + while (width <= 9 && val <= -wrange[width]) { + width++; + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + +inline char * +_witoaw( + char *buf, + register Tcl_WideInt val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + if (val >= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 >= wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val >= wrange[width]) { + width++; + } + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + if (val <= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 <= -wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val <= -wrange[width]) { + width++; + } + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + /* *---------------------------------------------------------------------- */ @@ -1760,51 +1915,6 @@ done: return ret; } - - -inline char * -_itoaw( - char *buf, - register int val, - char padchar, - unsigned short int width) -{ - register char *p; - static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; - unsigned short int sign = 0; - - /* sign = 1 by negative number */ - if (val < 0) - { - sign = 1; - val = -val; - if (!width) width++; - } - /* check resp. recalculate width (regarding sign) */ - width -= sign; - while (width <= 9 && val >= wrange[width]) { - width++; - } - width += sign; - /* number to string backwards */ - p = buf + width; - *p-- = '\0'; - do { - *p-- = '0' + (val % 10); - val /= 10; - } while (val > 0); - /* sign by 0 padding */ - if (sign && padchar != '0') { *p-- = '-'; sign = 0; } - /* fulling with pad-char */ - while (p >= buf + sign) { - *p-- = padchar; - } - /* sign by non 0 padding */ - if (sign) { *p = '-'; } - - return buf + width; -} - inline int FrmResultAllocate( @@ -1833,7 +1943,7 @@ ClockFmtToken_HourAMPM_Proc( ClockFormatToken *tok, int *val) { - *val = ( ( ( *val % 86400 ) + 86400 - 3600 ) / 3600 ) % 12 + 1; + *val = ( ( ( *val % SECONDS_PER_DAY ) + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1; return TCL_OK; } @@ -1848,7 +1958,7 @@ ClockFmtToken_AMPM_Proc( const char *s; int len; - if ((*val % 84600) < (84600 / 2)) { + if ((*val % SECONDS_PER_DAY) < (SECONDS_PER_DAY / 2)) { mcObj = ClockMCGet(opts, MCLIT_AM); } else { mcObj = ClockMCGet(opts, MCLIT_PM); @@ -1895,7 +2005,7 @@ ClockFmtToken_StarDate_Proc( fractYear, '0', 3); *dateFmt->output++ = '.'; dateFmt->output = _itoaw(dateFmt->output, - dateFmt->date.localSeconds % 86400 / ( 86400 / 10 ), '0', 1); + dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); return TCL_OK; } @@ -1916,9 +2026,162 @@ ClockFmtToken_WeekOfYear_Proc( *val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7; return TCL_OK; } +static int +ClockFmtToken_TimeZone_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + if (*tok->tokWord.start == 'z') { + int z = dateFmt->date.tzOffset; + char sign = '+'; + if ( z < 0 ) { + z = -z; + sign = '-'; + } + if (FrmResultAllocate(dateFmt, 7) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = sign; + dateFmt->output = _itoaw(dateFmt->output, z / 3600, '0', 2); + z %= 3600; + dateFmt->output = _itoaw(dateFmt->output, z / 60, '0', 2); + z %= 60; + if (z != 0) { + dateFmt->output = _itoaw(dateFmt->output, z, '0', 2); + } + } else { + Tcl_Obj * objPtr; + const char *s; int len; + /* convert seconds to local seconds to obtain tzName object */ + if (ConvertUTCToLocal(opts->clientData, opts->interp, + &dateFmt->date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { + return TCL_ERROR; + }; + objPtr = dateFmt->date.tzName; + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERA_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if (dateFmt->date.era == BCE) { + mcObj = ClockMCGet(opts, MCLIT_BCE); + } else { + mcObj = ClockMCGet(opts, MCLIT_CE); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERAYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int rowc; + Tcl_Obj **rowv; + + if (dateFmt->localeEra == NULL) { + Tcl_Obj *mcObj = ClockMCGet(opts, MCLIT_LOCALE_ERAS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { + return TCL_ERROR; + } + if (rowc != 0) { + dateFmt->localeEra = LookupLastTransition(opts->interp, + dateFmt->date.localSeconds, rowc, rowv, NULL); + } + if (dateFmt->localeEra == NULL) { + dateFmt->localeEra = (Tcl_Obj*)1; + } + } + + /* if no LOCALE_ERAS in catalog or era not found */ + if (dateFmt->localeEra == (Tcl_Obj*)1) { + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + if (*tok->tokWord.start == 'C') { /* %EC */ + *val = dateFmt->date.year / 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } else { /* %Ey */ + *val = dateFmt->date.year % 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } + } else { + Tcl_Obj *objPtr; + const char *s; + int len; + if (*tok->tokWord.start == 'C') { /* %EC */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + } else { /* %Ey */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 2, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) { + return TCL_ERROR; + } + *val = dateFmt->date.year - *val; + /* if year in locale numerals */ + if (*val >= 0 && *val < 100) { + /* year as integer */ + Tcl_Obj * mcObj = ClockMCGet(opts, MCLIT_LOCALE_NUMERALS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + /* year as integer */ + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + return TCL_OK; + } + } + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + static const char *FmtSTokenMapIndex = - "demNbByYCHMSIklpaAuwUVgGjJsntQ"; + "demNbByYCHMSIklpaAuwUVzgGjJsntQ"; static ClockFormatTokenMap FmtSTokenMap[] = { /* %d */ {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, @@ -1941,21 +2204,21 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %C */ {CFMTT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, /* %H */ - {CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, /* %M */ - {CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, /* %S */ - {CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, /* %I */ - {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), ClockFmtToken_HourAMPM_Proc, NULL}, /* %k */ - {CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.localSeconds), NULL}, + {CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, /* %l */ - {CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), ClockFmtToken_HourAMPM_Proc, NULL}, /* %p %P */ - {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay), ClockFmtToken_AMPM_Proc, NULL}, /* %a */ {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), @@ -1972,6 +2235,9 @@ static ClockFormatTokenMap FmtSTokenMap[] = { ClockFmtToken_WeekOfYear_Proc, NULL}, /* %V */ {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, + /* %z %Z */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_TimeZone_Proc, NULL}, /* %g */ {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, /* %G */ @@ -1981,7 +2247,7 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %J */ {CFMTT_INT, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, /* %s */ - {CFMTT_WIDE, "%ld", 0, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, /* %n */ {CFMTT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, /* %t */ @@ -1989,103 +2255,61 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %Q */ {CFMTT_INT, NULL, 0, 0, 0, 0, 0, ClockFmtToken_StarDate_Proc, NULL}, - -#if 0 - /* %H %k %I %l */ - {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.hour), - NULL}, - /* %M */ - {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.minutes), - NULL}, - /* %S */ - {CFMTT_INT, CLF_TIME, 1, 2, TclOffset(DateFormat, date.secondOfDay), - NULL}, - /* %p %P */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, - ClockFmtToken_amPmInd_Proc, NULL}, - /* %J */ - {CFMTT_INT, CLF_JULIANDAY, 1, 0xffff, TclOffset(DateFormat, date.julianDay), - NULL}, - /* %j */ - {CFMTT_INT, CLF_DAYOFYEAR, 1, 3, TclOffset(DateFormat, date.dayOfYear), - NULL}, - /* %g */ - {CFMTT_INT, CLF_ISO8601YEAR | CLF_ISO8601, 2, 2, TclOffset(DateFormat, date.iso8601Year), - NULL}, - /* %G */ - {CFMTT_INT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 4, 4, TclOffset(DateFormat, date.iso8601Year), - NULL}, - /* %V */ - {CFMTT_INT, CLF_ISO8601, 1, 2, TclOffset(DateFormat, date.iso8601Week), - NULL}, - /* %a %A %u %w */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, - ClockFmtToken_DayOfWeek_Proc, NULL}, - /* %z %Z */ - {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0, - ClockFmtToken_TimeZone_Proc, NULL}, - /* %s */ - {CFMTT_INT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateFormat, date.localSeconds), - NULL}, -#endif }; static const char *FmtSTokenMapAliasIndex[2] = { - "hPW", - "bpU" + "hPWZ", + "bpUz" }; static const char *FmtETokenMapIndex = -"";// "Ey"; + "Ey"; static ClockFormatTokenMap FmtETokenMap[] = { - {CFMTT_INT, "0", 2, 0, 0, 0, 0, NULL}, -#if 0 /* %EE */ - {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateFormat, date.year), - ClockFmtToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, - /* %Ey */ - {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, -#endif + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era), + ClockFmtToken_LocaleERA_Proc, NULL}, + /* %Ey %EC */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), + ClockFmtToken_LocaleERAYear_Proc, NULL}, }; static const char *FmtETokenMapAliasIndex[2] = { - "", - "" + "C", + "y" }; static const char *FmtOTokenMapIndex = -"";// "dmyHMSu"; + "dmyHIMSuw"; static ClockFormatTokenMap FmtOTokenMap[] = { - {CFMTT_INT, "0", 2, 0, 0, 0, 0, NULL}, -#if 0 /* %Od %Oe */ - {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfMonth), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, /* %Om */ - {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, TclOffset(DateFormat, date.month), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, /* %Oy */ - {CTOKT_PARSER, CLF_YEAR, 0, 0, 0, TclOffset(DateFormat, date.year), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, - /* %OH %Ok %OI %Ol */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.hour), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.year), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 3600, 24, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OI %Ol */ + {CFMTT_INT, NULL, 0, CLFMT_CALC | CLFMT_LOCALE_INDX, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %OM */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.minutes), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 60, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, /* %OS */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay), - ClockFmtToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, - /* %Ou Ow */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, - ClockFmtToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, -#endif + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ow */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *FmtOTokenMapAliasIndex[2] = { -"", "" -#if 0 - "ekIlw", - "dHHHu" -#endif + "ekl", + "dHI" }; static ClockFormatTokenMap FmtWordTokenMap = { @@ -2232,7 +2456,14 @@ ClockFormat( return TCL_ERROR; } - dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); /* result container object */ + /* prepare formatting */ + dateFmt->date.secondOfDay = (int)(dateFmt->date.localSeconds % SECONDS_PER_DAY); + if (dateFmt->date.secondOfDay < 0) { + dateFmt->date.secondOfDay += SECONDS_PER_DAY; + } + + /* result container object */ + dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); if (dateFmt->resMem == NULL) { return TCL_ERROR; } @@ -2283,7 +2514,9 @@ ClockFormat( if (mcObj == NULL) { goto error; } - if (Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK) { + if ( Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK + || mcObj == NULL + ) { goto error; } s = TclGetString(mcObj); @@ -2297,7 +2530,11 @@ ClockFormat( if (1) { Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs); if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; }; - dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + if (map->width) { + dateFmt->output = _witoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } } break; case CFMTT_CHAR: diff --git a/generic/tclDate.h b/generic/tclDate.h index c5d7da5..7c68b2a 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -109,6 +109,7 @@ typedef enum ClockMsgCtLiteral { MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB, MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB, MCLIT_AM, MCLIT_PM, + MCLIT_LOCALE_ERAS, MCLIT_BCE, MCLIT_CE, MCLIT_BCE2, MCLIT_CE2, MCLIT_BCE3, MCLIT_CE3, @@ -121,6 +122,7 @@ typedef enum ClockMsgCtLiteral { pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ pref "AM", pref "PM", \ + pref "LOCALE_ERAS", \ pref "BCE", pref "CE", \ pref "b.c.e.", pref "c.e.", \ pref "b.c.", pref "a.d.", \ @@ -387,6 +389,8 @@ typedef struct DateFormat { char *output; TclDateFields date; + + Tcl_Obj *localeEra; } DateFormat; #define CLFMT_INCR (1 << 3) @@ -445,6 +449,11 @@ typedef struct ClockFmtScnStorage { MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); +MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, + TclDateFields *, Tcl_Obj *timezoneObj, int); +MODULE_SCOPE Tcl_Obj * + LookupLastTransition(Tcl_Interp *, Tcl_WideInt, + int, Tcl_Obj *const *, Tcl_WideInt rangesVal[2]); MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 41cc9e1..043d27f 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -56,7 +56,7 @@ proc _test_out_total {} { puts [format "Total %d cases in %.2f sec.:" [llength $_(itcnt)] [expr {[llength $_(itcnt)] * $_(reptime) / 1000.0}]] lset _(m) 0 [format %.6f [expr [join $_(ittm) +]]] lset _(m) 2 [expr [join $_(itcnt) +]] - lset _(m) 4 [expr {[lindex $_(m) 2] / ([llength $_(itcnt)] * $_(reptime) / 1000.0)}] + lset _(m) 4 [format %.3f [expr {[lindex $_(m) 2] / ([llength $_(itcnt)] * $_(reptime) / 1000.0)}]] puts $_(m) puts "Average:" lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / [llength $_(itcnt)]}]] @@ -95,6 +95,74 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} { _test_out_total } +proc test-format {{reptime 1000}} { + _test_run $reptime { + # Format : date only (in gmt) + {clock format 1482525936 -format "%Y-%m-%d" -gmt 1} + # Format : date only (system zone) + {clock format 1482525936 -format "%Y-%m-%d"} + # Format : date only (CEST) + {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M:%S" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M:%S"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M:%S" -timezone :CET} + # Format : default (in gmt) + {clock format 1482525936 -gmt 1} + # Format : default (system zone) + {clock format 1482525936} + # Format : default (CEST) + {clock format 1482525936 -timezone :CET} + # Format : ISO date-time (in gmt, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1} + # Format : ISO date-time (system zone, CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"} + # Format : ISO date-time (CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET} + # Format : ISO date-time (system zone, CEST) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"} + # Format : julian day with time (in gmt): + {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1} + # Format : julian day with time (system zone): + {clock format 1246379415 -format "%J %H:%M:%S"} + + # Format : locale date-time (en): + {clock format 1246379415 -format "%x %X" -locale en} + # Format : locale date-time (de): + {clock format 1246379415 -format "%x %X" -locale de} + + # Format : locale lookup table month: + {clock format 1246379400 -format "%b" -locale en -gmt 1} + # Format : locale lookup 2 tables - month and day: + {clock format 1246379400 -format "%b %Od" -locale en -gmt 1} + + # Format : dynamic clock value (without converter caches): + {set i 0; continue} + {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1} + {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1]\n; continue} + # Format : dynamic clock value (without any converter caches, zone range overflow): + {set i 0; continue} + {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1} + {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1]\n; continue} + + # Format : dynamic format (cacheable) + {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1} + + # Format : all (in gmt, locale en) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} + # Format : all (in CET, locale de) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} + } +} + proc test-scan {{reptime 1000}} { _test_run $reptime { # Scan : date (in gmt) @@ -146,7 +214,7 @@ proc test-scan {{reptime 1000}} { # Scan : century, lookup table month {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} # Scan : century, lookup table month and day (both entries are first) - {clock scan {1970 Jan 02} -format {%C%y %b %Od} -locale en -gmt 1} + {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1} # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} @@ -235,8 +303,9 @@ proc test-other {{reptime 1000}} { proc test {{reptime 1000}} { puts "" + test-format $reptime test-scan $reptime - #test-freescan $reptime + test-freescan $reptime test-other $reptime puts \n**OK** -- cgit v0.12 From 9ece7c7e6960bda4940f6b550d3522be072a1092 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:44:30 +0000 Subject: several missing scan tokens added, test cases extended and fixed; token "%s" used for seconds only (time zone independent), additionally "%Es" token added for local seconds (zone dependent seconds); --- generic/tclClock.c | 16 ++--- generic/tclClockFmt.c | 174 ++++++++++++++++++++++++++++++++++++++++---------- generic/tclDate.h | 16 ++++- tests/clock.test | 49 +++++++++++++- 4 files changed, 208 insertions(+), 47 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 28a484f..a3a9332 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -87,8 +87,6 @@ static int ClockConfigureObjCmd(ClientData clientData, static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); -static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); -static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); static int WeekdayOnOrBefore(int, int); static int ClockClicksObjCmd( ClientData clientData, Tcl_Interp *interp, @@ -2266,7 +2264,7 @@ GetMonthDay( *---------------------------------------------------------------------- */ -static void +MODULE_SCOPE void GetJulianDayFromEraYearWeekDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Julian Day Number of the Gregorian @@ -2319,7 +2317,7 @@ GetJulianDayFromEraYearWeekDay( *---------------------------------------------------------------------- */ -static void +MODULE_SCOPE void GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ @@ -2415,7 +2413,7 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ -static void +MODULE_SCOPE void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ @@ -3169,9 +3167,11 @@ ClockScanObjCmd( + ( yySeconds % SECONDS_PER_DAY ); } - if (ConvertLocalToUTC(clientData, interp, &yydate, opts.timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { - goto done; + if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) { + if (ConvertLocalToUTC(clientData, interp, &yydate, opts.timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { + goto done; + } } /* Increment UTC seconds with relative time */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 55e328c..7a6fa0b 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -50,7 +50,7 @@ _str2int( int sign) { register time_t val = 0, prev = 0; - if (sign > 0) { + if (sign >= 0) { while (p < e) { val = val * 10 + (*p++ - '0'); if (val < prev) { @@ -80,7 +80,7 @@ _str2wideInt( int sign) { register Tcl_WideInt val = 0, prev = 0; - if (sign > 0) { + if (sign >= 0) { while (p < e) { val = val * 10 + (*p++ - '0'); if (val < prev) { @@ -1296,13 +1296,91 @@ ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, return TCL_OK; } +static int +ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + register const char *p = yyInput, *end; const char *s; + time_t year, fractYear, fractDayDiv, fractDay; + static const char *stardatePref = "stardate "; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + end = yyInput + maxLen; + + /* stardate string */ + p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s); + if (p >= end || p - yyInput < 9) { + return TCL_RETURN; + } + /* bypass spaces */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + if (p >= end) { + return TCL_RETURN; + } + /* currently positive stardate only */ + if (*p == '+') { p++; }; + s = p; + while (p < end && isdigit(UCHAR(*p))) { + p++; + } + if (p >= end || p - s < 4) { + return TCL_RETURN; + } + if ( _str2int(&year, s, p-3, 1) != TCL_OK + || _str2int(&fractYear, p-3, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + if (*p++ != '.') { + return TCL_RETURN; + } + s = p; + fractDayDiv = 1; + while (p < end && isdigit(UCHAR(*p))) { + fractDayDiv *= 10; + p++; + } + if ( _str2int(&fractDay, s, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + yyInput = p; + + /* Build a date from year and fraction. */ + + yydate.year = year + RODDENBERRY; + yydate.era = CE; + yydate.gregorian = 1; + + if (IsGregorianLeapYear(&yydate)) { + fractYear *= 366; + } else { + fractYear *= 365; + } + yydate.dayOfYear = fractYear / 1000 + 1; + if (fractYear % 1000 >= 500) { + yydate.dayOfYear++; + } + + GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + + yydate.seconds = + -210866803200L + + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + + ( SECONDS_PER_DAY * fractDay / fractDayDiv ); + + return TCL_OK; +} + static const char *ScnSTokenMapIndex = - "dmbyYHMSpJjCgGVazs"; + "dmbyYHMSpJjCgGVazUsntQ"; static ClockScanTokenMap ScnSTokenMap[] = { /* %d %e */ {CTOKT_DIGIT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth), NULL}, - /* %m */ + /* %m %N */ {CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), NULL}, /* %b %B %h */ @@ -1350,17 +1428,27 @@ static ClockScanTokenMap ScnSTokenMap[] = { /* %z %Z */ {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0, 0, ClockScnToken_TimeZone_Proc, NULL}, + /* %U %W */ + {CTOKT_DIGIT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */ + NULL}, /* %s */ - {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + {CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), NULL}, + /* %n */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, + /* %t */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, + /* %Q */ + {CTOKT_PARSER, CLF_POSIXSEC, 0, 16, 30, 0, + ClockScnToken_StarDate_Proc, NULL}, }; static const char *ScnSTokenMapAliasIndex[2] = { - "eNBhkIlPAuwZ", - "dmbbHHHpaaaz" + "eNBhkIlPAuwZW", + "dmbbHHHpaaazU" }; static const char *ScnETokenMapIndex = - "Ey"; + "Eys"; static ClockScanTokenMap ScnETokenMap[] = { /* %EE */ {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateInfo, date.year), @@ -1368,6 +1456,9 @@ static ClockScanTokenMap ScnETokenMap[] = { /* %Ey */ {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Es */ + {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + NULL}, }; static const char *ScnETokenMapAliasIndex[2] = { "", @@ -1427,7 +1518,10 @@ EstimateTokenCount( /* estimate token count by % char and format length */ tokcnt = 0; while (p <= end) { - if (*p++ == '%') tokcnt++; + if (*p++ == '%') { + tokcnt++; + p++; + } } p = fmt + tokcnt * 2; if (p < end) { @@ -1653,7 +1747,9 @@ ClockScan( map = tok->map; /* bypass spaces at begin of input before parsing each token */ if ( !(opts->flags & CLF_STRICT) - && (map->type != CTOKT_SPACE && map->type != CTOKT_WORD) + && ( map->type != CTOKT_SPACE + && map->type != CTOKT_WORD + && map->type != CTOKT_CHAR ) ) { while (p < end && isspace(UCHAR(*p))) { p++; @@ -1710,27 +1806,28 @@ ClockScan( if (size < map->minSize) { /* missing input -> error */ if ((map->flags & CLF_OPTIONAL)) { - yyInput = p; continue; } goto not_match; } /* string 2 number, put number into info structure by offset */ - p = yyInput; x = p + size; - if (!(map->flags & CLF_LOCALSEC)) { - if (_str2int((time_t *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; - } - p = x; - } else { - if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; + if (map->offs) { + p = yyInput; x = p + size; + if (!(map->flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { + if (_str2int((time_t *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; } - p = x; + flags = (flags & ~map->clearFlags) | map->flags; } - flags = (flags & ~map->clearFlags) | map->flags; } break; case CTOKT_PARSER: @@ -1771,7 +1868,14 @@ ClockScan( goto not_match; } p = x; - continue; + break; + case CTOKT_CHAR: + x = (char *)map->data; + if (*x != *p) { + /* no match -> error */ + goto not_match; + } + p++; break; } } @@ -1802,7 +1906,7 @@ ClockScan( */ /* seconds token (%s) take precedence over all other tokens */ - if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_LOCALSEC)) { + if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) { if (flags & CLF_DATE) { if (!(flags & CLF_JULIANDAY)) { @@ -1876,7 +1980,7 @@ ClockScan( } /* if no time - reset time */ - if (!(flags & (CLF_TIME|CLF_LOCALSEC))) { + if (!(flags & (CLF_TIME|CLF_LOCALSEC|CLF_POSIXSEC))) { info->flags |= CLF_ASSEMBLE_SECONDS; yydate.localSeconds = 0; } @@ -1886,7 +1990,7 @@ ClockScan( yySeconds = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); } else - if (!(flags & CLF_LOCALSEC)) { + if (!(flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { info->flags |= CLF_ASSEMBLE_SECONDS; yySeconds = yydate.localSeconds % SECONDS_PER_DAY; } @@ -1996,7 +2100,7 @@ ClockFmtToken_StarDate_Proc( } /* Put together the StarDate as "Stardate %02d%03d.%1d" */ - if (FrmResultAllocate(dateFmt, 20) != TCL_OK) { return TCL_ERROR; }; + if (FrmResultAllocate(dateFmt, 30) != TCL_OK) { return TCL_ERROR; }; memcpy(dateFmt->output, "Stardate ", 9); dateFmt->output += 9; dateFmt->output = _itoaw(dateFmt->output, @@ -2005,7 +2109,7 @@ ClockFmtToken_StarDate_Proc( fractYear, '0', 3); *dateFmt->output++ = '.'; dateFmt->output = _itoaw(dateFmt->output, - dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); + dateFmt->date.seconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); return TCL_OK; } @@ -2249,9 +2353,9 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %s */ {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, /* %n */ - {CFMTT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, + {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, /* %t */ - {CFMTT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, + {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, /* %Q */ {CFMTT_INT, NULL, 0, 0, 0, 0, 0, ClockFmtToken_StarDate_Proc, NULL}, @@ -2262,7 +2366,7 @@ static const char *FmtSTokenMapAliasIndex[2] = { }; static const char *FmtETokenMapIndex = - "Ey"; + "Eys"; static ClockFormatTokenMap FmtETokenMap[] = { /* %EE */ {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era), @@ -2270,6 +2374,8 @@ static ClockFormatTokenMap FmtETokenMap[] = { /* %Ey %EC */ {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), ClockFmtToken_LocaleERAYear_Proc, NULL}, + /* %Es */ + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL}, }; static const char *FmtETokenMapAliasIndex[2] = { "C", @@ -2537,7 +2643,7 @@ ClockFormat( } } break; - case CFMTT_CHAR: + case CTOKT_CHAR: if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; }; *dateFmt->output++ = *map->tostr; break; diff --git a/generic/tclDate.h b/generic/tclDate.h index 7c68b2a..2ce629d 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -33,9 +33,10 @@ #define CLF_OPTIONAL (1 << 0) /* token is non mandatory */ +#define CLF_POSIXSEC (1 << 1) +#define CLF_LOCALSEC (1 << 2) #define CLF_JULIANDAY (1 << 3) #define CLF_TIME (1 << 4) -#define CLF_LOCALSEC (1 << 5) #define CLF_CENTURY (1 << 6) #define CLF_DAYOFMONTH (1 << 7) #define CLF_DAYOFYEAR (1 << 8) @@ -355,8 +356,8 @@ typedef int ClockScanTokenProc( typedef enum _CLCKTOK_TYPE { - CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, - CFMTT_INT, CFMTT_WIDE, CFMTT_CHAR, CFMTT_PROC + CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR, + CFMTT_INT, CFMTT_WIDE, CFMTT_PROC } CLCKTOK_TYPE; typedef struct ClockScanTokenMap { @@ -449,6 +450,15 @@ typedef struct ClockFmtScnStorage { MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, time_t Seconds, MERIDIAN Meridian); MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); +MODULE_SCOPE void + GetJulianDayFromEraYearWeekDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearMonthDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearDay( + TclDateFields *fields, int changeover); MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); MODULE_SCOPE Tcl_Obj * diff --git a/tests/clock.test b/tests/clock.test index b27d2a3..4b0587a 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18605,6 +18605,40 @@ test clock-6.19 {no token parsing} { [catch { clock scan "...%..." -format "...%%..." }] } {0 0} +test clock-6.20 {special char tokens %n, %t} { + clock scan "30\t06\t2009\n18\t30" -format "%d%t%m%t%Y%n%H%t%M" -gmt 1 +} 1246386600 + +# Hi, Jeff! +test clock-6.21.0 {Stardate 0 day} { + list [set d [clock format -757382400 -format "%Q" -gmt 1]] \ + [clock scan $d -format "%Q" -gmt 1] +} [list "Stardate 00000.0" -757382400] +test clock-6.21.1 {Stardate} { + list [set d [clock format 1482857280 -format "%Q" -gmt 1]] \ + [clock scan $d -format "%Q" -gmt 1] +} [list "Stardate 70986.7" 1482857280] +test clock-6.21.2 {Stardate next time} { + list [set d [clock format 1482865920 -format "%Q" -gmt 1]] \ + [clock scan $d -format "%Q" -gmt 1] +} [list "Stardate 70986.8" 1482865920] +test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)} -body { + set s [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1] + set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]] + set wrong {} + while {[incr i 86400] < $s + 86400*366*2} { + set d [clock format $i -f "%Q" -g 1] + set i2 [clock scan $d -f "%Q" -g 1] + if {$i != $i2} { + lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]" + } + } + join $wrong \n +} -result {} -cleanup { + unset -nocomplain wrong i i2 s d +} + + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true } -210866803200 @@ -36080,10 +36114,21 @@ test clock-37.1 {%s gmt testing} { set s [clock seconds] set a [clock format $s -format %s -gmt 0] set b [clock format $s -format %s -gmt 1] + set c [clock scan $s -format %s -gmt 0] + set d [clock scan $s -format %s -gmt 1] # %s, being the difference between local and Greenwich, does not # depend on the time zone. - set c [expr {$b-$a}] -} {0} + list [expr {$b-$a}] [expr {$d-$c}] +} {0 0} +test clock-37.2 {%Es gmt testing} { + set s [clock seconds] + set a [clock format $s -format %Es -timezone CET] + set b [clock format $s -format %Es -gmt 1] + set c [clock scan $s -format %Es -timezone CET] + set d [clock scan $s -format %Es -gmt 1] + # %Es depend on the time zone (local seconds instead of posix seconds). + list [expr {$b-$a}] [expr {$d-$c}] +} {-3600 3600} test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \ -setup { -- cgit v0.12 From 8ea52694c552cb1c68f8853af7a3887c71b9ba2a Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:44:55 +0000 Subject: performance test cases ready --- tests-perf/clock.perf.tcl | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 043d27f..34d9429 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -97,6 +97,12 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} { proc test-format {{reptime 1000}} { _test_run $reptime { + # Format : short, week only (in gmt) + {clock format 1482525936 -format "%u" -gmt 1} + # Format : short, week only (system zone) + {clock format 1482525936 -format "%u"} + # Format : short, week only (CEST) + {clock format 1482525936 -format "%u" -timezone :CET} # Format : date only (in gmt) {clock format 1482525936 -format "%Y-%m-%d" -gmt 1} # Format : date only (system zone) @@ -229,12 +235,6 @@ proc test-scan {{reptime 1000}} { {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} break - - # Scan : zone only - {clock scan "CET" -format "%z"} - {clock scan "EST" -format "%z"} - {**STOP** : Wed Nov 25 01:00:00 CET 2015} - # # Scan : long format test (allock chain) # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): @@ -293,7 +293,6 @@ proc test-other {{reptime 1000}} { # Scan : julian day (overflow) {catch {clock scan 5373485 -format %J}} - **STOP** # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) -- cgit v0.12 From 4652be3e6ba87fa5d1044c3e53396f5fe6f059bf Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:45:29 +0000 Subject: small code review, performance test cases ready. --- generic/tclClock.c | 2 +- generic/tclClockFmt.c | 6 +++--- tests-perf/clock.perf.tcl | 32 ++++++++++++++++++++------------ 3 files changed, 24 insertions(+), 16 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a3a9332..7d4263c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3488,7 +3488,7 @@ ClockSecondsObjCmd( /* *---------------------------------------------------------------------- * - * TzsetIfNecessary -- + * TzsetGetEpoch --, TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ * environment variable has changed. diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 7a6fa0b..307fc28 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1366,7 +1366,7 @@ ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); - yydate.seconds = + yydate.localSeconds = -210866803200L + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + ( SECONDS_PER_DAY * fractDay / fractDayDiv ); @@ -1439,7 +1439,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { /* %t */ {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, /* %Q */ - {CTOKT_PARSER, CLF_POSIXSEC, 0, 16, 30, 0, + {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0, ClockScnToken_StarDate_Proc, NULL}, }; static const char *ScnSTokenMapAliasIndex[2] = { @@ -2109,7 +2109,7 @@ ClockFmtToken_StarDate_Proc( fractYear, '0', 3); *dateFmt->output++ = '.'; dateFmt->output = _itoaw(dateFmt->output, - dateFmt->date.seconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); + dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); return TCL_OK; } diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 34d9429..f3b8a10 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -32,7 +32,7 @@ proc {**STOP**} {args} { } proc _test_get_commands {lst} { - regsub -all {(?:^|\n)[ \t]*(\#[^\n]*)(?=\n\s*[\{\#])} $lst "\n{\\1}" + regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup))} $lst "\n{\\1}" } proc _test_out_total {} { @@ -83,7 +83,11 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} { foreach _(c) [_test_get_commands $lst] { puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" - if {[regexp {\s*\#} $_(c)]} continue + if {[regexp {^\s*\#} $_(c)]} continue + if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} { + puts [if 1 [lindex $_(c) 1]] + continue + } set _(r) [if 1 $_(c)] if {$outcmd ne {}} $outcmd puts [set _(m) [timerate $_(c) $reptime]] @@ -122,11 +126,11 @@ proc test-format {{reptime 1000}} { # Format : time only (CEST) {clock format 1482525936 -format "%H:%M:%S" -timezone :CET} # Format : default (in gmt) - {clock format 1482525936 -gmt 1} + {clock format 1482525936 -gmt 1 -locale en} # Format : default (system zone) - {clock format 1482525936} + {clock format 1482525936 -locale en} # Format : default (CEST) - {clock format 1482525936 -timezone :CET} + {clock format 1482525936 -timezone :CET -locale en} # Format : ISO date-time (in gmt, numeric zone) {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1} # Format : ISO date-time (system zone, CEST, numeric zone) @@ -149,15 +153,19 @@ proc test-format {{reptime 1000}} { {clock format 1246379400 -format "%b" -locale en -gmt 1} # Format : locale lookup 2 tables - month and day: {clock format 1246379400 -format "%b %Od" -locale en -gmt 1} + # Format : locale lookup 3 tables - week, month and day: + {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1} + # Format : locale lookup 4 tables - week, month, day and year: + {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1} # Format : dynamic clock value (without converter caches): - {set i 0; continue} - {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1} - {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1]\n; continue} + setup {set i 0} + {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} # Format : dynamic clock value (without any converter caches, zone range overflow): - {set i 0; continue} - {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1} - {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -gmt 1]\n; continue} + setup {set i 0} + {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} # Format : dynamic format (cacheable) {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1} @@ -310,4 +318,4 @@ proc test {{reptime 1000}} { puts \n**OK** } -test 100; # ms +test 500; # ms -- cgit v0.12 From 06def2383669a835dc38d3c7c75374bf36892ca8 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:45:59 +0000 Subject: clock.tcl: clean unused resp. obsolete commands --- library/clock.tcl | 2578 +++++------------------------------------------------ library/init.tcl | 2 +- 2 files changed, 213 insertions(+), 2367 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index 06aa10a..3caa270 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -389,152 +389,6 @@ proc ::tcl::clock::Initialize {} { {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu }] - # Groups of fields that specify the date, priorities, and code bursts that - # determine Julian Day Number given those groups. The code in [clock - # scan] will choose the highest priority (lowest numbered) set of fields - # that determines the date. - - variable DateParseActions { - - { seconds } 0 {} - - { julianDay } 1 {} - - { era century yearOfCentury month dayOfMonth } 2 { - dict set date year [expr { 100 * [dict get $date century] - + [dict get $date yearOfCentury] }] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ - $changeover] - } - { era century yearOfCentury dayOfYear } 2 { - dict set date year [expr { 100 * [dict get $date century] - + [dict get $date yearOfCentury] }] - set date [GetJulianDayFromEraYearDay $date[set date {}] \ - $changeover] - } - - { century yearOfCentury month dayOfMonth } 3 { - dict set date era CE - dict set date year [expr { 100 * [dict get $date century] - + [dict get $date yearOfCentury] }] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ - $changeover] - } - { century yearOfCentury dayOfYear } 3 { - dict set date era CE - dict set date year [expr { 100 * [dict get $date century] - + [dict get $date yearOfCentury] }] - set date [GetJulianDayFromEraYearDay $date[set date {}] \ - $changeover] - } - { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 { - dict set date era CE - dict set date iso8601Year \ - [expr { 100 * [dict get $date iso8601Century] - + [dict get $date iso8601YearOfCentury] }] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ - $changeover] - } - - { yearOfCentury month dayOfMonth } 4 { - set date [InterpretTwoDigitYear $date[set date {}] $baseTime] - dict set date era CE - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ - $changeover] - } - { yearOfCentury dayOfYear } 4 { - set date [InterpretTwoDigitYear $date[set date {}] $baseTime] - dict set date era CE - set date [GetJulianDayFromEraYearDay $date[set date {}] \ - $changeover] - } - { iso8601YearOfCentury iso8601Week dayOfWeek } 4 { - set date [InterpretTwoDigitYear \ - $date[set date {}] $baseTime \ - iso8601YearOfCentury iso8601Year] - dict set date era CE - set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ - $changeover] - } - - { month dayOfMonth } 5 { - set date [AssignBaseYear $date[set date {}] \ - $baseTime $timeZone $changeover] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ - $changeover] - } - { dayOfYear } 5 { - set date [AssignBaseYear $date[set date {}] \ - $baseTime $timeZone $changeover] - set date [GetJulianDayFromEraYearDay $date[set date {}] \ - $changeover] - } - { iso8601Week dayOfWeek } 5 { - set date [AssignBaseIso8601Year $date[set date {}] \ - $baseTime $timeZone $changeover] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ - $changeover] - } - - { dayOfMonth } 6 { - set date [AssignBaseMonth $date[set date {}] \ - $baseTime $timeZone $changeover] - set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \ - $changeover] - } - - { dayOfWeek } 7 { - set date [AssignBaseWeek $date[set date {}] \ - $baseTime $timeZone $changeover] - set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \ - $changeover] - } - - {} 8 { - set date [AssignBaseJulianDay $date[set date {}] \ - $baseTime $timeZone $changeover] - } - } - - # Groups of fields that specify time of day, priorities, and code that - # processes them - - variable TimeParseActions { - - seconds 1 {} - - { hourAMPM minute second amPmIndicator } 2 { - dict set date secondOfDay [InterpretHMSP $date] - } - { hour minute second } 2 { - dict set date secondOfDay [InterpretHMS $date] - } - - { hourAMPM minute amPmIndicator } 3 { - dict set date second 0 - dict set date secondOfDay [InterpretHMSP $date] - } - { hour minute } 3 { - dict set date second 0 - dict set date secondOfDay [InterpretHMS $date] - } - - { hourAMPM amPmIndicator } 4 { - dict set date minute 0 - dict set date second 0 - dict set date secondOfDay [InterpretHMSP $date] - } - { hour } 4 { - dict set date minute 0 - dict set date second 0 - dict set date secondOfDay [InterpretHMS $date] - } - - { } 5 { - dict set date secondOfDay 0 - } - } - # Legacy time zones, used primarily for parsing RFC822 dates. variable LegacyTimeZone [dict create \ @@ -667,2169 +521,281 @@ proc mcget {locale args} { #---------------------------------------------------------------------- # -# clock format -- -# -# Formats a count of seconds since the Posix Epoch as a time of day. -# -# The 'clock format' command formats times of day for output. Refer to the -# user documentation to see what it does. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::__org_format { args } { - - variable FormatProc - variable TZData - - lassign [ParseFormatArgs {*}$args] format locale timezone - set locale [string tolower $locale] - set clockval [lindex $args 0] - - # Build a procedure to format the result. Cache the built procedure's name - # in the 'FormatProc' array to avoid losing its internal representation, - # which contains the name resolution. - - set procName formatproc'$format'$locale - set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName] - if {[info exists FormatProc($procName)]} { - set procName $FormatProc($procName) - } else { - set FormatProc($procName) \ - [ParseClockFormatFormat $procName $format $locale] - } - - return [$procName $clockval $timezone] - -} - -#---------------------------------------------------------------------- -# -# ParseClockFormatFormat -- -# -# Builds and caches a procedure that formats a time value. -# -# Parameters: -# format -- Format string to use -# locale -- Locale in which the format string is to be interpreted -# -# Results: -# Returns the name of the newly-built procedure. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::ParseClockFormatFormat {procName format locale} { - - if {[namespace which $procName] ne {}} { - return $procName - } - - # Map away the locale-dependent composite format groups - - set locale [EnterLocale $locale] - - # Change locale if a fresh locale has been given on the command line. - - try { - return [ParseClockFormatFormat2 $format $locale $procName] - } trap CLOCK {result opts} { - dict unset opts -errorinfo - return -options $opts $result - } -} - -proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { - set didLocaleEra 0 - set didLocaleNumerals 0 - set preFormatCode \ - [string map [list @GREGORIAN_CHANGE_DATE@ \ - [mc GREGORIAN_CHANGE_DATE]] \ - { - variable TZData - set date [GetDateFields $clockval \ - $timezone \ - @GREGORIAN_CHANGE_DATE@] - }] - set formatString {} - set substituents {} - set state {} - - set format [LocalizeFormat $locale $format] - - foreach char [split $format {}] { - switch -exact -- $state { - {} { - if { [string equal % $char] } { - set state percent - } else { - append formatString $char - } - } - percent { # Character following a '%' character - set state {} - switch -exact -- $char { - % { # A literal character, '%' - append formatString %% - } - a { # Day of week, abbreviated - append formatString %s - append substituents \ - [string map \ - [list @DAYS_OF_WEEK_ABBREV@ \ - [list [mc DAYS_OF_WEEK_ABBREV]]] \ - { [lindex @DAYS_OF_WEEK_ABBREV@ \ - [expr {[dict get $date dayOfWeek] \ - % 7}]]}] - } - A { # Day of week, spelt out. - append formatString %s - append substituents \ - [string map \ - [list @DAYS_OF_WEEK_FULL@ \ - [list [mc DAYS_OF_WEEK_FULL]]] \ - { [lindex @DAYS_OF_WEEK_FULL@ \ - [expr {[dict get $date dayOfWeek] \ - % 7}]]}] - } - b - h { # Name of month, abbreviated. - append formatString %s - append substituents \ - [string map \ - [list @MONTHS_ABBREV@ \ - [list [mc MONTHS_ABBREV]]] \ - { [lindex @MONTHS_ABBREV@ \ - [expr {[dict get $date month]-1}]]}] - } - B { # Name of month, spelt out - append formatString %s - append substituents \ - [string map \ - [list @MONTHS_FULL@ \ - [list [mc MONTHS_FULL]]] \ - { [lindex @MONTHS_FULL@ \ - [expr {[dict get $date month]-1}]]}] - } - C { # Century number - append formatString %02d - append substituents \ - { [expr {[dict get $date year] / 100}]} - } - d { # Day of month, with leading zero - append formatString %02d - append substituents { [dict get $date dayOfMonth]} - } - e { # Day of month, without leading zero - append formatString %2d - append substituents { [dict get $date dayOfMonth]} - } - E { # Format group in a locale-dependent - # alternative era - set state percentE - if {!$didLocaleEra} { - append preFormatCode \ - [string map \ - [list @LOCALE_ERAS@ \ - [list [mc LOCALE_ERAS]]] \ - { - set date [GetLocaleEra \ - $date[set date {}] \ - @LOCALE_ERAS@]}] \n - set didLocaleEra 1 - } - if {!$didLocaleNumerals} { - append preFormatCode \ - [list set localeNumerals \ - [mc LOCALE_NUMERALS]] \n - set didLocaleNumerals 1 - } - } - g { # Two-digit year relative to ISO8601 - # week number - append formatString %02d - append substituents \ - { [expr { [dict get $date iso8601Year] % 100 }]} - } - G { # Four-digit year relative to ISO8601 - # week number - append formatString %02d - append substituents { [dict get $date iso8601Year]} - } - H { # Hour in the 24-hour day, leading zero - append formatString %02d - append substituents \ - { [expr { [dict get $date localSeconds] \ - / 3600 % 24}]} - } - I { # Hour AM/PM, with leading zero - append formatString %02d - append substituents \ - { [expr { ( ( ( [dict get $date localSeconds] \ - % 86400 ) \ - + 86400 \ - - 3600 ) \ - / 3600 ) \ - % 12 + 1 }] } - } - j { # Day of year (001-366) - append formatString %03d - append substituents { [dict get $date dayOfYear]} - } - J { # Julian Day Number - append formatString %07ld - append substituents { [dict get $date julianDay]} - } - k { # Hour (0-23), no leading zero - append formatString %2d - append substituents \ - { [expr { [dict get $date localSeconds] - / 3600 - % 24 }]} - } - l { # Hour (12-11), no leading zero - append formatString %2d - append substituents \ - { [expr { ( ( ( [dict get $date localSeconds] - % 86400 ) - + 86400 - - 3600 ) - / 3600 ) - % 12 + 1 }]} - } - m { # Month number, leading zero - append formatString %02d - append substituents { [dict get $date month]} - } - M { # Minute of the hour, leading zero - append formatString %02d - append substituents \ - { [expr { [dict get $date localSeconds] - / 60 - % 60 }]} - } - n { # A literal newline - append formatString \n - } - N { # Month number, no leading zero - append formatString %2d - append substituents { [dict get $date month]} - } - O { # A format group in the locale's - # alternative numerals - set state percentO - if {!$didLocaleNumerals} { - append preFormatCode \ - [list set localeNumerals \ - [mc LOCALE_NUMERALS]] \n - set didLocaleNumerals 1 - } - } - p { # Localized 'AM' or 'PM' indicator - # converted to uppercase - append formatString %s - append preFormatCode \ - [list set AM [string toupper [mc AM]]] \n \ - [list set PM [string toupper [mc PM]]] \n - append substituents \ - { [expr {(([dict get $date localSeconds] - % 86400) < 43200) ? - $AM : $PM}]} - } - P { # Localized 'AM' or 'PM' indicator - append formatString %s - append preFormatCode \ - [list set am [mc AM]] \n \ - [list set pm [mc PM]] \n - append substituents \ - { [expr {(([dict get $date localSeconds] - % 86400) < 43200) ? - $am : $pm}]} - - } - Q { # Hi, Jeff! - append formatString %s - append substituents { [FormatStarDate $date]} - } - s { # Seconds from the Posix Epoch - append formatString %s - append substituents { [dict get $date seconds]} - } - S { # Second of the minute, with - # leading zero - append formatString %02d - append substituents \ - { [expr { [dict get $date localSeconds] - % 60 }]} - } - t { # A literal tab character - append formatString \t - } - u { # Day of the week (1-Monday, 7-Sunday) - append formatString %1d - append substituents { [dict get $date dayOfWeek]} - } - U { # Week of the year (00-53). The - # first Sunday of the year is the - # first day of week 01 - append formatString %02d - append preFormatCode { - set dow [dict get $date dayOfWeek] - if { $dow == 7 } { - set dow 0 - } - incr dow - set UweekNumber \ - [expr { ( [dict get $date dayOfYear] - - $dow + 7 ) - / 7 }] - } - append substituents { $UweekNumber} - } - V { # The ISO8601 week number - append formatString %02d - append substituents { [dict get $date iso8601Week]} - } - w { # Day of the week (0-Sunday, - # 6-Saturday) - append formatString %1d - append substituents \ - { [expr { [dict get $date dayOfWeek] % 7 }]} - } - W { # Week of the year (00-53). The first - # Monday of the year is the first day - # of week 01. - append preFormatCode { - set WweekNumber \ - [expr { ( [dict get $date dayOfYear] - - [dict get $date dayOfWeek] - + 7 ) - / 7 }] - } - append formatString %02d - append substituents { $WweekNumber} - } - y { # The two-digit year of the century - append formatString %02d - append substituents \ - { [expr { [dict get $date year] % 100 }]} - } - Y { # The four-digit year - append formatString %04d - append substituents { [dict get $date year]} - } - z { # The time zone as hours and minutes - # east (+) or west (-) of Greenwich - append formatString %s - append substituents { [FormatNumericTimeZone \ - [dict get $date tzOffset]]} - } - Z { # The name of the time zone - append formatString %s - append substituents { [dict get $date tzName]} - } - % { # A literal percent character - append formatString %% - } - default { # An unknown escape sequence - append formatString %% $char - } - } - } - percentE { # Character following %E - set state {} - switch -exact -- $char { - E { - append formatString %s - append substituents { } \ - [string map \ - [list @BCE@ [list [mc BCE]] \ - @CE@ [list [mc CE]]] \ - {[dict get {BCE @BCE@ CE @CE@} \ - [dict get $date era]]}] - } - C { # Locale-dependent era - append formatString %s - append substituents { [dict get $date localeEra]} - } - y { # Locale-dependent year of the era - append preFormatCode { - set y [dict get $date localeYear] - if { $y >= 0 && $y < 100 } { - set Eyear [lindex $localeNumerals $y] - } else { - set Eyear $y - } - } - append formatString %s - append substituents { $Eyear} - } - default { # Unknown %E format group - append formatString %%E $char - } - } - } - percentO { # Character following %O - set state {} - switch -exact -- $char { - d - e { # Day of the month in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [dict get $date dayOfMonth]]} - } - H - k { # Hour of the day in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - / 3600 - % 24 }]]} - } - I - l { # Hour (12-11) AM/PM in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { ( ( ( [dict get $date localSeconds] - % 86400 ) - + 86400 - - 3600 ) - / 3600 ) - % 12 + 1 }]]} - } - m { # Month number in alternative numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals [dict get $date month]]} - } - M { # Minute of the hour in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - / 60 - % 60 }]]} - } - S { # Second of the minute in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { [dict get $date localSeconds] - % 60 }]]} - } - u { # Day of the week (Monday=1,Sunday=7) - # in alternative numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [dict get $date dayOfWeek]]} - } - w { # Day of the week (Sunday=0,Saturday=6) - # in alternative numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { [dict get $date dayOfWeek] % 7 }]]} - } - y { # Year of the century in alternative - # numerals - append formatString %s - append substituents \ - { [lindex $localeNumerals \ - [expr { [dict get $date year] % 100 }]]} - } - default { # Unknown format group - append formatString %%O $char - } - } - } - } - } - - # Clean up any improperly terminated groups - - switch -exact -- $state { - percent { - append formatString %% - } - percentE { - append retval %%E - } - percentO { - append retval %%O - } - } - - proc $procName {clockval timezone} " - $preFormatCode - return \[::format [list $formatString] $substituents\] - " - - # puts [list $procName [info args $procName] [info body $procName]] - - return $procName -} - -#---------------------------------------------------------------------- -# -# clock scan -- -# -# Inputs a count of seconds since the Posix Epoch as a time of day. -# -# The 'clock format' command scans times of day on input. Refer to the user -# documentation to see what it does. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::__org_scan { args } { - - set format {} - - # Check the count of args - - if { [llength $args] < 1 || [llength $args] % 2 != 1 } { - set cmdName "clock scan" - return -code error \ - -errorcode [list CLOCK wrongNumArgs] \ - "wrong \# args: should be\ - \"$cmdName string\ - ?-base seconds?\ - ?-format string? ?-gmt boolean?\ - ?-locale LOCALE? ?-timezone ZONE?\"" - } - - # Set defaults - - set base [clock seconds] - set string [lindex $args 0] - set format {} - set gmt 0 - set locale c - if {[set timezone [configure -system-tz]] eq ""} { - set timezone [GetSystemTimeZone] - } - - # Pick up command line options. - - foreach { flag value } [lreplace $args 0 0] { - set saw($flag) {} - switch -exact -- $flag { - -b - -ba - -bas - -base { - set base $value - } - -f - -fo - -for - -form - -forma - -format { - set format $value - } - -g - -gm - -gmt { - set gmt $value - } - -l - -lo - -loc - -loca - -local - -locale { - set locale [string tolower $value] - } - -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone { - set timezone $value - } - default { - return -code error \ - -errorcode [list CLOCK badOption $flag] \ - "bad option \"$flag\",\ - must be -base, -format, -gmt, -locale or -timezone" - } - } - } - - # Check options for validity - - if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { - return -code error \ - -errorcode [list CLOCK gmtWithTimezone] \ - "cannot use -gmt and -timezone in same call" - } - if { [catch { expr { wide($base) } } result] } { - return -code error "expected integer but got \"$base\"" - } - if { ![string is boolean -strict $gmt] } { - return -code error "expected boolean value but got \"$gmt\"" - } elseif { $gmt } { - set timezone :GMT - } - - # Change locale if a fresh locale has been given on the command line. - - EnterLocale $locale - - try { - # Map away the locale-dependent composite format groups - - set scanner [ParseClockScanFormat $format $locale] - return [$scanner $string $base $timezone] - } trap CLOCK {result opts} { - # Conceal location of generation of expected errors - dict unset opts -errorinfo - return -options $opts $result - } -} - -#---------------------------------------------------------------------- -# -# ParseClockScanFormat -- +# GetSystemLocale -- # -# Parses a format string given to [clock scan -format] +# Determines the system locale, which corresponds to "system" +# keyword for locale parameter of 'clock' command. # # Parameters: -# formatString - The format being parsed -# locale - The current locale +# None. # # Results: -# Constructs and returns a procedure that accepts the string being -# scanned, the base time, and the time zone. The procedure will either -# return the scanned time or else throw an error that should be rethrown -# to the caller of [clock scan] +# Returns the system locale. # # Side effects: -# The given procedure is defined in the ::tcl::clock namespace. Scan -# procedures are not deleted once installed. -# -# Why do we parse dates by defining a procedure to parse them? The reason is -# that by doing so, we have one convenient place to cache all the information: -# the regular expressions that match the patterns (which will be compiled), -# the code that assembles the date information, everything lands in one place. -# In this way, when a given format is reused at run time, all the information -# of how to apply it is available in a single place. +# None # #---------------------------------------------------------------------- -proc ::tcl::clock::ParseClockScanFormat {formatString locale} { - # Check whether the format has been parsed previously, and return the - # existing recognizer if it has. - - set procName scanproc'$formatString'$locale - set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName] - if { [namespace which $procName] != {} } { - return $procName - } - - variable DateParseActions - variable TimeParseActions - - # Localize the %x, %X, etc. groups - - set formatString [LocalizeFormat $locale $formatString] - - # Condense whitespace - - regsub -all {[[:space:]]+} $formatString { } formatString - - # Walk through the groups of the format string. In this loop, we - # accumulate: - # - a regular expression that matches the string, - # - the count of capturing brackets in the regexp - # - a set of code that post-processes the fields captured by the regexp, - # - a dictionary whose keys are the names of fields that are present - # in the format string. - - set re {^[[:space:]]*} - set captureCount 0 - set postcode {} - set fieldSet [dict create] - set fieldCount 0 - set postSep {} - set state {} - - foreach c [split $formatString {}] { - switch -exact -- $state { - {} { - if { $c eq "%" } { - set state % - } elseif { $c eq " " } { - append re {[[:space:]]+} - } else { - if { ! [string is alnum $c] } { - append re "\\" - } - append re $c - } - } - % { - set state {} - switch -exact -- $c { - % { - append re % - } - { } { - append re "\[\[:space:\]\]*" - } - a - A { # Day of week, in words - set l {} - foreach \ - i {7 1 2 3 4 5 6} \ - abr [mc DAYS_OF_WEEK_ABBREV] \ - full [mc DAYS_OF_WEEK_FULL] { - dict set l [string tolower $abr] $i - dict set l [string tolower $full] $i - incr i - } - lassign [UniquePrefixRegexp $l] regex lookup - append re ( $regex ) - dict set fieldSet dayOfWeek [incr fieldCount] - append postcode "dict set date dayOfWeek \[" \ - "dict get " [list $lookup] " " \ - \[ {string tolower $field} [incr captureCount] \] \ - "\]\n" - } - b - B - h { # Name of month - set i 0 - set l {} - foreach \ - abr [mc MONTHS_ABBREV] \ - full [mc MONTHS_FULL] { - incr i - dict set l [string tolower $abr] $i - dict set l [string tolower $full] $i - } - lassign [UniquePrefixRegexp $l] regex lookup - append re ( $regex ) - dict set fieldSet month [incr fieldCount] - append postcode "dict set date month \[" \ - "dict get " [list $lookup] \ - " " \[ {string tolower $field} \ - [incr captureCount] \] \ - "\]\n" - } - C { # Gregorian century - append re \\s*(\\d\\d?) - dict set fieldSet century [incr fieldCount] - append postcode "dict set date century \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - d - e { # Day of month - append re \\s*(\\d\\d?) - dict set fieldSet dayOfMonth [incr fieldCount] - append postcode "dict set date dayOfMonth \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - E { # Prefix for locale-specific codes - set state %E - } - g { # ISO8601 2-digit year - append re \\s*(\\d\\d) - dict set fieldSet iso8601YearOfCentury \ - [incr fieldCount] - append postcode \ - "dict set date iso8601YearOfCentury \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - G { # ISO8601 4-digit year - append re \\s*(\\d\\d)(\\d\\d) - dict set fieldSet iso8601Century [incr fieldCount] - dict set fieldSet iso8601YearOfCentury \ - [incr fieldCount] - append postcode \ - "dict set date iso8601Century \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" \ - "dict set date iso8601YearOfCentury \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - H - k { # Hour of day - append re \\s*(\\d\\d?) - dict set fieldSet hour [incr fieldCount] - append postcode "dict set date hour \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - I - l { # Hour, AM/PM - append re \\s*(\\d\\d?) - dict set fieldSet hourAMPM [incr fieldCount] - append postcode "dict set date hourAMPM \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - j { # Day of year - append re \\s*(\\d\\d?\\d?) - dict set fieldSet dayOfYear [incr fieldCount] - append postcode "dict set date dayOfYear \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - J { # Julian Day Number - append re \\s*(\\d+) - dict set fieldSet julianDay [incr fieldCount] - append postcode "dict set date julianDay \[" \ - "::scan \$field" [incr captureCount] " %ld" \ - "\]\n" - } - m - N { # Month number - append re \\s*(\\d\\d?) - dict set fieldSet month [incr fieldCount] - append postcode "dict set date month \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - M { # Minute - append re \\s*(\\d\\d?) - dict set fieldSet minute [incr fieldCount] - append postcode "dict set date minute \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - n { # Literal newline - append re \\n - } - O { # Prefix for locale numerics - set state %O - } - p - P { # AM/PM indicator - set l [list [string tolower [mc AM]] 0 \ - [string tolower [mc PM]] 1] - lassign [UniquePrefixRegexp $l] regex lookup - append re ( $regex ) - dict set fieldSet amPmIndicator [incr fieldCount] - append postcode "dict set date amPmIndicator \[" \ - "dict get " [list $lookup] " \[string tolower " \ - "\$field" \ - [incr captureCount] \ - "\]\]\n" - } - Q { # Hi, Jeff! - append re {Stardate\s+([-+]?\d+)(\d\d\d)[.](\d)} - incr captureCount - dict set fieldSet seconds [incr fieldCount] - append postcode {dict set date seconds } \[ \ - {ParseStarDate $field} [incr captureCount] \ - { $field} [incr captureCount] \ - { $field} [incr captureCount] \ - \] \n - } - s { # Seconds from Posix Epoch - # This next case is insanely difficult, because it's - # problematic to determine whether the field is - # actually within the range of a wide integer. - append re {\s*([-+]?\d+)} - dict set fieldSet seconds [incr fieldCount] - append postcode {dict set date seconds } \[ \ - {ScanWide $field} [incr captureCount] \] \n - } - S { # Second - append re \\s*(\\d\\d?) - dict set fieldSet second [incr fieldCount] - append postcode "dict set date second \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - t { # Literal tab character - append re \\t - } - u - w { # Day number within week, 0 or 7 == Sun - # 1=Mon, 6=Sat - append re \\s*(\\d) - dict set fieldSet dayOfWeek [incr fieldCount] - append postcode {::scan $field} [incr captureCount] \ - { %d dow} \n \ - { - if { $dow == 0 } { - set dow 7 - } elseif { $dow > 7 } { - return -code error \ - -errorcode [list CLOCK badDayOfWeek] \ - "day of week is greater than 7" - } - dict set date dayOfWeek $dow - } - } - U { # Week of year. The first Sunday of - # the year is the first day of week - # 01. No scan rule uses this group. - append re \\s*\\d\\d? - } - V { # Week of ISO8601 year - - append re \\s*(\\d\\d?) - dict set fieldSet iso8601Week [incr fieldCount] - append postcode "dict set date iso8601Week \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - W { # Week of the year (00-53). The first - # Monday of the year is the first day - # of week 01. No scan rule uses this - # group. - append re \\s*\\d\\d? - } - y { # Two-digit Gregorian year - append re \\s*(\\d\\d?) - dict set fieldSet yearOfCentury [incr fieldCount] - append postcode "dict set date yearOfCentury \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - Y { # 4-digit Gregorian year - append re \\s*(\\d\\d)(\\d\\d) - dict set fieldSet century [incr fieldCount] - dict set fieldSet yearOfCentury [incr fieldCount] - append postcode \ - "dict set date century \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" \ - "dict set date yearOfCentury \[" \ - "::scan \$field" [incr captureCount] " %d" \ - "\]\n" - } - z - Z { # Time zone name - append re {(?:([-+]\d\d(?::?\d\d(?::?\d\d)?)?)|([[:alnum:]]{1,4}))} - dict set fieldSet tzName [incr fieldCount] - append postcode \ - {if } \{ { $field} [incr captureCount] \ - { ne "" } \} { } \{ \n \ - {dict set date tzName $field} \ - $captureCount \n \ - \} { else } \{ \n \ - {dict set date tzName } \[ \ - {ConvertLegacyTimeZone $field} \ - [incr captureCount] \] \n \ - \} \n \ - } - % { # Literal percent character - append re % - } - default { - append re % - if { ! [string is alnum $c] } { - append re \\ - } - append re $c - } - } - } - %E { - switch -exact -- $c { - C { # Locale-dependent era - set d {} - foreach triple [mc LOCALE_ERAS] { - lassign $triple t symbol year - dict set d [string tolower $symbol] $year - } - lassign [UniquePrefixRegexp $d] regex lookup - append re (?: $regex ) - } - E { - set l {} - dict set l [string tolower [mc BCE]] BCE - dict set l [string tolower [mc CE]] CE - dict set l b.c.e. BCE - dict set l c.e. CE - dict set l b.c. BCE - dict set l a.d. CE - lassign [UniquePrefixRegexp $l] regex lookup - append re ( $regex ) - dict set fieldSet era [incr fieldCount] - append postcode "dict set date era \["\ - "dict get " [list $lookup] \ - { } \[ {string tolower $field} \ - [incr captureCount] \] \ - "\]\n" - } - y { # Locale-dependent year of the era - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - incr captureCount - } - default { - append re %E - if { ! [string is alnum $c] } { - append re \\ - } - append re $c - } - } - set state {} - } - %O { - switch -exact -- $c { - d - e { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet dayOfMonth [incr fieldCount] - append postcode "dict set date dayOfMonth \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - H - k { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet hour [incr fieldCount] - append postcode "dict set date hour \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - I - l { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet hourAMPM [incr fieldCount] - append postcode "dict set date hourAMPM \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - m { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet month [incr fieldCount] - append postcode "dict set date month \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - M { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet minute [incr fieldCount] - append postcode "dict set date minute \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - S { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet second [incr fieldCount] - append postcode "dict set date second \[" \ - "dict get " [list $lookup] " \$field" \ - [incr captureCount] \ - "\]\n" - } - u - w { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet dayOfWeek [incr fieldCount] - append postcode "set dow \[dict get " [list $lookup] \ - { $field} [incr captureCount] \] \n \ - { - if { $dow == 0 } { - set dow 7 - } elseif { $dow > 7 } { - return -code error \ - -errorcode [list CLOCK badDayOfWeek] \ - "day of week is greater than 7" - } - dict set date dayOfWeek $dow - } - } - y { - lassign [LocaleNumeralMatcher $locale] regex lookup - append re $regex - dict set fieldSet yearOfCentury [incr fieldCount] - append postcode {dict set date yearOfCentury } \[ \ - {dict get } [list $lookup] { $field} \ - [incr captureCount] \] \n - } - default { - append re %O - if { ! [string is alnum $c] } { - append re \\ - } - append re $c - } - } - set state {} - } - } - } - - # Clean up any unfinished format groups - - append re $state \\s*\$ - - # Build the procedure - - set procBody {} - append procBody "variable ::tcl::clock::TZData" \n - append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->" - for { set i 1 } { $i <= $captureCount } { incr i } { - append procBody " " field $i - } - append procBody "\] \} \{" \n - append procBody { - return -code error -errorcode [list CLOCK badInputString] \ - {input string does not match supplied format} - } - append procBody \}\n - append procBody "set date \[dict create\]" \n - append procBody {dict set date tzName $timeZone} \n - append procBody $postcode - append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n - - # Set up the time zone before doing anything with a default base date - # that might need a timezone to interpret it. - - if { ![dict exists $fieldSet seconds] - && ![dict exists $fieldSet starDate] } { - if { [dict exists $fieldSet tzName] } { - append procBody { - set timeZone [dict get $date tzName] - } - } - append procBody { - set timeZone [::tcl::clock::SetupTimeZone $timeZone] - } - } - - # Add code that gets Julian Day Number from the fields. - - append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions] - - # Get time of day - - append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions] - - # Assemble seconds from the Julian day and second of the day. - # Convert to local time unless epoch seconds or stardate are - # being processed - they're always absolute - - if { ![dict exists $fieldSet seconds] - && ![dict exists $fieldSet starDate] } { - append procBody { - if { [dict get $date julianDay] > 5373484 } { - return -code error -errorcode [list CLOCK dateTooLarge] \ - "requested date too large to represent" - } - dict set date localSeconds [expr { - -210866803200 - + ( 86400 * wide([dict get $date julianDay]) ) - + [dict get $date secondOfDay] - }] - } - - # Finally, convert the date to local time +proc ::tcl::clock::GetSystemLocale {} { + if { $::tcl_platform(platform) ne {windows} } { + # On a non-windows platform, the 'system' locale is the same as + # the 'current' locale - append procBody { - set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \ - $timeZone $changeover] - } + return [mclocale] } - # Return result - - append procBody {return [dict get $date seconds]} \n - - proc $procName { string baseTime timeZone } $procBody - - # puts [list proc $procName [list string baseTime timeZone] $procBody] - - return $procName -} + # On a windows platform, the 'system' locale is adapted from the + # 'current' locale by applying the date and time formats from the + # Control Panel. First, load the 'current' locale if it's not yet + # loaded -#---------------------------------------------------------------------- -# -# LocaleNumeralMatcher -- -# -# Composes a regexp that captures the numerals in the given locale, and -# a dictionary to map them to conventional numerals. -# -# Parameters: -# locale - Name of the current locale -# -# Results: -# Returns a two-element list comprising the regexp and the dictionary. -# -# Side effects: -# Caches the result. -# -#---------------------------------------------------------------------- + mcpackagelocale set [mclocale] -proc ::tcl::clock::LocaleNumeralMatcher {l} { - variable LocaleNumeralCache + # Make a new locale string for the system locale, and get the + # Control Panel information - if { ![dict exists $LocaleNumeralCache $l] } { - set d {} - set i 0 - set sep \( - foreach n [mc LOCALE_NUMERALS] { - dict set d $n $i - regsub -all {[^[:alnum:]]} $n \\\\& subex - append re $sep $subex - set sep | - incr i - } - append re \) - dict set LocaleNumeralCache $l [list $re $d] + set locale [mclocale]_windows + if { ! [mcpackagelocale present $locale] } { + LoadWindowsDateTimeFormats $locale } - return [dict get $LocaleNumeralCache $l] -} - - - -#---------------------------------------------------------------------- -# -# UniquePrefixRegexp -- -# -# Composes a regexp that performs unique-prefix matching. The RE -# matches one of a supplied set of strings, or any unique prefix -# thereof. -# -# Parameters: -# data - List of alternating match-strings and values. -# Match-strings with distinct values are considered -# distinct. -# -# Results: -# Returns a two-element list. The first is a regexp that matches any -# unique prefix of any of the strings. The second is a dictionary whose -# keys are match values from the regexp and whose values are the -# corresponding values from 'data'. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::UniquePrefixRegexp { data } { - # The 'successors' dictionary will contain, for each string that is a - # prefix of any key, all characters that may follow that prefix. The - # 'prefixMapping' dictionary will have keys that are prefixes of keys and - # values that correspond to the keys. - - set prefixMapping [dict create] - set successors [dict create {} {}] - - # Walk the key-value pairs - - foreach { key value } $data { - # Construct all prefixes of the key; - - set prefix {} - foreach char [split $key {}] { - set oldPrefix $prefix - dict set successors $oldPrefix $char {} - append prefix $char - - # Put the prefixes in the 'prefixMapping' and 'successors' - # dictionaries - - dict lappend prefixMapping $prefix $value - if { ![dict exists $successors $prefix] } { - dict set successors $prefix {} - } - } - } - - # Identify those prefixes that designate unique values, and those that are - # the full keys - - set uniquePrefixMapping {} - dict for { key valueList } $prefixMapping { - if { [llength $valueList] == 1 } { - dict set uniquePrefixMapping $key [lindex $valueList 0] - } - } - foreach { key value } $data { - dict set uniquePrefixMapping $key $value - } - - # Construct the re. - - return [list \ - [MakeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \ - $uniquePrefixMapping] -} - -#---------------------------------------------------------------------- -# -# MakeUniquePrefixRegexp -- -# -# Service procedure for 'UniquePrefixRegexp' that constructs a regular -# expresison that matches the unique prefixes. -# -# Parameters: -# successors - Dictionary whose keys are all prefixes -# of keys passed to 'UniquePrefixRegexp' and whose -# values are dictionaries whose keys are the characters -# that may follow those prefixes. -# uniquePrefixMapping - Dictionary whose keys are the unique -# prefixes and whose values are not examined. -# prefixString - Current prefix being processed. -# -# Results: -# Returns a constructed regular expression that matches the set of -# unique prefixes beginning with the 'prefixString'. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::MakeUniquePrefixRegexp { successors - uniquePrefixMapping - prefixString } { - - # Get the characters that may follow the current prefix string - - set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]] - if { [llength $schars] == 0 } { - return {} - } - - # If there is more than one successor character, or if the current prefix - # is a unique prefix, surround the generated re with non-capturing - # parentheses. - - set re {} - if { - [dict exists $uniquePrefixMapping $prefixString] - || [llength $schars] > 1 - } then { - append re "(?:" - } - - # Generate a regexp that matches the successors. - - set sep "" - foreach { c } $schars { - set nextPrefix $prefixString$c - regsub -all {[^[:alnum:]]} $c \\\\& rechar - append re $sep $rechar \ - [MakeUniquePrefixRegexp \ - $successors $uniquePrefixMapping $nextPrefix] - set sep | - } - - # If the current prefix is a unique prefix, make all following text - # optional. Otherwise, if there is more than one successor character, - # close the non-capturing parentheses. - - if { [dict exists $uniquePrefixMapping $prefixString] } { - append re ")?" - } elseif { [llength $schars] > 1 } { - append re ")" - } - - return $re -} - -#---------------------------------------------------------------------- -# -# MakeParseCodeFromFields -- -# -# Composes Tcl code to extract the Julian Day Number from a dictionary -# containing date fields. -# -# Parameters: -# dateFields -- Dictionary whose keys are fields of the date, -# and whose values are the rightmost positions -# at which those fields appear. -# parseActions -- List of triples: field set, priority, and -# code to emit. Smaller priorities are better, and -# the list must be in ascending order by priority -# -# Results: -# Returns a burst of code that extracts the day number from the given -# date. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } { - - set currPrio 999 - set currFieldPos [list] - set currCodeBurst { - error "in ::tcl::clock::MakeParseCodeFromFields: can't happen" - } - - foreach { fieldSet prio parseAction } $parseActions { - # If we've found an answer that's better than any that follow, quit - # now. - - if { $prio > $currPrio } { - break - } - - # Accumulate the field positions that are used in the current field - # grouping. - - set fieldPos [list] - set ok true - foreach field $fieldSet { - if { ! [dict exists $dateFields $field] } { - set ok 0 - break - } - lappend fieldPos [dict get $dateFields $field] - } - - # Quit if we don't have a complete set of fields - if { !$ok } { - continue - } - - # Determine whether the current answer is better than the last. - - set fPos [lsort -integer -decreasing $fieldPos] - - if { $prio == $currPrio } { - foreach currPos $currFieldPos newPos $fPos { - if { - ![string is integer $newPos] - || ![string is integer $currPos] - || $newPos > $currPos - } then { - break - } - if { $newPos < $currPos } { - set ok 0 - break - } - } - } - if { !$ok } { - continue - } - - # Remember the best possibility for extracting date information - - set currPrio $prio - set currFieldPos $fPos - set currCodeBurst $parseAction - } - - return $currCodeBurst -} - -#---------------------------------------------------------------------- -# -# GetSystemTimeZone -- -# -# Determines the system time zone, which is the default for the -# 'clock' command if no other zone is supplied. -# -# Parameters: -# None. -# -# Results: -# Returns the system time zone. -# -# Side effects: -# Stores the sustem time zone in engine configuration, since -# determining it may be an expensive process. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::GetSystemLocale {} { - if { $::tcl_platform(platform) ne {windows} } { - # On a non-windows platform, the 'system' locale is the same as - # the 'current' locale - - return [mclocale] - } - - # On a windows platform, the 'system' locale is adapted from the - # 'current' locale by applying the date and time formats from the - # Control Panel. First, load the 'current' locale if it's not yet - # loaded - - mcpackagelocale set [mclocale] - - # Make a new locale string for the system locale, and get the - # Control Panel information - - set locale [mclocale]_windows - if { ! [mcpackagelocale present $locale] } { - LoadWindowsDateTimeFormats $locale - } - - return $locale -} - -#---------------------------------------------------------------------- -# -# EnterLocale -- -# -# Switch [mclocale] to a given locale if necessary -# -# Parameters: -# locale -- Desired locale -# -# Results: -# Returns the locale that was previously current. -# -# Side effects: -# Does [mclocale]. If necessary, loades the designated locale's files. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::EnterLocale { locale } { - switch -- $locale system { - set locale [GetSystemLocale] - } current { - set locale [mclocale] - } - # Select the locale, eventually load it - mcpackagelocale set $locale - return $locale -} - -#---------------------------------------------------------------------- -# -# LoadWindowsDateTimeFormats -- -# -# Load the date/time formats from the Control Panel in Windows and -# convert them so that they're usable by Tcl. -# -# Parameters: -# locale - Name of the locale in whose message catalog -# the converted formats are to be stored. -# -# Results: -# None. -# -# Side effects: -# Updates the given message catalog with the locale strings. -# -# Presumes that on entry, [mclocale] is set to the current locale, so that -# default strings can be obtained if the Registry query fails. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { - # Bail out if we can't find the Registry - - variable NoRegistry - if { [info exists NoRegistry] } return - - if { ![catch { - registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ - sShortDate - } string] } { - set quote {} - set datefmt {} - foreach { unquoted quoted } [split $string '] { - append datefmt $quote [string map { - dddd %A - ddd %a - dd %d - d %e - MMMM %B - MMM %b - MM %m - M %N - yyyy %Y - yy %y - y %y - gg {} - } $unquoted] - if { $quoted eq {} } { - set quote ' - } else { - set quote $quoted - } - } - ::msgcat::mcset $locale DATE_FORMAT $datefmt - } - - if { ![catch { - registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ - sLongDate - } string] } { - set quote {} - set ldatefmt {} - foreach { unquoted quoted } [split $string '] { - append ldatefmt $quote [string map { - dddd %A - ddd %a - dd %d - d %e - MMMM %B - MMM %b - MM %m - M %N - yyyy %Y - yy %y - y %y - gg {} - } $unquoted] - if { $quoted eq {} } { - set quote ' - } else { - set quote $quoted - } - } - ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt - } - - if { ![catch { - registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ - sTimeFormat - } string] } { - set quote {} - set timefmt {} - foreach { unquoted quoted } [split $string '] { - append timefmt $quote [string map { - HH %H - H %k - hh %I - h %l - mm %M - m %M - ss %S - s %S - tt %p - t %p - } $unquoted] - if { $quoted eq {} } { - set quote ' - } else { - set quote $quoted - } - } - ::msgcat::mcset $locale TIME_FORMAT $timefmt - } - - catch { - ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt" - } - catch { - ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt" - } - - return - -} - -#---------------------------------------------------------------------- -# -# LocalizeFormat -- -# -# Map away locale-dependent format groups in a clock format. -# -# Parameters: -# locale -- Current [mclocale] locale, supplied to avoid -# an extra call -# format -- Format supplied to [clock scan] or [clock format] -# -# Results: -# Returns the string with locale-dependent composite format groups -# substituted out. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { - variable LocaleFormats - - if { $fmtkey eq {} } { set fmtkey FMT_$format } - if { [catch { - set locfmt [dict get $LocaleFormats $locale $fmtkey] - }] } { - - # get map list cached or build it: - if { [catch { - set mlst [dict get $LocaleFormats $locale MLST] - }] } { - - # message catalog dictionary: - set mcd [mcget $locale] - - # Handle locale-dependent format groups by mapping them out of the format - # string. Note that the order of the [string map] operations is - # significant because later formats can refer to later ones; for example - # %c can refer to %X, which in turn can refer to %T. - - set mlst { - %% %% - %D %m/%d/%Y - %+ {%a %b %e %H:%M:%S %Z %Y} - } - lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]] - lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]] - lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]] - lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]] - lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]] - lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]] - lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]] - lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]] - lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]] - lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]] - - dict set LocaleFormats $locale MLST $mlst - } - - # translate copy of format (don't use format object here, because otherwise - # it can lose its internal representation (string map - convert to unicode) - set locfmt [string map $mlst [string range " $format" 1 end]] - - # cache it: - dict set LocaleFormats $locale $fmtkey $locfmt - } - - # Save original format as long as possible, because of internal - # representation (performance). - # Note that in this case such format will be never localized (also - # using another locales). To prevent this return a duplicate (but - # it may be slower). - if {$locfmt eq $format} { - set locfmt $format - } - - return $locfmt -} - -#---------------------------------------------------------------------- -# -# FormatNumericTimeZone -- -# -# Formats a time zone as +hhmmss -# -# Parameters: -# z - Time zone in seconds east of Greenwich -# -# Results: -# Returns the time zone formatted in a numeric form -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::FormatNumericTimeZone { z } { - if { $z < 0 } { - set z [expr { - $z }] - set retval - - } else { - set retval + - } - append retval [::format %02d [expr { $z / 3600 }]] - set z [expr { $z % 3600 }] - append retval [::format %02d [expr { $z / 60 }]] - set z [expr { $z % 60 }] - if { $z != 0 } { - append retval [::format %02d $z] - } - return $retval -} - -#---------------------------------------------------------------------- -# -# FormatStarDate -- -# -# Formats a date as a StarDate. -# -# Parameters: -# date - Dictionary containing 'year', 'dayOfYear', and -# 'localSeconds' fields. -# -# Results: -# Returns the given date formatted as a StarDate. -# -# Side effects: -# None. -# -# Jeff Hobbs put this in to support an atrocious pun about Tcl being -# "Enterprise ready." Now we're stuck with it. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::FormatStarDate { date } { - variable Roddenberry - - # Get day of year, zero based - - set doy [expr { [dict get $date dayOfYear] - 1 }] - - # Determine whether the year is a leap year - - set lp [IsGregorianLeapYear $date] - - # Convert day of year to a fractional year - - if { $lp } { - set fractYear [expr { 1000 * $doy / 366 }] - } else { - set fractYear [expr { 1000 * $doy / 365 }] - } - - # Put together the StarDate - - return [::format "Stardate %02d%03d.%1d" \ - [expr { [dict get $date year] - $Roddenberry }] \ - $fractYear \ - [expr { [dict get $date localSeconds] % 86400 - / ( 86400 / 10 ) }]] -} - -#---------------------------------------------------------------------- -# -# ParseStarDate -- -# -# Parses a StarDate -# -# Parameters: -# year - Year from the Roddenberry epoch -# fractYear - Fraction of a year specifiying the day of year. -# fractDay - Fraction of a day -# -# Results: -# Returns a count of seconds from the Posix epoch. -# -# Side effects: -# None. -# -# Jeff Hobbs put this in to support an atrocious pun about Tcl being -# "Enterprise ready." Now we're stuck with it. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::ParseStarDate { year fractYear fractDay } { - variable Roddenberry - - # Build a tentative date from year and fraction. - - set date [dict create \ - gregorian 1 \ - era CE \ - year [expr { $year + $Roddenberry }] \ - dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]] - set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] - - # Determine whether the given year is a leap year - - set lp [IsGregorianLeapYear $date] - - # Reconvert the fractional year according to whether the given year is a - # leap year - - if { $lp } { - dict set date dayOfYear \ - [expr { $fractYear * 366 / 1000 + 1 }] - } else { - dict set date dayOfYear \ - [expr { $fractYear * 365 / 1000 + 1 }] - } - dict unset date julianDay - dict unset date gregorian - set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]] - - return [expr { - 86400 * [dict get $date julianDay] - - 210866803200 - + ( 86400 / 10 ) * $fractDay - }] -} - -#---------------------------------------------------------------------- -# -# ScanWide -- -# -# Scans a wide integer from an input -# -# Parameters: -# str - String containing a decimal wide integer -# -# Results: -# Returns the string as a pure wide integer. Throws an error if the -# string is misformatted or out of range. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::ScanWide { str } { - set count [::scan $str {%ld %c} result junk] - if { $count != 1 } { - return -code error -errorcode [list CLOCK notAnInteger $str] \ - "\"$str\" is not an integer" - } - if { [incr result 0] != $str } { - return -code error -errorcode [list CLOCK integervalueTooLarge] \ - "integer value too large to represent" - } - return $result -} - -#---------------------------------------------------------------------- -# -# InterpretTwoDigitYear -- -# -# Given a date that contains only the year of the century, determines -# the target value of a two-digit year. -# -# Parameters: -# date - Dictionary containing fields of the date. -# baseTime - Base time relative to which the date is expressed. -# twoDigitField - Name of the field that stores the two-digit year. -# Default is 'yearOfCentury' -# fourDigitField - Name of the field that will receive the four-digit -# year. Default is 'year' -# -# Results: -# Returns the dictionary augmented with the four-digit year, stored in -# the given key. -# -# Side effects: -# None. -# -# The current rule for interpreting a two-digit year is that the year shall be -# between 1937 and 2037, thus staying within the range of a 32-bit signed -# value for time. This rule may change to a sliding window in future -# versions, so the 'baseTime' parameter (which is currently ignored) is -# provided in the procedure signature. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::InterpretTwoDigitYear { date baseTime - { twoDigitField yearOfCentury } - { fourDigitField year } } { - set yr [dict get $date $twoDigitField] - if { $yr >= [configure -century-switch] } { - incr yr -100 - } - incr yr [configure -year-century] - dict set date $fourDigitField $yr - return $date -} - -#---------------------------------------------------------------------- -# -# AssignBaseYear -- -# -# Places the number of the current year into a dictionary. -# -# Parameters: -# date - Dictionary value to update -# baseTime - Base time from which to extract the year, expressed -# in seconds from the Posix epoch -# timezone - the time zone in which the date is being scanned -# changeover - the Julian Day on which the Gregorian calendar -# was adopted in the target locale. -# -# Results: -# Returns the dictionary with the current year assigned. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } { - variable TZData - - # Find the Julian Day Number corresponding to the base time, and - # find the Gregorian year corresponding to that Julian Day. - - set date2 [GetDateFields $baseTime $timezone $changeover] - - # Store the converted year - - dict set date era [dict get $date2 era] - dict set date year [dict get $date2 year] - - return $date -} - -#---------------------------------------------------------------------- -# -# AssignBaseIso8601Year -- -# -# Determines the base year in the ISO8601 fiscal calendar. -# -# Parameters: -# date - Dictionary containing the fields of the date that -# is to be augmented with the base year. -# baseTime - Base time expressed in seconds from the Posix epoch. -# timeZone - Target time zone -# changeover - Julian Day of adoption of the Gregorian calendar in -# the target locale. -# -# Results: -# Returns the given date with "iso8601Year" set to the -# base year. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} { - variable TZData - - # Find the Julian Day Number corresponding to the base time - - set date2 [GetDateFields $baseTime $timeZone $changeover] - - # Calculate the ISO8601 date and transfer the year - - dict set date era CE - dict set date iso8601Year [dict get $date2 iso8601Year] - return $date -} - -#---------------------------------------------------------------------- -# -# AssignBaseMonth -- -# -# Places the number of the current year and month into a -# dictionary. -# -# Parameters: -# date - Dictionary value to update -# baseTime - Time from which the year and month are to be -# obtained, expressed in seconds from the Posix epoch. -# timezone - Name of the desired time zone -# changeover - Julian Day on which the Gregorian calendar was adopted. -# -# Results: -# Returns the dictionary with the base year and month assigned. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} { - variable TZData - - # Find the year and month corresponding to the base time - - set date2 [GetDateFields $baseTime $timezone $changeover] - dict set date era [dict get $date2 era] - dict set date year [dict get $date2 year] - dict set date month [dict get $date2 month] - return $date -} - -#---------------------------------------------------------------------- -# -# AssignBaseWeek -- -# -# Determines the base year and week in the ISO8601 fiscal calendar. -# -# Parameters: -# date - Dictionary containing the fields of the date that -# is to be augmented with the base year and week. -# baseTime - Base time expressed in seconds from the Posix epoch. -# changeover - Julian Day on which the Gregorian calendar was adopted -# in the target locale. -# -# Results: -# Returns the given date with "iso8601Year" set to the -# base year and "iso8601Week" to the week number. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} { - variable TZData - - # Find the Julian Day Number corresponding to the base time - - set date2 [GetDateFields $baseTime $timeZone $changeover] - - # Calculate the ISO8601 date and transfer the year - dict set date era CE - dict set date iso8601Year [dict get $date2 iso8601Year] - dict set date iso8601Week [dict get $date2 iso8601Week] - return $date + return $locale } #---------------------------------------------------------------------- # -# AssignBaseJulianDay -- +# EnterLocale -- # -# Determines the base day for a time-of-day conversion. +# Switch [mclocale] to a given locale if necessary # # Parameters: -# date - Dictionary that is to get the base day -# baseTime - Base time expressed in seconds from the Posix epoch -# changeover - Julian day on which the Gregorian calendar was -# adpoted in the target locale. +# locale -- Desired locale # # Results: -# Returns the given dictionary augmented with a 'julianDay' field -# that contains the base day. +# Returns the locale that was previously current. # # Side effects: -# None. +# Does [mclocale]. If necessary, loades the designated locale's files. # #---------------------------------------------------------------------- -proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } { - variable TZData - - # Find the Julian Day Number corresponding to the base time - - set date2 [GetDateFields $baseTime $timeZone $changeover] - dict set date julianDay [dict get $date2 julianDay] - - return $date +proc ::tcl::clock::EnterLocale { locale } { + switch -- $locale system { + set locale [GetSystemLocale] + } current { + set locale [mclocale] + } + # Select the locale, eventually load it + mcpackagelocale set $locale + return $locale } #---------------------------------------------------------------------- # -# InterpretHMSP -- +# LoadWindowsDateTimeFormats -- # -# Interprets a time in the form "hh:mm:ss am". +# Load the date/time formats from the Control Panel in Windows and +# convert them so that they're usable by Tcl. # # Parameters: -# date -- Dictionary containing "hourAMPM", "minute", "second" -# and "amPmIndicator" fields. +# locale - Name of the locale in whose message catalog +# the converted formats are to be stored. # # Results: -# Returns the number of seconds from local midnight. +# None. # # Side effects: -# None. +# Updates the given message catalog with the locale strings. +# +# Presumes that on entry, [mclocale] is set to the current locale, so that +# default strings can be obtained if the Registry query fails. # #---------------------------------------------------------------------- -proc ::tcl::clock::InterpretHMSP { date } { - set hr [dict get $date hourAMPM] - if { $hr == 12 } { - set hr 0 +proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { + # Bail out if we can't find the Registry + + variable NoRegistry + if { [info exists NoRegistry] } return + + if { ![catch { + registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ + sShortDate + } string] } { + set quote {} + set datefmt {} + foreach { unquoted quoted } [split $string '] { + append datefmt $quote [string map { + dddd %A + ddd %a + dd %d + d %e + MMMM %B + MMM %b + MM %m + M %N + yyyy %Y + yy %y + y %y + gg {} + } $unquoted] + if { $quoted eq {} } { + set quote ' + } else { + set quote $quoted + } + } + ::msgcat::mcset $locale DATE_FORMAT $datefmt + } + + if { ![catch { + registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ + sLongDate + } string] } { + set quote {} + set ldatefmt {} + foreach { unquoted quoted } [split $string '] { + append ldatefmt $quote [string map { + dddd %A + ddd %a + dd %d + d %e + MMMM %B + MMM %b + MM %m + M %N + yyyy %Y + yy %y + y %y + gg {} + } $unquoted] + if { $quoted eq {} } { + set quote ' + } else { + set quote $quoted + } + } + ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt + } + + if { ![catch { + registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ + sTimeFormat + } string] } { + set quote {} + set timefmt {} + foreach { unquoted quoted } [split $string '] { + append timefmt $quote [string map { + HH %H + H %k + hh %I + h %l + mm %M + m %M + ss %S + s %S + tt %p + t %p + } $unquoted] + if { $quoted eq {} } { + set quote ' + } else { + set quote $quoted + } + } + ::msgcat::mcset $locale TIME_FORMAT $timefmt + } + + catch { + ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt" } - if { [dict get $date amPmIndicator] } { - incr hr 12 + catch { + ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt" } - dict set date hour $hr - return [InterpretHMS $date[set date {}]] + + return + } #---------------------------------------------------------------------- # -# InterpretHMS -- +# LocalizeFormat -- # -# Interprets a 24-hour time "hh:mm:ss" +# Map away locale-dependent format groups in a clock format. # # Parameters: -# date -- Dictionary containing the "hour", "minute" and "second" -# fields. +# locale -- Current [mclocale] locale, supplied to avoid +# an extra call +# format -- Format supplied to [clock scan] or [clock format] # # Results: -# Returns the given dictionary augmented with a "secondOfDay" -# field containing the number of seconds from local midnight. +# Returns the string with locale-dependent composite format groups +# substituted out. # # Side effects: # None. # #---------------------------------------------------------------------- -proc ::tcl::clock::InterpretHMS { date } { - return [expr { - ( [dict get $date hour] * 60 - + [dict get $date minute] ) * 60 - + [dict get $date second] - }] +proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { + variable LocaleFormats + + if { $fmtkey eq {} } { set fmtkey FMT_$format } + if { [catch { + set locfmt [dict get $LocaleFormats $locale $fmtkey] + }] } { + + # get map list cached or build it: + if { [catch { + set mlst [dict get $LocaleFormats $locale MLST] + }] } { + + # message catalog dictionary: + set mcd [mcget $locale] + + # Handle locale-dependent format groups by mapping them out of the format + # string. Note that the order of the [string map] operations is + # significant because later formats can refer to later ones; for example + # %c can refer to %X, which in turn can refer to %T. + + set mlst { + %% %% + %D %m/%d/%Y + %+ {%a %b %e %H:%M:%S %Z %Y} + } + lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]] + lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]] + lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]] + lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]] + lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]] + lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]] + lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]] + lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]] + lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]] + lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]] + + dict set LocaleFormats $locale MLST $mlst + } + + # translate copy of format (don't use format object here, because otherwise + # it can lose its internal representation (string map - convert to unicode) + set locfmt [string map $mlst [string range " $format" 1 end]] + + # cache it: + dict set LocaleFormats $locale $fmtkey $locfmt + } + + # Save original format as long as possible, because of internal + # representation (performance). + # Note that in this case such format will be never localized (also + # using another locales). To prevent this return a duplicate (but + # it may be slower). + if {$locfmt eq $format} { + set locfmt $format + } + + return $locfmt } #---------------------------------------------------------------------- @@ -2891,38 +857,6 @@ proc ::tcl::clock::GetSystemTimeZone {} { #---------------------------------------------------------------------- # -# ConvertLegacyTimeZone -- -# -# Given an alphanumeric time zone identifier and the system time zone, -# convert the alphanumeric identifier to an unambiguous time zone. -# -# Parameters: -# tzname - Name of the time zone to convert -# -# Results: -# Returns a time zone name corresponding to tzname, but in an -# unambiguous form, generally +hhmm. -# -# This procedure is implemented primarily to allow the parsing of RFC822 -# date/time strings. Processing a time zone name on input is not recommended -# practice, because there is considerable room for ambiguity; for instance, is -# BST Brazilian Standard Time, or British Summer Time? -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::ConvertLegacyTimeZone { tzname } { - variable LegacyTimeZone - - set tzname [string tolower $tzname] - if { ![dict exists $LegacyTimeZone $tzname] } { - return -code error -errorcode [list CLOCK badTZName $tzname] \ - "time zone \"$tzname\" not found" - } - return [dict get $LegacyTimeZone $tzname] -} - -#---------------------------------------------------------------------- -# # SetupTimeZone -- # # Given the name or specification of a time zone, sets up its in-memory @@ -3837,43 +1771,6 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { #---------------------------------------------------------------------- # -# GetLocaleEra -- -# -# Given local time expressed in seconds from the Posix epoch, -# determine localized era and year within the era. -# -# Parameters: -# date - Dictionary that must contain the keys, 'localSeconds', -# whose value is expressed as the appropriate local time; -# and 'year', whose value is the Gregorian year. -# etable - Value of the LOCALE_ERAS key in the message catalogue -# for the target locale. -# -# Results: -# Returns the dictionary, augmented with the keys, 'localeEra' and -# 'localeYear'. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::GetLocaleEra { date etable } { - set index [BSearch $etable [dict get $date localSeconds]] - if { $index < 0} { - dict set date localeEra \ - [::format %02d [expr { [dict get $date year] / 100 }]] - dict set date localeYear [expr { - [dict get $date year] % 100 - }] - } else { - dict set date localeEra [lindex $etable $index 1] - dict set date localeYear [expr { - [dict get $date year] - [lindex $etable $index 2] - }] - } - return $date -} - -#---------------------------------------------------------------------- -# # GetJulianDayFromEraYearDay -- # # Given a year, month and day on the Gregorian calendar, determines @@ -4051,57 +1948,6 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } { #---------------------------------------------------------------------- # -# BSearch -- -# -# Service procedure that does binary search in several places inside the -# 'clock' command. -# -# Parameters: -# list - List of lists, sorted in ascending order by the -# first elements -# key - Value to search for -# -# Results: -# Returns the index of the greatest element in $list that is less than -# or equal to $key. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::BSearch { list key } { - if {[llength $list] == 0} { - return -1 - } - if { $key < [lindex $list 0 0] } { - return -1 - } - - set l 0 - set u [expr { [llength $list] - 1 }] - - while { $l < $u } { - # At this point, we know that - # $k >= [lindex $list $l 0] - # Either $u == [llength $list] or else $k < [lindex $list $u+1 0] - # We find the midpoint of the interval {l,u} rounded UP, compare - # against it, and set l or u to maintain the invariant. Note that the - # interval shrinks at each step, guaranteeing convergence. - - set m [expr { ( $l + $u + 1 ) / 2 }] - if { $key >= [lindex $list $m 0] } { - set l $m - } else { - set u [expr { $m - 1 }] - } - } - - return $l -} - -#---------------------------------------------------------------------- -# # clock add -- # # Adds an offset to a given time. diff --git a/library/init.tcl b/library/init.tcl index 6f34302..f1f1bb4 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 LocalizeFormat SetupTimeZone GetSystemTimeZone} { + foreach cmd {add mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} { proc ::tcl::clock::$cmd args { variable TclLibDir source -encoding utf-8 [file join $TclLibDir clock.tcl] -- cgit v0.12 From a6394b9a2e95c16faeb04b4ad950f46b11458466 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:52:12 +0000 Subject: some greedy matches are fixed (see test cases clock-6.22.11 and clock-6.22.12), involving space count in look ahead and end distance calculation (because spaces are optional in date-time string as well as in scanning format). --- generic/tclClockFmt.c | 121 ++++++++++++++++++++++++++++++++------------------ generic/tclDate.h | 2 + tests/clock.test | 37 +++++++++++++++ 3 files changed, 117 insertions(+), 43 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 307fc28..00ea0ed 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -723,24 +723,36 @@ inline void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok, int *minLen, int *maxLen) { - register const char*p = yyInput; + register const char *p = yyInput, + *end = info->dateEnd; *minLen = 0; - /* max length to the end regarding distance to end (min-width of following tokens) */ - *maxLen = info->dateEnd - p - tok->endDistance; - /* if no tokens anymore */ - if (!(tok+1)->map) { - /* should match to end or first space */ - while (!isspace(UCHAR(*p)) && ++p < info->dateEnd) {}; - *minLen = p - yyInput; - } else - /* next token is a word */ - if ((tok+1)->map->type == CTOKT_WORD) { - /* should match at least to the first char of this word */ - while (*p != *((tok+1)->tokWord.start) && ++p < info->dateEnd) {}; - *minLen = p - yyInput; + /* if still tokens available */ + if ((tok+1)->map) { + end -= tok->endDistance + yySpaceCount; + /* next token is a word */ + switch ((tok+1)->map->type) { + case CTOKT_WORD: + /* should match at least to the first char of this word */ + while (*p != *((tok+1)->tokWord.start) && ++p < end) {}; + *minLen = p - yyInput; + break; + case CTOKT_CHAR: + while (*p != *((char *)(tok+1)->map->data) && ++p < end) {}; + *minLen = p - yyInput; + break; + } } + /* max length to the end regarding distance to end (min-width of following tokens) */ + *maxLen = end - p; + if (*maxLen > tok->map->maxSize) { + *maxLen = tok->map->maxSize; + }; + + if (*minLen < tok->map->minSize) { + *minLen = tok->map->minSize; + } if (*minLen > *maxLen) { *maxLen = *minLen; } @@ -1384,7 +1396,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), NULL}, /* %b %B %h */ - {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0, ClockScnToken_Month_Proc}, /* %y */ {CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), @@ -1402,7 +1414,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay), NULL}, /* %p %P */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, ClockScnToken_amPmInd_Proc, NULL}, /* %J */ {CTOKT_DIGIT, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), @@ -1423,10 +1435,10 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), NULL}, /* %a %A %u %w */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, ClockScnToken_DayOfWeek_Proc, NULL}, /* %z %Z */ - {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0xffff, 0, ClockScnToken_TimeZone_Proc, NULL}, /* %U %W */ {CTOKT_DIGIT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */ @@ -1435,9 +1447,9 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), NULL}, /* %n */ - {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, + {CTOKT_CHAR, 0, 0, 0, 1, 0, NULL, "\n"}, /* min=0 - spaces are optional (in yySpaceCount) */ /* %t */ - {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, + {CTOKT_CHAR, 0, 0, 0, 1, 0, NULL, "\t"}, /* min=0 - spaces are optional (in yySpaceCount) */ /* %Q */ {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0, ClockScnToken_StarDate_Proc, NULL}, @@ -1451,10 +1463,10 @@ static const char *ScnETokenMapIndex = "Eys"; static ClockScanTokenMap ScnETokenMap[] = { /* %EE */ - {CTOKT_PARSER, 0, 0, 0, 0, TclOffset(DateInfo, date.year), + {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Ey */ - {CTOKT_PARSER, 0, 0, 0, 0, 0, /* currently no capture, parse only token */ + {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Es */ {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), @@ -1469,25 +1481,25 @@ static const char *ScnOTokenMapIndex = "dmyHMSu"; static ClockScanTokenMap ScnOTokenMap[] = { /* %Od %Oe */ - {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0, TclOffset(DateInfo, date.dayOfMonth), + {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.dayOfMonth), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Om */ - {CTOKT_PARSER, CLF_MONTH, 0, 0, 0, TclOffset(DateInfo, date.month), + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.month), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Oy */ - {CTOKT_PARSER, CLF_YEAR, 0, 0, 0, TclOffset(DateInfo, date.year), + {CTOKT_PARSER, CLF_YEAR, 0, 0, 0xffff, TclOffset(DateInfo, date.year), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %OH %Ok %OI %Ol */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.hour), + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.hour), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %OM */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.minutes), + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.minutes), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %OS */ - {CTOKT_PARSER, CLF_TIME, 0, 0, 0, TclOffset(DateInfo, date.secondOfDay), + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.secondOfDay), ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Ou Ow */ - {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0, 0, + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, }; static const char *ScnOTokenMapAliasIndex[2] = { @@ -1498,12 +1510,12 @@ static const char *ScnOTokenMapAliasIndex[2] = { static const char *ScnSpecTokenMapIndex = " "; static ClockScanTokenMap ScnSpecTokenMap[] = { - {CTOKT_SPACE, 0, 0, 0, 0xffff, 0, + {CTOKT_SPACE, 0, 0, 0, 0xffff, 0, /* min=0 - spaces are optional (in yySpaceCount) */ NULL}, }; static ClockScanTokenMap ScnWordTokenMap = { - CTOKT_WORD, 0, 0, 1, 0, 0, + CTOKT_WORD, 0, 0, 1, 0xffff, 0, NULL }; @@ -1739,7 +1751,22 @@ ClockScan( p++; } } - info->dateStart = yyInput = p; + yyInput = p; + /* look ahead to count spaces (bypass it by count length and distances) */ + x = end; + while (p < end) { + if (isspace(UCHAR(*p))) { + x = p++; + yySpaceCount++; + continue; + } + x = end; + p++; + } + /* ignore spaces at end */ + yySpaceCount -= (end - x); + end = x; + info->dateStart = p = yyInput; info->dateEnd = end; /* parse string */ @@ -1752,6 +1779,7 @@ ClockScan( && map->type != CTOKT_CHAR ) ) { while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; p++; } } @@ -1764,16 +1792,17 @@ ClockScan( { case CTOKT_DIGIT: if (1) { - int size = map->maxSize; + int minLen, size; int sign = 1; if (map->flags & CLF_SIGNED) { if (*p == '+') { yyInput = ++p; } else if (*p == '-') { yyInput = ++p; sign = -1; }; } + DetermineGreedySearchLen(opts, info, tok, &minLen, &size); /* greedy find digits (look for forward digits consider spaces), * corresponding pre-calculated lookAhead */ - if (size != map->minSize && tok->lookAhead) { + if (size != minLen && tok->lookAhead) { int spcnt = 0; const char *pe; size += tok->lookAhead; @@ -1845,6 +1874,12 @@ ClockScan( goto done; break; }; + /* decrement count for possible spaces in match */ + while (p < yyInput) { + if (isspace(UCHAR(*p++))) { + yySpaceCount--; + } + } p = yyInput; flags = (flags & ~map->clearFlags) | map->flags; break; @@ -1855,9 +1890,11 @@ ClockScan( /* unmatched -> error */ goto not_match; } + yySpaceCount--; p++; } while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; p++; } break; @@ -1875,27 +1912,25 @@ ClockScan( /* no match -> error */ goto not_match; } + if (isspace(UCHAR(*x))) { + yySpaceCount--; + } p++; break; } } /* check end was reached */ if (p < end) { - /* ignore spaces at end */ - while (p < end && isspace(UCHAR(*p))) { - p++; - } - if (p < end) { - /* something after last token - wrong format */ - goto not_match; - } + /* something after last token - wrong format */ + goto not_match; } /* end of string, check only optional tokens at end, otherwise - not match */ while (tok->map != NULL) { if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) { tok++; + if (tok->map == NULL) break; } - if (tok->map != NULL && !(tok->map->flags & CLF_OPTIONAL)) { + if (!(tok->map->flags & CLF_OPTIONAL)) { goto not_match; } tok++; diff --git a/generic/tclDate.h b/generic/tclDate.h index 2ce629d..519a3e5 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -204,6 +204,7 @@ typedef struct DateInfo { time_t *dateRelPointer; + time_t dateSpaceCount; time_t dateDigitCount; time_t dateCentury; @@ -241,6 +242,7 @@ typedef struct DateInfo { #define yyRelPointer (info->dateRelPointer) #define yyInput (info->dateInput) #define yyDigitCount (info->dateDigitCount) +#define yySpaceCount (info->dateSpaceCount) inline void ClockInitDateInfo(DateInfo *info) { diff --git a/tests/clock.test b/tests/clock.test index 4b0587a..46a2b29 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18638,6 +18638,43 @@ test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and unset -nocomplain wrong i i2 s d } +test clock-6.22.1 {Greedy match} { + clock format [clock scan "111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 00:00:00 GMT 2001} +test clock-6.22.2 {Greedy match} { + clock format [clock scan "1111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Thu Jan 11 00:00:00 GMT 2001} +test clock-6.22.3 {Greedy match} { + clock format [clock scan "11111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Sun Nov 11 00:00:00 GMT 2001} +test clock-6.22.4 {Greedy match} { + clock format [clock scan "111111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Fri Nov 11 00:00:00 GMT 2011} +test clock-6.22.5 {Greedy match} { + clock format [clock scan "1 1 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 00:00:00 GMT 2001} +test clock-6.22.6 {Greedy match} { + clock format [clock scan "111 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Thu Jan 11 00:00:00 GMT 2001} +test clock-6.22.7 {Greedy match} { + clock format [clock scan "1 111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Thu Nov 01 00:00:00 GMT 2001} +test clock-6.22.8 {Greedy match} { + clock format [clock scan "1 11 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Thu Nov 01 00:00:00 GMT 2001} +test clock-6.22.9 {Greedy match} { + clock format [clock scan "1 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Tue Nov 01 00:00:00 GMT 2011} +test clock-6.22.10 {Greedy match} { + clock format [clock scan "11 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1 +} {Fri Nov 11 00:00:00 GMT 2011} +test clock-6.22.11 {Greedy match} { + clock format [clock scan "1111 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Sat Jan 01 01:02:00 GMT 2011} +test clock-6.22.12 {Greedy match} { + clock format [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 01:02:00 GMT 2001} + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true -- cgit v0.12 From ca189ac27c97eb664b3093dee4fd774a933d7a67 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:52:44 +0000 Subject: another way to make greedy search more precise, some greedy matches are fixed (see test cases clock-6.22.11 - clock-6.22.20), additionally involving look ahead token of known type into pre-search process. --- generic/tclClockFmt.c | 273 ++++++++++++++++++++++++++++++++++---------------- generic/tclDate.h | 7 +- tests/clock.test | 41 ++++++-- 3 files changed, 224 insertions(+), 97 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 00ea0ed..680e33d 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -713,49 +713,127 @@ clean: return (opts->formatObj = valObj); } +static const char * +FindTokenBegin( + register const char *p, + register const char *end, + ClockScanToken *tok) +{ + char c; + if (p < end) { + /* next token a known token type */ + switch (tok->map->type) { + case CTOKT_DIGIT: + /* should match at least one digit */ + while (!isdigit(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_WORD: + c = *(tok->tokWord.start); + /* should match at least to the first char of this word */ + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_SPACE: + while (!isspace(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_CHAR: + c = *((char *)tok->map->data); + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + } + } + return p; +} + /* * DetermineGreedySearchLen -- * * Determine min/max lengths as exact as possible (speed, greedy match) * */ -inline -void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, - DateInfo *info, ClockScanToken *tok, int *minLen, int *maxLen) +static void +DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok, + int *minLenPtr, int *maxLenPtr) { - register const char *p = yyInput, + register int minLen = tok->map->minSize; + register int maxLen; + register const char *p = yyInput + minLen, *end = info->dateEnd; - *minLen = 0; - /* if still tokens available */ + /* if still tokens available, try to correct minimum length */ if ((tok+1)->map) { end -= tok->endDistance + yySpaceCount; - /* next token is a word */ - switch ((tok+1)->map->type) { - case CTOKT_WORD: - /* should match at least to the first char of this word */ - while (*p != *((tok+1)->tokWord.start) && ++p < end) {}; - *minLen = p - yyInput; - break; - case CTOKT_CHAR: - while (*p != *((char *)(tok+1)->map->data) && ++p < end) {}; - *minLen = p - yyInput; - break; + /* find position of next known token */ + p = FindTokenBegin(p, end, tok+1); + if (p < end) { + minLen = p - yyInput; } } /* max length to the end regarding distance to end (min-width of following tokens) */ - *maxLen = end - p; - if (*maxLen > tok->map->maxSize) { - *maxLen = tok->map->maxSize; + maxLen = end - yyInput; + /* several amendments */ + if (maxLen > tok->map->maxSize) { + maxLen = tok->map->maxSize; }; - - if (*minLen < tok->map->minSize) { - *minLen = tok->map->minSize; + if (minLen < tok->map->minSize) { + minLen = tok->map->minSize; } - if (*minLen > *maxLen) { - *maxLen = *minLen; + if (minLen > maxLen) { + maxLen = minLen; + } + if (maxLen > info->dateEnd - yyInput) { + maxLen = info->dateEnd - yyInput; + } + + /* check digits rigth now */ + if (tok->map->type == CTOKT_DIGIT) { + p = yyInput; + end = p + maxLen; + if (end > info->dateEnd) { end = info->dateEnd; }; + while (isdigit(UCHAR(*p)) && p < end) { p++; }; + maxLen = p - yyInput; + } + + /* try to get max length more precise for greedy match, + * check the next ahead token available there */ + if (minLen < maxLen && tok->lookAhTok) { + ClockScanToken *laTok = tok + tok->lookAhTok + 1; + p = yyInput + maxLen; + /* regards all possible spaces here (because they are optional) */ + end = p + tok->lookAhMax + yySpaceCount + 1; + if (end > info->dateEnd) { + end = info->dateEnd; + } + p += tok->lookAhMin; + if (laTok->map && p < end) { + const char *f; + /* try to find laTok between [lookAhMin, lookAhMax] */ + while (minLen < maxLen) { + f = FindTokenBegin(p, end, laTok); + /* if found (not below lookAhMax) */ + if (f < end) { + break; + } + /* try again with fewer length */ + maxLen--; + p--; + end--; + } + } else if (p > end) { + maxLen -= (p - end); + if (maxLen < minLen) { + maxLen = minLen; + } + } } + + *minLenPtr = minLen; + *maxLenPtr = maxLen; } inline int @@ -1447,9 +1525,9 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), NULL}, /* %n */ - {CTOKT_CHAR, 0, 0, 0, 1, 0, NULL, "\n"}, /* min=0 - spaces are optional (in yySpaceCount) */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, /* %t */ - {CTOKT_CHAR, 0, 0, 0, 1, 0, NULL, "\t"}, /* min=0 - spaces are optional (in yySpaceCount) */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, /* %Q */ {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0, ClockScnToken_StarDate_Proc, NULL}, @@ -1510,12 +1588,12 @@ static const char *ScnOTokenMapAliasIndex[2] = { static const char *ScnSpecTokenMapIndex = " "; static ClockScanTokenMap ScnSpecTokenMap[] = { - {CTOKT_SPACE, 0, 0, 0, 0xffff, 0, /* min=0 - spaces are optional (in yySpaceCount) */ + {CTOKT_SPACE, 0, 0, 1, 1, 0, NULL}, }; static ClockScanTokenMap ScnWordTokenMap = { - CTOKT_WORD, 0, 0, 1, 0xffff, 0, + CTOKT_WORD, 0, 0, 1, 1, 0, NULL }; @@ -1559,7 +1637,7 @@ EstimateTokenCount( /* *---------------------------------------------------------------------- */ -ClockScanToken * +ClockFmtScnStorage * ClockGetOrParseScanFormat( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *formatObj) /* Format container */ @@ -1574,6 +1652,7 @@ ClockGetOrParseScanFormat( /* if first time scanning - tokenize format */ if (fss->scnTok == NULL) { + unsigned int tokCnt; register const char *p, *e, *cp; e = p = HashEntry4FmtScn(fss)->key.string; @@ -1581,11 +1660,14 @@ ClockGetOrParseScanFormat( /* estimate token count by % char and format length */ fss->scnTokC = EstimateTokenCount(p, e); + + fss->scnSpaceCount = 0; Tcl_MutexLock(&ClockFmtMutex); fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; while (p < e) { switch (*p) { case '%': @@ -1605,7 +1687,7 @@ ClockGetOrParseScanFormat( tok->map = &ScnWordTokenMap; tok->tokWord.start = p; tok->tokWord.end = p+1; - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; p++; continue; break; @@ -1642,21 +1724,31 @@ ClockGetOrParseScanFormat( } tok->map = &scnMap[cp - mapIndex]; tok->tokWord.start = p; + /* calculate look ahead value by standing together tokens */ - if (tok > fss->scnTok && tok->map->minSize) { - unsigned int lookAhead = tok->map->minSize; + if (tok > fss->scnTok) { ClockScanToken *prevTok = tok - 1; while (prevTok >= fss->scnTok) { if (prevTok->map->type != tok->map->type) { break; } - prevTok->lookAhead += lookAhead; + prevTok->lookAhMin += tok->map->minSize; + prevTok->lookAhMax += tok->map->maxSize; + prevTok->lookAhTok++; prevTok--; } } + + /* increase space count used in format */ + if ( tok->map->type == CTOKT_CHAR + && isspace(UCHAR(*((char *)tok->map->data))) + ) { + fss->scnSpaceCount++; + } + /* next token */ - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; p++; continue; } @@ -1668,7 +1760,10 @@ ClockGetOrParseScanFormat( goto word_tok; } tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + /* increase space count used in format */ + fss->scnSpaceCount++; + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; p++; continue; break; @@ -1679,10 +1774,14 @@ word_tok: if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { wordTok = tok-1; } + /* new word token */ if (wordTok == tok) { wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; - AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + } + if (isspace(UCHAR(*p))) { + fss->scnSpaceCount++; } p = TclUtfNext(p); wordTok->tokWord.end = p; @@ -1705,12 +1804,22 @@ word_tok: } prevTok--; } - } + } + + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->scnTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->scnTok = tok; + } + } + fss->scnTokC = tokCnt; + done: Tcl_MutexUnlock(&ClockFmtMutex); } - return fss->scnTok; + return fss; } /* @@ -1723,6 +1832,7 @@ ClockScan( ClockFmtScnCmdArgs *opts) /* Command options */ { ClockClientData *dataPtr = opts->clientData; + ClockFmtScnStorage *fss; ClockScanToken *tok; ClockScanTokenMap *map; register const char *p, *x, *end; @@ -1734,8 +1844,9 @@ ClockScan( return TCL_ERROR; } - if ((tok = ClockGetOrParseScanFormat(opts->interp, - opts->formatObj)) == NULL) { + if ( !(fss = ClockGetOrParseScanFormat(opts->interp, opts->formatObj)) + || !(tok = fss->scnTok) + ) { return TCL_ERROR; } @@ -1766,6 +1877,11 @@ ClockScan( /* ignore spaces at end */ yySpaceCount -= (end - x); end = x; + /* ignore mandatory spaces used in format */ + yySpaceCount -= fss->scnSpaceCount; + if (yySpaceCount < 0) { + yySpaceCount = 0; + } info->dateStart = p = yyInput; info->dateEnd = end; @@ -1799,39 +1915,9 @@ ClockScan( else if (*p == '-') { yyInput = ++p; sign = -1; }; } + DetermineGreedySearchLen(opts, info, tok, &minLen, &size); - /* greedy find digits (look for forward digits consider spaces), - * corresponding pre-calculated lookAhead */ - if (size != minLen && tok->lookAhead) { - int spcnt = 0; - const char *pe; - size += tok->lookAhead; - x = p + size; if (x > end) { x = end; }; - pe = x; - while (p < x) { - if (isspace(UCHAR(*p))) { - if (pe > p) { pe = p; }; - if (x < end) x++; - p++; - spcnt++; - continue; - } - if (isdigit(UCHAR(*p))) { - p++; - continue; - } - break; - } - /* consider reserved (lookAhead) for next tokens */ - p -= tok->lookAhead + spcnt; - if (p > pe) { - p = pe; - } - } else { - x = p + size; if (x > end) { x = end; }; - while (isdigit(UCHAR(*p)) && p < x) { p++; }; - } - size = p - yyInput; + if (size < map->minSize) { /* missing input -> error */ if ((map->flags & CLF_OPTIONAL)) { @@ -1884,15 +1970,13 @@ ClockScan( flags = (flags & ~map->clearFlags) | map->flags; break; case CTOKT_SPACE: - /* at least one space in strict mode */ - if (opts->flags & CLF_STRICT) { - if (!isspace(UCHAR(*p))) { - /* unmatched -> error */ - goto not_match; - } - yySpaceCount--; - p++; + /* at least one space */ + if (!isspace(UCHAR(*p))) { + /* unmatched -> error */ + goto not_match; } + yySpaceCount--; + p++; while (p < end && isspace(UCHAR(*p))) { yySpaceCount--; p++; @@ -2460,7 +2544,7 @@ static ClockFormatTokenMap FmtWordTokenMap = { /* *---------------------------------------------------------------------- */ -ClockFormatToken * +ClockFmtScnStorage * ClockGetOrParseFmtFormat( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *formatObj) /* Format container */ @@ -2475,6 +2559,7 @@ ClockGetOrParseFmtFormat( /* if first time scanning - tokenize format */ if (fss->fmtTok == NULL) { + unsigned int tokCnt; register const char *p, *e, *cp; e = p = HashEntry4FmtScn(fss)->key.string; @@ -2487,6 +2572,7 @@ ClockGetOrParseFmtFormat( fss->fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC); memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; while (p < e) { switch (*p) { case '%': @@ -2506,7 +2592,7 @@ ClockGetOrParseFmtFormat( tok->map = &FmtWordTokenMap; tok->tokWord.start = p; tok->tokWord.end = p+1; - AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; p++; continue; break; @@ -2544,7 +2630,7 @@ ClockGetOrParseFmtFormat( tok->map = &fmtMap[cp - mapIndex]; tok->tokWord.start = p; /* next token */ - AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; p++; continue; } @@ -2559,7 +2645,7 @@ word_tok: if (wordTok == tok) { wordTok->tokWord.start = p; wordTok->map = &FmtWordTokenMap; - AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; } p = TclUtfNext(p); wordTok->tokWord.end = p; @@ -2568,11 +2654,20 @@ word_tok: } } + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->fmtTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->fmtTok = tok; + } + } + fss->fmtTokC = tokCnt; + done: Tcl_MutexUnlock(&ClockFmtMutex); } - return fss->fmtTok; + return fss; } /* @@ -2584,6 +2679,7 @@ ClockFormat( ClockFmtScnCmdArgs *opts) /* Command options */ { ClockClientData *dataPtr = opts->clientData; + ClockFmtScnStorage *fss; ClockFormatToken *tok; ClockFormatTokenMap *map; @@ -2592,8 +2688,9 @@ ClockFormat( return TCL_ERROR; } - if ((tok = ClockGetOrParseFmtFormat(opts->interp, - opts->formatObj)) == NULL) { + if ( !(fss = ClockGetOrParseFmtFormat(opts->interp, opts->formatObj)) + || !(tok = fss->fmtTok) + ) { return TCL_ERROR; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 519a3e5..c50753d 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -375,12 +375,14 @@ typedef struct ClockScanTokenMap { typedef struct ClockScanToken { ClockScanTokenMap *map; - unsigned short int lookAhead; - unsigned short int endDistance; struct { const char *start; const char *end; } tokWord; + unsigned short int endDistance; + unsigned short int lookAhMin; + unsigned short int lookAhMax; + unsigned short int lookAhTok; } ClockScanToken; @@ -435,6 +437,7 @@ typedef struct ClockFmtScnStorage { int objRefCount; /* Reference count shared across threads */ ClockScanToken *scnTok; unsigned int scnTokC; + unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */ ClockFormatToken *fmtTok; unsigned int fmtTokC; #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 diff --git a/tests/clock.test b/tests/clock.test index 46a2b29..d9c491a 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18588,16 +18588,16 @@ test clock-6.16 {input of ambiguous short locale token (%b)} { } {1 {input string does not match supplied format} {CLOCK badInputString}} test clock-6.17 {spaces are always optional in non-strict mode (default)} { - list [clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ - [clock scan "2009-06-30T18:30:00 +02:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ - [clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S %z" -timezone CET] \ - [clock scan "2009-06-30T18:30:00 Z" -format "%Y-%m-%dT%H:%M:%S %z" -timezone CET] + list [clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00 +02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET] \ + [clock scan "2009-06-30T18:30:00 Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET] } {1246379400 1246379400 1246386600 1246386600} test clock-6.18 {zone token (%z) is optional} { - list [clock scan "2009-06-30T18:30:00 -01:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ - [clock scan "2009-06-30T18:30:00" -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ - [clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1] \ + list [clock scan "2009-06-30T18:30:00 -01:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \ + [clock scan "2009-06-30T18:30:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \ + [clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \ } {1246390200 1246386600 1246386600} test clock-6.19 {no token parsing} { @@ -18674,6 +18674,33 @@ test clock-6.22.11 {Greedy match} { test clock-6.22.12 {Greedy match} { clock format [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 } {Mon Jan 01 01:02:00 GMT 2001} +test clock-6.22.13 {Greedy match} { + clock format [clock scan "1 11 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 01:02:00 GMT 2001} +test clock-6.22.14 {Greedy match} { + clock format [clock scan "111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 01:02:00 GMT 2001} +test clock-6.22.15 {Greedy match} { + clock format [clock scan "1111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1 +} {Sat Jan 01 01:02:00 GMT 2011} +test clock-6.22.16 {Greedy match} { + clock format [clock scan "11121120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1 +} {Thu Dec 01 01:02:00 GMT 2011} +test clock-6.22.17 {Greedy match} { + clock format [clock scan "111213120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1 +} {Tue Dec 13 01:02:00 GMT 2011} +test clock-6.22.17 {Greedy match (space wins as date-time separator)} { + clock format [clock scan "1112 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Sun Jan 02 13:12:00 GMT 2011} +test clock-6.22.18 {Greedy match (second space wins as date-time separator)} { + clock format [clock scan "1112 13 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Tue Dec 13 01:02:00 GMT 2011} +test clock-6.22.19 {Greedy match (space wins as date-time separator)} { + clock format [clock scan "111 213120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Mon Jan 01 21:31:20 GMT 2001} +test clock-6.22.20 {Greedy match (second space wins as date-time separator)} { + clock format [clock scan "111 2 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 +} {Sun Jan 02 13:12:00 GMT 2011} test clock-7.1 {Julian Day} { -- cgit v0.12 From c0770e6442035a91d2d3d60624071e44cb6c7950 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:53:05 +0000 Subject: dict: unused variable removed --- generic/tclDictObj.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 3944173..8e11bfe 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2014,7 +2014,6 @@ DictSmartRefCmd( Tcl_Obj *const *objv) { Tcl_Obj *result; - Dict *dict; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); -- cgit v0.12 From 711d1c6a2168db11f4a5157d4cb75d5f9382ef6a Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:55:00 +0000 Subject: [unix] build for *nix fixed, code clean-ups; missing declarations; unused vars, functions etc; types normalization; --- generic/tclClock.c | 6 +--- generic/tclClockFmt.c | 31 ++++++++++--------- generic/tclDate.c | 8 ++--- generic/tclDate.h | 80 +++++++++++++++++++++++++------------------------ generic/tclGetDate.y | 8 ++--- generic/tclStrIdxTree.c | 8 ++--- generic/tclStrIdxTree.h | 8 ++--- unix/Makefile.in | 4 +-- 8 files changed, 77 insertions(+), 76 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 7d4263c..1b1faae 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -137,10 +137,6 @@ static unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); -static int ClockTestObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); - /* * Structure containing description of "native" clock commands to create. */ @@ -3365,7 +3361,7 @@ repeat_rel: /* relative time (seconds), if exceeds current date, do the day conversion and * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */ if (yyRelSeconds) { - time_t newSecs = yySeconds + yyRelSeconds; + int newSecs = yySeconds + yyRelSeconds; /* if seconds increment outside of current date, increment day */ if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) { diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 680e33d..a5ddd18 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -43,13 +43,13 @@ CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); inline int _str2int( - time_t *out, + int *out, register const char *p, const char *e, int sign) { - register time_t val = 0, prev = 0; + register int val = 0, prev = 0; if (sign >= 0) { while (p < e) { val = val * 10 + (*p++ - '0'); @@ -880,6 +880,7 @@ ObjListSearch(ClockFmtScnCmdArgs *opts, } return TCL_RETURN; } +#if 0 static int LocaleListSearch(ClockFmtScnCmdArgs *opts, @@ -905,6 +906,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, return ObjListSearch(opts, info, val, lstv, lstc, minLen, maxLen); } +#endif static TclStrIdxTree * ClockMCGetListIdxTree( @@ -1039,6 +1041,7 @@ ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, return TCL_OK; } +#if 0 static int StaticListSearch(ClockFmtScnCmdArgs *opts, @@ -1062,6 +1065,7 @@ StaticListSearch(ClockFmtScnCmdArgs *opts, } return TCL_RETURN; } +#endif inline const char * FindWordEnd( @@ -1069,7 +1073,7 @@ FindWordEnd( register const char * p, const char * end) { register const char *x = tok->tokWord.start; - const char *pfnd; + const char *pfnd = p; if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */ if (*p == *x) { return ++p; @@ -1088,14 +1092,14 @@ static int ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { - /* +#if 0 static const char * months[] = { - /* full * / + /* full */ "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December", - /* abbr * / + /* abbr */ "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", NULL @@ -1106,7 +1110,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, } yyMonth = (val % 12) + 1; return TCL_OK; - */ +#endif static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; @@ -1300,7 +1304,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, } if (tok->map->offs > 0) { - *(time_t *)(((char *)info) + tok->map->offs) = val; + *(int *)(((char *)info) + tok->map->offs) = val; } return TCL_OK; @@ -1334,7 +1338,7 @@ ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, *bp++ = *p++; len++; if (len + 2 < maxLen) { if (*p == ':') { - *p++; len++; + p++; len++; } } } @@ -1392,7 +1396,7 @@ ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, { int minLen, maxLen; register const char *p = yyInput, *end; const char *s; - time_t year, fractYear, fractDayDiv, fractDay; + int year, fractYear, fractDayDiv, fractDay; static const char *stardatePref = "stardate "; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -1626,7 +1630,7 @@ EstimateTokenCount( #define AllocTokenInChain(tok, chain, tokCnt) \ if (++(tok) >= (chain) + (tokCnt)) { \ - (char *)(chain) = ckrealloc((char *)(chain), \ + *((char **)&chain) = ckrealloc((char *)(chain), \ (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ if ((chain) == NULL) { goto done; }; \ (tok) = (chain) + (tokCnt); \ @@ -1929,7 +1933,7 @@ ClockScan( if (map->offs) { p = yyInput; x = p + size; if (!(map->flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { - if (_str2int((time_t *)(((char *)info) + map->offs), + if (_str2int((int *)(((char *)info) + map->offs), p, x, sign) != TCL_OK) { goto overflow; } @@ -2678,7 +2682,6 @@ ClockFormat( register DateFormat *dateFmt, /* Date fields used for parsing & converting */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = opts->clientData; ClockFmtScnStorage *fss; ClockFormatToken *tok; ClockFormatTokenMap *map; @@ -2716,7 +2719,7 @@ ClockFormat( { case CFMTT_INT: if (1) { - int val = (int)*(time_t *)(((char *)dateFmt) + map->offs); + int val = (int)*(int *)(((char *)dateFmt) + map->offs); if (map->fmtproc == NULL) { if (map->flags & CLFMT_DECR) { val--; diff --git a/generic/tclDate.c b/generic/tclDate.c index 5bd96d0..64cb804 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2448,11 +2448,11 @@ TclDateerror( infoPtr->separatrix = "\n"; } -time_t +MODULE_SCOPE int ToSeconds( - time_t Hours, - time_t Minutes, - time_t Seconds, + int Hours, + int Minutes, + int Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { diff --git a/generic/tclDate.h b/generic/tclDate.h index c50753d..c9c6726 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -142,21 +142,21 @@ typedef struct TclDateFields { * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds * from the Posix epoch */ - time_t tzOffset; /* Time zone offset in seconds east of + int tzOffset; /* Time zone offset in seconds east of * Greenwich */ - time_t julianDay; /* Julian Day Number in local time zone */ + int julianDay; /* Julian Day Number in local time zone */ enum {BCE=1, CE=0} era; /* Era */ - time_t gregorian; /* Flag == 1 if the date is Gregorian */ - time_t year; /* Year of the era */ - time_t dayOfYear; /* Day of the year (1 January == 1) */ - time_t month; /* Month number */ - time_t dayOfMonth; /* Day of the month */ - time_t iso8601Year; /* ISO8601 week-based year */ - time_t iso8601Week; /* ISO8601 week number */ - time_t dayOfWeek; /* Day of the week */ - time_t hour; /* Hours of day (in-between time only calculation) */ - time_t minutes; /* Minutes of day (in-between time only calculation) */ - time_t secondOfDay; /* Seconds of day (in-between time only calculation) */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ + int hour; /* Hours of day (in-between time only calculation) */ + int minutes; /* Minutes of day (in-between time only calculation) */ + int secondOfDay; /* Seconds of day (in-between time only calculation) */ /* Non cacheable fields: */ @@ -180,34 +180,34 @@ typedef struct DateInfo { int flags; - time_t dateHaveDate; + int dateHaveDate; - time_t dateMeridian; - time_t dateHaveTime; + int dateMeridian; + int dateHaveTime; - time_t dateTimezone; - time_t dateDSTmode; - time_t dateHaveZone; + int dateTimezone; + int dateDSTmode; + int dateHaveZone; - time_t dateRelMonth; - time_t dateRelDay; - time_t dateRelSeconds; - time_t dateHaveRel; + int dateRelMonth; + int dateRelDay; + int dateRelSeconds; + int dateHaveRel; - time_t dateMonthOrdinalIncr; - time_t dateMonthOrdinal; - time_t dateHaveOrdinalMonth; + int dateMonthOrdinalIncr; + int dateMonthOrdinal; + int dateHaveOrdinalMonth; - time_t dateDayOrdinal; - time_t dateDayNumber; - time_t dateHaveDay; + int dateDayOrdinal; + int dateDayNumber; + int dateHaveDay; - time_t *dateRelPointer; + int *dateRelPointer; - time_t dateSpaceCount; - time_t dateDigitCount; + int dateSpaceCount; + int dateDigitCount; - time_t dateCentury; + int dateCentury; Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ @@ -244,7 +244,7 @@ typedef struct DateInfo { #define yyDigitCount (info->dateDigitCount) #define yySpaceCount (info->dateSpaceCount) -inline void +static inline void ClockInitDateInfo(DateInfo *info) { memset(info, 0, sizeof(DateInfo)); } @@ -314,7 +314,7 @@ typedef struct ClockClientData { Tcl_WideInt seconds; Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ /* values */ - time_t tzOffset; + int tzOffset; Tcl_Obj *tzName; } UTC2Local; /* Las-period cache for fast Local2UTC conversion */ @@ -325,7 +325,7 @@ typedef struct ClockClientData { Tcl_WideInt localSeconds; Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ /* values */ - time_t tzOffset; + int tzOffset; } Local2UTC; } ClockClientData; @@ -444,16 +444,18 @@ typedef struct ClockFmtScnStorage { ClockFmtScnStorage *nextPtr; ClockFmtScnStorage *prevPtr; #endif -/* +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, +#if 0 + +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, * stored by offset +sizeof(self) */ +#endif } ClockFmtScnStorage; /* * Prototypes of module functions. */ -MODULE_SCOPE time_t ToSeconds(time_t Hours, time_t Minutes, - time_t Seconds, MERIDIAN Meridian); +MODULE_SCOPE int ToSeconds(int Hours, int Minutes, + int Seconds, MERIDIAN Meridian); MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); MODULE_SCOPE void GetJulianDayFromEraYearWeekDay( diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 9e3623f..6d6a0d0 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -659,11 +659,11 @@ TclDateerror( infoPtr->separatrix = "\n"; } -time_t +MODULE_SCOPE int ToSeconds( - time_t Hours, - time_t Minutes, - time_t Seconds, + int Hours, + int Minutes, + int Seconds, MERIDIAN Meridian) { if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) { diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index afb53e5..b47b4b7 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -171,11 +171,11 @@ TclStrIdxTreeInsertBranch( parent->firstPtr = item; if (parent->lastPtr == child) parent->lastPtr = item; - if (item->nextPtr = child->nextPtr) { + if ( (item->nextPtr = child->nextPtr) ) { item->nextPtr->prevPtr = item; child->nextPtr = NULL; } - if (item->prevPtr = child->prevPtr) { + if ( (item->prevPtr = child->prevPtr) ) { item->prevPtr->nextPtr = item; child->prevPtr = NULL; } @@ -365,7 +365,7 @@ StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1; } /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ - Tcl_InitObjRef(((Tcl_Obj *)copyPtr->internalRep.twoPtrValue.ptr1), + Tcl_InitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1), srcPtr); copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &StrIdxTreeObjType; @@ -379,7 +379,7 @@ StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr) && objPtr->internalRep.twoPtrValue.ptr2 == NULL ) { /* is a link */ - Tcl_UnsetObjRef(((Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1)); + Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1)); } else { /* is a tree */ TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index 934e28f..305053c 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -49,7 +49,7 @@ typedef struct TclStrIdx { *---------------------------------------------------------------------- */ -inline const char * +static inline const char * TclUtfFindEqual( register const char *cs, /* UTF string to find in cin. */ register const char *cse, /* End of cs */ @@ -66,7 +66,7 @@ TclUtfFindEqual( return ret; } -inline const char * +static inline const char * TclUtfFindEqualNC( register const char *cs, /* UTF string to find in cin. */ register const char *cse, /* End of cs */ @@ -89,7 +89,7 @@ TclUtfFindEqualNC( return ret; } -inline const char * +static inline const char * TclUtfFindEqualNCInLwr( register const char *cs, /* UTF string (in anycase) to find in cin. */ register const char *cse, /* End of cs */ @@ -111,7 +111,7 @@ TclUtfFindEqualNCInLwr( return ret; } -inline const char * +static inline const char * TclUtfNext( register const char *src) /* The current location in the string. */ { diff --git a/unix/Makefile.in b/unix/Makefile.in index 19ab6ec..9bdcacd 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -292,7 +292,7 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ - tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ + tclClock.o tclClockFmt.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \ tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \ tclEncoding.o tclEnsemble.o \ @@ -304,7 +304,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \ tclPkg.o tclPkgConfig.o tclPosixStr.o \ tclPreserve.o tclProc.o tclRegexp.o \ - tclResolve.o tclResult.o tclScan.o tclStringObj.o \ + tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStrIdxTree.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ -- cgit v0.12 From 5b78094ea6b2026c6b28ee878ad1c09b26946bd5 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:56:13 +0000 Subject: Merge remote-tracking branch 'remotes/fossil/trunk' into sb/trunk-rewrite-clock-in-c; + minor fixes after merge. --- generic/tclClock.c | 3 +-- generic/tclDate.h | 2 +- generic/tclDictObj.c | 50 +++++++++++++++++++++++++++++++---------------- library/msgcat/msgcat.tcl | 2 +- win/makefile.vc | 4 +--- 5 files changed, 37 insertions(+), 24 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1b1faae..a417758 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -309,8 +309,7 @@ ClockDeleteCmdProc( ClockClientData *data = clientData; int i; - data->refCount--; - if (data->refCount == 0) { + if (data->refCount-- <= 1) { for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } diff --git a/generic/tclDate.h b/generic/tclDate.h index c9c6726..cf307a6 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -275,7 +275,7 @@ typedef struct ClockFmtScnCmdArgs { */ typedef struct ClockClientData { - int refCount; /* Number of live references. */ + size_t refCount; /* Number of live references. */ Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */ Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */ Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_, diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 8e11bfe..caebbf1 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -145,7 +145,7 @@ typedef struct Dict { * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ - int refcount; /* Reference counter (see above) */ + size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ @@ -395,7 +395,7 @@ DupDictInternalRep( newDict->epoch = 0; newDict->chain = NULL; - newDict->refcount = 1; + newDict->refCount = 1; /* * Store in the object. @@ -430,8 +430,7 @@ FreeDictInternalRep( { Dict *dict = DICT(dictPtr); - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } dictPtr->typePtr = NULL; @@ -716,7 +715,7 @@ SetDictFromAny( TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; @@ -1120,7 +1119,7 @@ Tcl_DictObjFirst( searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; - dict->refcount++; + dict->refCount++; if (keyPtrPtr != NULL) { *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); } @@ -1234,8 +1233,7 @@ Tcl_DictObjDone( if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } } @@ -1387,7 +1385,7 @@ Tcl_NewDictObj(void) InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1437,7 +1435,7 @@ Tcl_DbNewDictObj( InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1981,7 +1979,7 @@ Tcl_DictObjSmartRef( result = Tcl_NewObj(); DICT(result) = dict; - dict->refcount++; + dict->refCount++; result->internalRep.twoPtrValue.ptr2 = NULL; result->typePtr = &tclDictType; @@ -2355,7 +2353,7 @@ DictAppendCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; - int i, allocatedDict = 0; + int allocatedDict = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); @@ -2380,15 +2378,33 @@ DictAppendCmd( if ((objc > 3) || (valuePtr == NULL)) { /* Only go through append activites when something will change. */ + Tcl_Obj *appendObjPtr = NULL; - if (valuePtr == NULL) { + if (objc > 3) { + /* Something to append */ + + if (objc == 4) { + appendObjPtr = objv[3]; + } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, + objc-3, objv+3, &appendObjPtr)) { + return TCL_ERROR; + } + } + + if (appendObjPtr == NULL) { + /* => (objc == 3) => (valuePtr == NULL) */ TclNewObj(valuePtr); - } else if (Tcl_IsShared(valuePtr)) { - valuePtr = Tcl_DuplicateObj(valuePtr); + } else if (valuePtr == NULL) { + valuePtr = appendObjPtr; + appendObjPtr = NULL; } - for (i=3 ; i Date: Tue, 10 Jan 2017 22:58:29 +0000 Subject: test-performance: added calibration of `timerate` to minimize influence of the parasitical execution-overhead by extremely fast execution times --- tests-perf/clock.perf.tcl | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index f3b8a10..7b522d0 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -19,11 +19,19 @@ ## set testing defaults: set ::env(TCL_TZ) :CET -## warm-up (load clock.tcl, system zones, locales, etc.): +# warm-up interpeter compiler env, clock platform-related features, +# calibrate timerate measurement functionality: +puts -nonewline "Calibration ... "; flush stdout +puts "done: [lrange \ + [timerate -calibrate {}] \ +0 1]" + +## warm-up test-related features (load clock.tcl, system zones, locales, etc.): clock scan "" -gmt 1 clock scan "" clock scan "" -timezone :CET clock scan "" -format "" -locale en +clock scan "" -format "" -locale de ## ------------------------------------------ @@ -239,6 +247,11 @@ proc test-scan {{reptime 1000}} { {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"} {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"} + # Scan : locale date-time (en): + {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en} + # Scan : locale date-time (de): + {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de} + # Scan : dynamic format (cacheable) {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} -- cgit v0.12 From 1adb7a5b43634186dbc9ecbd86aac53f45cdcd3c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 22:59:16 +0000 Subject: [unix] resolving of several warnings (gcc 5.x): - static used in non-static inline function; - x64 int cast on pointer [-Wpointer-to-int-cast]; - (obscure) may be used uninitialized in this function [-Wmaybe-uninitialized]; - TclEnvEpoch initialized and declared extern; --- generic/tclClock.c | 8 ++++---- generic/tclClockFmt.c | 36 ++++++++++++++++++------------------ generic/tclEnv.c | 5 +++-- generic/tclStrIdxTree.c | 2 +- 4 files changed, 26 insertions(+), 25 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a417758..a324b65 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -336,7 +336,7 @@ ClockDeleteCmdProc( /* *---------------------------------------------------------------------- */ -inline Tcl_Obj * +static inline Tcl_Obj * NormTimezoneObj( ClockClientData *dataPtr, /* Client data containing literal pool */ Tcl_Obj *timezoneObj) @@ -383,7 +383,7 @@ NormTimezoneObj( /* *---------------------------------------------------------------------- */ -inline Tcl_Obj * +static inline Tcl_Obj * ClockGetSystemLocale( ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp) /* Tcl interpreter */ @@ -397,7 +397,7 @@ ClockGetSystemLocale( /* *---------------------------------------------------------------------- */ -inline Tcl_Obj * +static inline Tcl_Obj * ClockGetCurrentLocale( ClockClientData *dataPtr, /* Client data containing literal pool */ Tcl_Interp *interp) /* Tcl interpreter */ @@ -782,7 +782,7 @@ ClockConfigureObjCmd( /* *---------------------------------------------------------------------- */ -inline Tcl_Obj* +static inline Tcl_Obj * ClockGetTZData( ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index a5ddd18..24c0f1d 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -41,7 +41,7 @@ CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); * Clock scan and format facilities. */ -inline int +static inline int _str2int( int *out, register @@ -71,7 +71,7 @@ _str2int( return TCL_OK; } -inline int +static inline int _str2wideInt( Tcl_WideInt *out, register @@ -101,7 +101,7 @@ _str2wideInt( return TCL_OK; } -inline char * +static inline char * _itoaw( char *buf, register int val, @@ -169,7 +169,7 @@ _itoaw( return buf + width; } -inline char * +static inline char * _witoaw( char *buf, register Tcl_WideInt val, @@ -268,7 +268,7 @@ static struct { unsigned int count; } ClockFmtScnStorage_GC = {NULL, NULL, 0}; -inline void +static inline void ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) { /* add new entry */ @@ -291,7 +291,7 @@ ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) ClockFmtScnStorageDelete(delEnt); } } -inline void +static inline void ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) { TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr); @@ -311,11 +311,11 @@ ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) static Tcl_HashTable FmtScnHashTable; static int initialized = 0; -inline Tcl_HashEntry * +static inline Tcl_HashEntry * HashEntry4FmtScn(ClockFmtScnStorage *fss) { return (Tcl_HashEntry*)(fss + 1); }; -inline ClockFmtScnStorage * +static inline ClockFmtScnStorage * FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) { return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage)); }; @@ -836,7 +836,7 @@ DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, *maxLenPtr = maxLen; } -inline int +static inline int ObjListSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, int *val, Tcl_Obj **lstv, int lstc, @@ -1015,7 +1015,7 @@ done: return idxTree; } -inline int +static inline int ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, TclStrIdxTree *idxTree, int *val, int minLen, int maxLen) @@ -1067,7 +1067,7 @@ StaticListSearch(ClockFmtScnCmdArgs *opts, } #endif -inline const char * +static inline const char * FindWordEnd( ClockScanToken *tok, register const char * p, const char * end) @@ -1152,17 +1152,17 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, /* %u %w %Ou %Ow */ if ( curTok != 'a' && curTok != 'A' - && ((minLen <= 1 && maxLen >= 1) || (int)tok->map->data) + && ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data)) ) { val = -1; - if (!(int)tok->map->data) { + if (PTR2INT(tok->map->data) == 0) { if (*yyInput >= '0' && *yyInput <= '9') { val = *yyInput - '0'; } } else { - idxTree = ClockMCGetListIdxTree(opts, (int)tok->map->data /* mcKey */); + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); if (idxTree == NULL) { return TCL_ERROR; } @@ -1293,7 +1293,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, /* get or create tree in msgcat dict */ - idxTree = ClockMCGetListIdxTree(opts, (int)tok->map->data /* mcKey */); + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); if (idxTree == NULL) { return TCL_ERROR; } @@ -1602,7 +1602,7 @@ static ClockScanTokenMap ScnWordTokenMap = { }; -inline unsigned int +static inline unsigned int EstimateTokenCount( register const char *fmt, register const char *end) @@ -2143,7 +2143,7 @@ done: return ret; } -inline int +static inline int FrmResultAllocate( register DateFormat *dateFmt, int len) @@ -2751,7 +2751,7 @@ ClockFormat( } } else { const char *s; - Tcl_Obj * mcObj = ClockMCGet(opts, (int)map->data /* mcKey */); + Tcl_Obj * mcObj = ClockMCGet(opts, PTR2INT(map->data) /* mcKey */); if (mcObj == NULL) { goto error; } diff --git a/generic/tclEnv.c b/generic/tclEnv.c index fd0a8ce..0041a40 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -18,8 +18,9 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ -MODULE_SCOPE unsigned long TclEnvEpoch = 0; /* Epoch of the tcl environment - * (if changed with tcl-env). */ +/* MODULE_SCOPE */ +unsigned long TclEnvEpoch = 0; /* Epoch of the tcl environment + * (if changed with tcl-env). */ static struct { int cacheSize; /* Number of env strings in cache. */ diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index b47b4b7..686c1e4 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -93,7 +93,7 @@ TclStrIdxTreeSearch( /* search in tree */ do { - cin = TclGetString(item->key) + offs; + cinf = cin = TclGetString(item->key) + offs; f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf); /* if something was found */ if (f > s) { -- cgit v0.12 From 45c23f525667f963acefc9114c79a9a28d5ab1a9 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 23:00:05 +0000 Subject: correct output of total resp. average values considering net execution time (overhead considered) --- tests-perf/clock.perf.tcl | 54 +++++++++++++++++++++++++++++------------------ 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 7b522d0..16664b2 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -46,48 +46,62 @@ proc _test_get_commands {lst} { proc _test_out_total {} { upvar _ _ - if {![llength $_(ittm)]} { + set tcnt [llength $_(itm)] + if {!$tcnt} { puts "" return } set mintm 0x7fffffff set maxtm 0 + set nett 0 + set wtm 0 + set wcnt 0 set i 0 - foreach tm $_(ittm) { + foreach tm $_(itm) { + if {[llength $tm] > 6} { + set nett [expr {$nett + [lindex $tm 6]}] + } + set wtm [expr {$wtm + [lindex $tm 0]}] + set wcnt [expr {$wcnt + [lindex $tm 2]}] + set tm [lindex $tm 0] if {$tm > $maxtm} {set maxtm $tm; set maxi $i} if {$tm < $mintm} {set mintm $tm; set mini $i} incr i } puts [string repeat ** 40] - puts [format "Total %d cases in %.2f sec.:" [llength $_(itcnt)] [expr {[llength $_(itcnt)] * $_(reptime) / 1000.0}]] - lset _(m) 0 [format %.6f [expr [join $_(ittm) +]]] - lset _(m) 2 [expr [join $_(itcnt) +]] - lset _(m) 4 [format %.3f [expr {[lindex $_(m) 2] / ([llength $_(itcnt)] * $_(reptime) / 1000.0)}]] + set s [format "%d cases in %.2f sec." $tcnt [expr {$tcnt * $_(reptime) / 1000.0}]] + if {$nett > 0} { + append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]] + } + puts "Total $s:" + lset _(m) 0 [format %.6f $wtm] + lset _(m) 2 $wcnt + lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f $nett] + } puts $_(m) puts "Average:" - lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / [llength $_(itcnt)]}]] - lset _(m) 2 [expr {[lindex $_(m) 2] / [llength $_(itcnt)]}] - lset _(m) 4 [expr {[lindex $_(m) 2] * (1000 / $_(reptime))}] + lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]] + lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]] + lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]] + } puts $_(m) puts "Min:" - lset _(m) 0 [lindex $_(ittm) $mini] - lset _(m) 2 [lindex $_(itcnt) $mini] - lset _(m) 2 [lindex $_(itrate) $mini] - puts $_(m) + puts [lindex $_(itm) $mini] puts "Max:" - lset _(m) 0 [lindex $_(ittm) $maxi] - lset _(m) 2 [lindex $_(itcnt) $maxi] - lset _(m) 2 [lindex $_(itrate) $maxi] - puts $_(m) + puts [lindex $_(itm) $maxi] puts [string repeat ** 40] puts "" } proc _test_run {reptime lst {outcmd {puts $_(r)}}} { upvar _ _ - array set _ [list ittm {} itcnt {} itrate {} reptime $reptime] + array set _ [list itm {} reptime $reptime] foreach _(c) [_test_get_commands $lst] { puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" @@ -99,9 +113,7 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} { set _(r) [if 1 $_(c)] if {$outcmd ne {}} $outcmd puts [set _(m) [timerate $_(c) $reptime]] - lappend _(ittm) [lindex $_(m) 0] - lappend _(itcnt) [lindex $_(m) 2] - lappend _(itrate) [lindex $_(m) 4] + lappend _(itm) $_(m) puts "" } _test_out_total -- cgit v0.12 From a46b1f79d3095b4e867148fee2cb94dfe84fab44 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 23:01:23 +0000 Subject: code review and inline documentation --- generic/tclClock.c | 262 +++++++++++++++++++++++++++++++++++++++++++++--- generic/tclClockFmt.c | 3 + generic/tclDate.h | 7 -- generic/tclDictObj.c | 32 +++++- generic/tclInt.h | 7 ++ generic/tclStrIdxTree.c | 3 +- 6 files changed, 288 insertions(+), 26 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a324b65..fc7c70c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -167,7 +167,6 @@ static const struct ClockCommand clockCommands[] = { { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, { "ParseFormatArgs", ClockParseformatargsObjCmd }, - { "_test", TclStrIdxTreeTestObjCmd }, { NULL, NULL } }; @@ -262,10 +261,11 @@ TclClockInit( /* *---------------------------------------------------------------------- * - * ClockDeleteCmdProc -- + * ClockConfigureClear -- * - * Remove a reference to the clock client data, and clean up memory - * when it's all gone. + * Clean up cached resp. run-time storages used in clock commands. + * + * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear". * * Results: * None. @@ -301,7 +301,20 @@ ClockConfigureClear( Tcl_UnsetObjRef(data->UTC2Local.tzName); Tcl_UnsetObjRef(data->Local2UTC.timezoneObj); } - + +/* + *---------------------------------------------------------------------- + * + * 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 */ @@ -335,7 +348,20 @@ ClockDeleteCmdProc( /* *---------------------------------------------------------------------- + * + * NormTimezoneObj -- + * + * Normalizes the timezone object (used for caching puposes). + * + * If already cached time zone could be found, returns this + * object (last setup or last used, system (current) or gmt). + * + * Results: + * Normalized tcl object pointer. + * + *---------------------------------------------------------------------- */ + static inline Tcl_Obj * NormTimezoneObj( ClockClientData *dataPtr, /* Client data containing literal pool */ @@ -411,9 +437,23 @@ ClockGetCurrentLocale( return dataPtr->CurrentLocale; } + /* *---------------------------------------------------------------------- + * + * NormLocaleObj -- + * + * Normalizes the locale object (used for caching puposes). + * + * If already cached locale could be found, returns this + * object (current, system (OS) or last used locales). + * + * Results: + * Normalized tcl object pointer. + * + *---------------------------------------------------------------------- */ + static Tcl_Obj * NormLocaleObj( ClockClientData *dataPtr, /* Client data containing literal pool */ @@ -494,7 +534,21 @@ NormLocaleObj( /* *---------------------------------------------------------------------- + * + * ClockMCDict -- + * + * Retrieves a localized storage dictionary object for the given + * locale object. + * + * This corresponds with call `::tcl::clock::mcget locale`. + * Cached representation stored in options (for further access). + * + * Results: + * Tcl-object contains smart reference to msgcat dictionary. + * + *---------------------------------------------------------------------- */ + MODULE_SCOPE Tcl_Obj * ClockMCDict(ClockFmtScnCmdArgs *opts) { @@ -560,6 +614,21 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) return opts->mcDictObj; } +/* + *---------------------------------------------------------------------- + * + * ClockMCGet -- + * + * Retrieves a msgcat value for the given literal integer mcKey + * from localized storage (corresponding given locale object) + * by mcLiterals[mcKey] (e. g. MONTHS_FULL). + * + * Results: + * Tcl-object contains localized value. + * + *---------------------------------------------------------------------- + */ + MODULE_SCOPE Tcl_Obj * ClockMCGet( ClockFmtScnCmdArgs *opts, @@ -581,6 +650,21 @@ ClockMCGet( return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */ } +/* + *---------------------------------------------------------------------- + * + * ClockMCGetIdx -- + * + * Retrieves an indexed msgcat value for the given literal integer mcKey + * from localized storage (corresponding given locale object) + * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). + * + * Results: + * Tcl-object contains localized indexed value. + * + *---------------------------------------------------------------------- + */ + MODULE_SCOPE Tcl_Obj * ClockMCGetIdx( ClockFmtScnCmdArgs *opts, @@ -609,6 +693,21 @@ ClockMCGetIdx( return valObj; } + +/* + *---------------------------------------------------------------------- + * + * ClockMCSetIdx -- + * + * Sets an indexed msgcat value for the given literal integer mcKey + * in localized storage (corresponding given locale object) + * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). + * + * Results: + * Returns a standard Tcl result. + * + *---------------------------------------------------------------------- + */ MODULE_SCOPE int ClockMCSetIdx( @@ -639,7 +738,23 @@ ClockMCSetIdx( /* *---------------------------------------------------------------------- + * + * ClockConfigureObjCmd -- + * + * This function is invoked to process the Tcl "clock configure" command. + * + * Usage: + * ::tcl::clock::configure ?-option ?value?? + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- */ + static int ClockConfigureObjCmd( ClientData clientData, /* Client data containing literal pool */ @@ -781,7 +896,20 @@ ClockConfigureObjCmd( /* *---------------------------------------------------------------------- + * + * ClockGetTZData -- + * + * Retrieves tzdata table for given normalized timezone. + * + * Results: + * Returns a tcl object with tzdata. + * + * Side effects: + * The tzdata can be cached in ClockClientData structure. + * + *---------------------------------------------------------------------- */ + static inline Tcl_Obj * ClockGetTZData( ClientData clientData, /* Opaque pointer to literal pool, etc. */ @@ -839,9 +967,20 @@ ClockGetTZData( } return ret; } + /* *---------------------------------------------------------------------- + * + * ClockGetSystemTimeZone -- + * + * Returns system (current) timezone. + * + * Results: + * Returns normalized timezone object. + * + *---------------------------------------------------------------------- */ + static Tcl_Obj * ClockGetSystemTimeZone( ClientData clientData, /* Opaque pointer to literal pool, etc. */ @@ -869,9 +1008,20 @@ ClockGetSystemTimeZone( } return dataPtr->SystemTimeZone; } + /* *---------------------------------------------------------------------- + * + * ClockSetupTimeZone -- + * + * Sets up the timezone. Loads tzdata, etc. + * + * Results: + * Returns normalized timezone object. + * + *---------------------------------------------------------------------- */ + MODULE_SCOPE Tcl_Obj * ClockSetupTimeZone( ClientData clientData, /* Opaque pointer to literal pool, etc. */ @@ -908,20 +1058,22 @@ ClockSetupTimeZone( } return NULL; } + /* *---------------------------------------------------------------------- - * ClockFormatNumericTimeZone - * - * Formats a time zone as +hhmmss + * ClockFormatNumericTimeZone -- + * + * Formats a time zone as +hhmmss * * Parameters: - * z - Time zone in seconds east of Greenwich + * z - Time zone in seconds east of Greenwich * * Results: - * Returns the time zone object (formatted in a numeric form) + * Returns the time zone object (formatted in a numeric form) * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ @@ -943,6 +1095,7 @@ ClockFormatNumericTimeZone(int z) { } return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); } + /* *---------------------------------------------------------------------- * @@ -1145,7 +1298,20 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- + * + * ClockGetDateFields -- + * + * Converts given UTC time (seconds in a TclDateFields structure) + * to local time and determines the values that clock routines will + * use in scanning or formatting a date. + * + * Results: + * Date-time values are stored in structure "fields". + * Returns a standard Tcl result. + * + *---------------------------------------------------------------------- */ + int ClockGetDateFields( ClientData clientData, /* Client data of the interpreter */ @@ -1586,6 +1752,7 @@ ConvertLocalToUTCUsingTable( fields->seconds = fields->localSeconds - fields->tzOffset; #if 0 + /* currently unused, test purposes only */ /* * Convert back from UTC, if local times are different - wrong local time * (local time seems to be in between DST-hole). @@ -2404,9 +2571,24 @@ GetJulianDayFromEraYearMonthDay( + ym1o4; } } + /* *---------------------------------------------------------------------- + * + * GetJulianDayFromEraYearDay -- + * + * Given era, year, and dayOfYear (in TclDateFields), and the + * Gregorian transition date, computes the Julian Day Number. + * + * Results: + * None. + * + * Side effects: + * Stores day number in 'julianDay' + * + *---------------------------------------------------------------------- */ + MODULE_SCOPE void GetJulianDayFromEraYearDay( @@ -2740,6 +2922,19 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +/* + *----------------------------------------------------------------------------- + * + * _ClockParseFmtScnArgs -- + * + * Parses the arguments for [clock scan] and [clock format]. + * + * Results: + * Returns a standard Tcl result, and stores parsed options + * (format, the locale, timezone and base) in structure "opts". + * + *----------------------------------------------------------------------------- + */ static int _ClockParseFmtScnArgs( @@ -2853,9 +3048,7 @@ _ClockParseFmtScnArgs( * Returns a standard Tcl result, whose value is a four-element list * comprising the time format, the locale, and the timezone. * - * This function exists because the loop that parses the [clock format] - * options is a known performance "hot spot", and is implemented in an effort - * to speed that particular code up. + * This function exists for backward compatibility purposes. * *----------------------------------------------------------------------------- */ @@ -2919,7 +3112,20 @@ ClockParseformatargsObjCmd( /*---------------------------------------------------------------------- * - * ClockFormatObjCmd - + * ClockFormatObjCmd -- , clock format -- + * + * This function is invoked to process the Tcl "clock format" command. + * + * Formats a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock format' command formats times of day for output. Refer + * to the user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. * *---------------------------------------------------------------------- */ @@ -3018,7 +3224,20 @@ done: /*---------------------------------------------------------------------- * - * ClockScanObjCmd - + * ClockScanObjCmd -- , clock scan -- + * + * This function is invoked to process the Tcl "clock scan" command. + * + * Inputs a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock scan' command scans times of day on input. Refer to the + * user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. * *---------------------------------------------------------------------- */ @@ -3188,7 +3407,20 @@ done: } /*---------------------------------------------------------------------- + * + * ClockFreeScan -- + * + * Used by ClockScanObjCmd for free scanning without format. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- */ + int ClockFreeScan( ClientData clientData, /* Client data containing literal pool */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 24c0f1d..ff16714 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -881,6 +881,7 @@ ObjListSearch(ClockFmtScnCmdArgs *opts, return TCL_RETURN; } #if 0 +/* currently unused */ static int LocaleListSearch(ClockFmtScnCmdArgs *opts, @@ -1042,6 +1043,7 @@ ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, return TCL_OK; } #if 0 +/* currently unused */ static int StaticListSearch(ClockFmtScnCmdArgs *opts, @@ -1093,6 +1095,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { #if 0 +/* currently unused, test purposes only */ static const char * months[] = { /* full */ "January", "February", "March", diff --git a/generic/tclDate.h b/generic/tclDate.h index cf307a6..1519842 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -509,11 +509,4 @@ MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt, MODULE_SCOPE void ClockFrmScnClearCaches(void); -/* - * Other externals. - */ - -MODULE_SCOPE unsigned long TclEnvEpoch; /* Epoch of the tcl environment - * (if changed with tcl-env). */ - #endif /* _TCLCLOCK_H */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index caebbf1..b786c4f 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -1960,6 +1960,32 @@ DictSizeCmd( /* *---------------------------------------------------------------------- + * + * Tcl_DictObjSmartRef -- + * + * This function returns new tcl-object with the smart reference to + * dictionary object. + * + * Object returned with this function is a smart reference (pointer), + * so new object of type tclDictType, that directly references given + * dictionary object (with internally increased refCount). + * + * The usage of such pointer objects allows to hold more as one + * reference to the same real dictionary object, allows to make a pointer + * to part of another dictionary, allows to change the dictionary without + * regarding of the "shared" state of the dictionary object. + * + * Prevents "called with shared object" exception if object is multiple + * referenced. + * + * Results: + * The newly create object (contains smart reference) is returned. + * The returned object has a ref count of 0. + * + * Side effects: + * Increases ref count of the referenced dictionary. + * + *---------------------------------------------------------------------- */ Tcl_Obj * @@ -1991,9 +2017,9 @@ Tcl_DictObjSmartRef( * * DictSmartRefCmd -- * - * This function implements the "dict smartref" Tcl command. See the user - * documentation for details on what it does, and TIP#111 for the formal - * specification. + * This function implements the "dict smartref" Tcl command. + * + * See description of Tcl_DictObjSmartRef for details. * * Results: * A standard Tcl result. diff --git a/generic/tclInt.h b/generic/tclInt.h index a569788..15cb355 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4886,6 +4886,13 @@ typedef struct NRE_callback { #define Tcl_Free(ptr) TclpFree(ptr) #endif +/* + * Other externals. + */ + +MODULE_SCOPE unsigned long TclEnvEpoch; /* Epoch of the tcl environment + * (if changed with tcl-env). */ + #endif /* _TCLINT */ /* diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 686c1e4..773eb6a 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -418,7 +418,8 @@ TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) { /* * Several debug primitives */ -#if 1 +#if 0 +/* currently unused, debug resp. test purposes only */ void TclStrIdxTreePrint( -- cgit v0.12 From 77a54daa546c50756c2734f86b9e230f02bcc676 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 23:02:02 +0000 Subject: "clock add" rewritten in C, using common functionality of "clock scan" (and freescan)... test-performance.tcl: test cases extended to cover "clock add" --- generic/tclClock.c | 735 +++++++++++++++++++++++++++++++--------------- generic/tclDate.h | 2 +- library/clock.tcl | 328 --------------------- library/init.tcl | 2 +- tests-perf/clock.perf.tcl | 39 +++ tests/clock.test | 17 +- 6 files changed, 559 insertions(+), 564 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index fc7c70c..791898b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -116,9 +116,6 @@ static int ClockMicrosecondsObjCmd( static int ClockMillisecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockParseformatargsObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); static int ClockSecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -128,10 +125,17 @@ static int ClockFormatObjCmd( static int ClockScanObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int ClockScanCommit( + ClientData clientData, register DateInfo *info, + register ClockFmtScnCmdArgs *opts); static int ClockFreeScan( - ClientData clientData, Tcl_Interp *interp, register DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); +static int ClockCalcRelTime( + register DateInfo *info, ClockFmtScnCmdArgs *opts); +static int ClockAddObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static struct tm * ThreadSafeLocalTime(const time_t *); static unsigned long TzsetGetEpoch(void); static void TzsetIfNecessary(void); @@ -151,6 +155,7 @@ struct ClockCommand { }; static const struct ClockCommand clockCommands[] = { + { "add", ClockAddObjCmd }, { "clicks", ClockClicksObjCmd }, { "getenv", ClockGetenvObjCmd }, { "microseconds", ClockMicrosecondsObjCmd }, @@ -166,7 +171,6 @@ static const struct ClockCommand clockCommands[] = { ClockGetjuliandayfromerayearmonthdayObjCmd }, { "GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd }, - { "ParseFormatArgs", ClockParseformatargsObjCmd }, { NULL, NULL } }; @@ -763,7 +767,6 @@ ClockConfigureObjCmd( Tcl_Obj *const objv[]) /* Parameter vector */ { ClockClientData *dataPtr = clientData; - Tcl_Obj **litPtr = dataPtr->literals; static const char *const options[] = { "-system-tz", "-setup-tz", "-default-locale", @@ -814,7 +817,7 @@ ClockConfigureObjCmd( Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj); Tcl_UnsetObjRef(dataPtr->LastSetupTZData); } - if (timezoneObj == litPtr[LIT_GMT]) { + if (timezoneObj == dataPtr->literals[LIT_GMT]) { optionIndex = CLOCK_SETUP_GMT; } else if (timezoneObj == dataPtr->SystemTimeZone) { optionIndex = CLOCK_SETUP_NOP; @@ -1158,7 +1161,7 @@ ClockConvertlocaltoutcObjCmd( "found in dictionary", -1)); return TCL_ERROR; } - if ((Tcl_GetWideIntFromObj(interp, secondsObj, + if ((TclGetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) { @@ -1238,7 +1241,7 @@ ClockGetdatefieldsObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover"); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK + if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) { return TCL_ERROR; } @@ -1762,7 +1765,7 @@ ConvertLocalToUTCUsingTable( int corrOffset; Tcl_WideInt backCompVal; /* check DST-hole interval contains UTC time */ - Tcl_GetWideIntFromObj(NULL, cellv[0], &backCompVal); + TclGetWideIntFromObj(NULL, cellv[0], &backCompVal); if ( fields->seconds >= backCompVal - fields->tzOffset && fields->seconds <= backCompVal + fields->tzOffset ) { @@ -2148,7 +2151,7 @@ LookupLastTransition( */ if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK - || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } @@ -2170,7 +2173,7 @@ LookupLastTransition( int m = (l + u + 1) / 2; if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK || - Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { + TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { return NULL; } if (tick >= compVal) { @@ -2922,10 +2925,21 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +static inline void +ClockInitFmtScnArgs( + ClientData clientData, + Tcl_Interp *interp, + ClockFmtScnCmdArgs *opts) +{ + memset(opts, 0, sizeof(*opts)); + opts->clientData = clientData; + opts->interp = interp; +} + /* *----------------------------------------------------------------------------- * - * _ClockParseFmtScnArgs -- + * ClockParseFmtScnArgs -- * * Parses the arguments for [clock scan] and [clock format]. * @@ -2936,92 +2950,116 @@ ClockMicrosecondsObjCmd( *----------------------------------------------------------------------------- */ +#define CLC_FMT_ARGS (0) +#define CLC_SCN_ARGS (1 << 0) +#define CLC_ADD_ARGS (1 << 1) + static int -_ClockParseFmtScnArgs( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ +ClockParseFmtScnArgs( + register + ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ + TclDateFields *date, /* Extracted date-time corresponding base + * (by scan or add) resp. clockval (by format) */ int objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ - ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ - int forScan /* Flag to differentiate between format and scan */ + int flags /* Flags, differentiates between format, scan, add */ ) { - ClockClientData *dataPtr = clientData; - Tcl_Obj **litPtr = dataPtr->literals; + Tcl_Interp *interp = opts->interp; + ClockClientData *dataPtr = opts->clientData; int gmtFlag = 0; - static const char *const options[2][6] = { - { /* Format command line options */ - "-format", "-gmt", "-locale", - "-timezone", NULL }, - { /* Scan command line options */ + static const char *const options[] = { "-format", "-gmt", "-locale", - "-timezone", "-base", NULL } + "-timezone", "-base", NULL }; enum optionInd { - CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, - CLOCK_FORMAT_TIMEZONE, CLOCK_FORMAT_BASE + CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE, + CLC_ARGS_TIMEZONE, CLC_ARGS_BASE }; int optionIndex; /* Index of an option. */ int saw = 0; /* Flag == 1 if option was seen already. */ int i; + Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ + + /* clock value (as current base) */ + if ( !(flags & (CLC_SCN_ARGS)) ) { + opts->baseObj = objv[1]; + saw |= (1 << CLC_ARGS_BASE); + } /* * Extract values for the keywords. */ - memset(opts, 0, sizeof(*opts)); for (i = 2; i < objc; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options[forScan], + /* bypass integers (offsets) by "clock add" */ + if (flags & CLC_ADD_ARGS) { + Tcl_WideInt num; + if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) { + continue; + } + } + /* get option */ + 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; + goto badOption; + } + /* if already specified */ + if (saw & (1 << optionIndex)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": doubly present", + TclGetString(objv[i])) + ); + goto badOption; } switch (optionIndex) { - case CLOCK_FORMAT_FORMAT: + case CLC_ARGS_FORMAT: + if (flags & CLC_ADD_ARGS) { + goto badOptionMsg; + } opts->formatObj = objv[i+1]; break; - case CLOCK_FORMAT_GMT: + case CLC_ARGS_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ return TCL_ERROR; } break; - case CLOCK_FORMAT_LOCALE: + case CLC_ARGS_LOCALE: opts->localeObj = objv[i+1]; break; - case CLOCK_FORMAT_TIMEZONE: + case CLC_ARGS_TIMEZONE: opts->timezoneObj = objv[i+1]; break; - case CLOCK_FORMAT_BASE: + case CLC_ARGS_BASE: + if ( !(flags & (CLC_SCN_ARGS)) ) { + goto badOptionMsg; + } opts->baseObj = objv[i+1]; break; } - saw |= 1 << optionIndex; + saw |= (1 << optionIndex); } /* * Check options. */ - if ((saw & (1 << CLOCK_FORMAT_GMT)) - && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { + if ((saw & (1 << CLC_ARGS_GMT)) + && (saw & (1 << CLC_ARGS_TIMEZONE))) { Tcl_SetResult(interp, "cannot use -gmt and -timezone in same call", TCL_STATIC); Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } if (gmtFlag) { - opts->timezoneObj = litPtr[LIT_GMT]; + opts->timezoneObj = dataPtr->literals[LIT_GMT]; } - opts->clientData = clientData; - opts->interp = interp; - /* If time zone not specified use system time zone */ if ( opts->timezoneObj == NULL || TclGetString(opts->timezoneObj) == NULL || opts->timezoneObj->length == 0 ) { - opts->timezoneObj = ClockGetSystemTimeZone(clientData, interp); + opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp); if (opts->timezoneObj == NULL) { return TCL_ERROR; } @@ -3029,85 +3067,90 @@ _ClockParseFmtScnArgs( /* Setup timezone (normalize object if needed and load TZ on demand) */ - opts->timezoneObj = ClockSetupTimeZone(clientData, interp, opts->timezoneObj); + opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj); if (opts->timezoneObj == NULL) { return TCL_ERROR; } - return TCL_OK; -} - -/* - *----------------------------------------------------------------------------- - * - * ClockParseformatargsObjCmd -- - * - * Parses the arguments for [clock format]. - * - * Results: - * Returns a standard Tcl result, whose value is a four-element list - * comprising the time format, the locale, and the timezone. - * - * This function exists for backward compatibility purposes. - * - *----------------------------------------------------------------------------- - */ + /* Base (by scan or add) or clock value (by format) */ -static int -ClockParseformatargsObjCmd( - 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 **literals = dataPtr->literals; - ClockFmtScnCmdArgs opts; /* Format, locale and timezone */ - Tcl_WideInt clockVal; /* Clock value - just used to parse. */ - int ret; + if (opts->baseObj != NULL) { + if (TclGetWideIntFromObj(NULL, opts->baseObj, &baseVal) != TCL_OK) { - /* - * Args consist of a time followed by keyword-value pairs. - */ + /* we accept "-now" as current date-time */ + const char *const nowOpts[] = { + "-now", NULL + }; + int idx; + if (Tcl_GetIndexFromObj(NULL, opts->baseObj, nowOpts, "seconds or -now", + TCL_EXACT, &idx) == TCL_OK + ) { + goto baseNow; + } - if (objc < 2 || (objc % 2) != 0) { - Tcl_WrongNumArgs(interp, 0, objv, - "clock format clockval ?-format string? " - "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); - return TCL_ERROR; - } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(opts->baseObj))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + i = 1; + goto badOption; + } + /* + * seconds could be an unsigned number that overflowed. Make sure + * that it isn't. + */ - /* - * Extract values for the keywords. - */ + if (opts->baseObj->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + return TCL_ERROR; + } - ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, - &opts, 0); - if (ret != TCL_OK) { - return ret; + } else { + +baseNow: + { + Tcl_Time now; + Tcl_GetTime(&now); + baseVal = (Tcl_WideInt) now.sec; + } } /* - * Check options. + * Extract year, month and day from the base time for the parser to use as + * defaults */ - if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { - return TCL_ERROR; + /* check base fields already cached (by TZ, last-second cache) */ + if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj + && dataPtr->lastBase.Date.seconds == baseVal) { + memcpy(date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); + } else { + /* extact fields from base */ + date->seconds = baseVal; + if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ + return TCL_ERROR; + } + /* cache last base */ + memcpy(&dataPtr->lastBase.Date, date, ClockCacheableDateFieldsSize); + Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); } - if (opts.formatObj == NULL) - opts.formatObj = literals[LIT__DEFAULT_FORMAT]; - if (opts.localeObj == NULL) - opts.localeObj = literals[LIT_C]; - if (opts.timezoneObj == NULL) - opts.timezoneObj = literals[LIT__NIL]; - /* - * Return options as a list. - */ - - Tcl_SetObjResult(interp, Tcl_NewListObj(3, (Tcl_Obj**)&opts.formatObj)); return TCL_OK; + +badOptionMsg: + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": unexpected for command \"%s\"", + TclGetString(objv[i]), TclGetString(objv[0])) + ); + +badOption: + + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); + + return TCL_ERROR; } /*---------------------------------------------------------------------- @@ -3141,11 +3184,11 @@ ClockFormatObjCmd( int ret; ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - Tcl_WideInt clockVal; /* Time, expressed in seconds from the Epoch */ DateFormat dateFmt; /* Common structure used for formatting */ + /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, "clockval " + Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now " "?-format string? " "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"); @@ -3153,53 +3196,17 @@ ClockFormatObjCmd( return TCL_ERROR; } - /* - * Extract values for the keywords. - */ - - ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, - &opts, 0); - if (ret != TCL_OK) { - return ret; - } - - ret = TCL_ERROR; - - if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { - return TCL_ERROR; - } - - /* - * seconds could be an unsigned number that overflowed. Make sure - * that it isn't. - */ - - if (objv[1]->typePtr == &tclBignumType) { - Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); - return TCL_ERROR; - } - memset(&dateFmt, 0, sizeof(dateFmt)); /* - * Extract year, month and day from the base time for the parser to use as - * defaults + * Extract values for the keywords. */ - /* check base fields already cached (by TZ, last-second cache) */ - if ( dataPtr->lastBase.timezoneObj == opts.timezoneObj - && dataPtr->lastBase.Date.seconds == clockVal) { - memcpy(&dateFmt.date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); - } else { - /* extact fields from base */ - dateFmt.date.seconds = clockVal; - if (ClockGetDateFields(clientData, interp, &dateFmt.date, opts.timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { - goto done; - } - /* cache last base */ - memcpy(&dataPtr->lastBase.Date, &dateFmt.date, ClockCacheableDateFieldsSize); - Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts.timezoneObj); + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv, + CLC_FMT_ARGS); + if (ret != TCL_OK) { + goto done; } /* Default format */ @@ -3249,14 +3256,12 @@ ClockScanObjCmd( int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter values */ { - ClockClientData *dataPtr = clientData; - int ret; ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ - Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ DateInfo yy; /* Common structure used for parsing */ DateInfo *info = &yy; + /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, "string " "?-base seconds? " @@ -3267,59 +3272,17 @@ ClockScanObjCmd( return TCL_ERROR; } + ClockInitDateInfo(&yy); + /* * Extract values for the keywords. */ - ret = _ClockParseFmtScnArgs(clientData, interp, objc, objv, - &opts, 1); + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, + CLC_SCN_ARGS); if (ret != TCL_OK) { - return ret; - } - - ret = TCL_ERROR; - - if (opts.baseObj != NULL) { - if (Tcl_GetWideIntFromObj(interp, opts.baseObj, &baseVal) != TCL_OK) { - return TCL_ERROR; - } - /* - * seconds could be an unsigned number that overflowed. Make sure - * that it isn't. - */ - - if (opts.baseObj->typePtr == &tclBignumType) { - Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); - return TCL_ERROR; - } - - } else { - Tcl_Time now; - Tcl_GetTime(&now); - baseVal = (Tcl_WideInt) now.sec; - } - - ClockInitDateInfo(info); - - /* - * Extract year, month and day from the base time for the parser to use as - * defaults - */ - - /* check base fields already cached (by TZ, last-second cache) */ - if ( dataPtr->lastBase.timezoneObj == opts.timezoneObj - && dataPtr->lastBase.Date.seconds == baseVal) { - memcpy(&yydate, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize); - } else { - /* extact fields from base */ - yydate.seconds = baseVal; - if (ClockGetDateFields(clientData, interp, &yydate, opts.timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { - goto done; - } - /* cache last base */ - memcpy(&dataPtr->lastBase.Date, &yydate, ClockCacheableDateFieldsSize); - Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts.timezoneObj); + goto done; } /* seconds are in localSeconds (relative base date), so reset time here */ @@ -3336,18 +3299,54 @@ ClockScanObjCmd( Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); return TCL_ERROR; } - ret = ClockFreeScan(clientData, interp, info, objv[1], &opts); + ret = ClockFreeScan(&yy, objv[1], &opts); } else { /* Use compiled version of Scan - */ - ret = ClockScan(info, objv[1], &opts); + ret = ClockScan(&yy, objv[1], &opts); + } + + /* Convert date info structure into UTC seconds */ + + if (ret == TCL_OK) { + ret = ClockScanCommit(clientData, &yy, &opts); } +done: + + Tcl_UnsetObjRef(yy.date.tzName); + if (ret != TCL_OK) { - goto done; + return ret; } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockScanCommit -- + * + * Converts date info structure into UTC seconds. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ClockScanCommit( + ClientData clientData, /* Client data containing literal pool */ + register DateInfo *info, /* Clock scan info structure */ + register + ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */ +{ /* If needed assemble julianDay using year, month, etc. */ if (info->flags & CLF_ASSEMBLE_JULIANDAY) { if ((info->flags & CLF_ISO8601)) { @@ -3362,13 +3361,12 @@ ClockScanObjCmd( } /* some overflow checks, if not extended */ - if (!(opts.flags & CLF_EXTENDED)) { + if (!(opts->flags & CLF_EXTENDED)) { if (yydate.julianDay > 5373484) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( "requested date too large to represent", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "dateTooLarge", NULL); - ret = TCL_ERROR; - goto done; + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + return TCL_ERROR; } } @@ -3382,9 +3380,9 @@ ClockScanObjCmd( } if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) { - if (ConvertLocalToUTC(clientData, interp, &yydate, opts.timezoneObj, + if (ConvertLocalToUTC(clientData, opts->interp, &yydate, opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) { - goto done; + return TCL_ERROR; } } @@ -3392,17 +3390,6 @@ ClockScanObjCmd( yydate.seconds += yyRelSeconds; - ret = TCL_OK; - -done: - - Tcl_UnsetObjRef(yydate.tzName); - - if (ret != TCL_OK) { - return ret; - } - - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yydate.seconds)); return TCL_OK; } @@ -3423,8 +3410,6 @@ done: int ClockFreeScan( - ClientData clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ register DateInfo *info, /* Date fields used for parsing & converting * simultaneously a yy-parse structure of the @@ -3432,7 +3417,8 @@ ClockFreeScan( Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = clientData; + Tcl_Interp *interp = opts->interp; + ClockClientData *dataPtr = opts->clientData; int ret = TCL_ERROR; @@ -3487,7 +3473,7 @@ ClockFreeScan( 60 * minEast + 3600 * dstFlag); Tcl_IncrRefCount(tzObjStor); - opts->timezoneObj = ClockSetupTimeZone(clientData, interp, tzObjStor); + opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor); Tcl_DecrRefCount(tzObjStor); if (opts->timezoneObj == NULL) { @@ -3531,6 +3517,39 @@ ClockFreeScan( * Do relative times */ + ret = ClockCalcRelTime(info, opts); + + /* Free scanning completed - date ready */ + +done: + + return ret; +} + +/*---------------------------------------------------------------------- + * + * ClockCalcRelTime -- + * + * Used for calculating of relative times. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +ClockCalcRelTime( + register + DateInfo *info, /* Date fields used for converting */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + /* + * Because some calculations require in-between conversion of the + * julian day, we can repeat this processing multiple times + */ repeat_rel: if (yyHaveRel) { @@ -3667,13 +3686,267 @@ repeat_rel: info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; } - /* Free scanning completed - date ready */ + return TCL_OK; +} + + +/*---------------------------------------------------------------------- + * + * ClockWeekdaysOffs -- + * + * Get offset in days for the number of week days corresponding the + * given day of week (skipping Saturdays and Sundays). + * + * + * Results: + * Returns a day increment adjusted the given weekdays + * + *---------------------------------------------------------------------- + */ + +static inline int +ClockWeekdaysOffs( + register int dayOfWeek, + register int offs) +{ + register int weeks, resDayOfWeek; + + /* offset in days */ + weeks = offs / 5; + offs = offs % 5; + /* compiler fix for negative offs - wrap (0, -1) -> (-1, 4) */ + if (offs < 0) { + weeks--; + offs = 5 + offs; + } + offs += 7 * weeks; + + /* resulting day of week */ + { + register int day = (offs % 7); + /* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */ + if (day < 0) { + day = 7 + day; + } + resDayOfWeek = dayOfWeek + day; + } + + /* adjust if we start from a weekend */ + if (dayOfWeek > 5) { + int adj = 5 - dayOfWeek; + offs += adj; + resDayOfWeek += adj; + } + + /* adjust if we end up on a weekend */ + if (resDayOfWeek > 5) { + offs += 2; + } + + return offs; +} + + + +/*---------------------------------------------------------------------- + * + * ClockAddObjCmd -- , clock add -- + * + * Adds an offset to a given time. + * + * Refer to the user documentation to see what it exactly does. + * + * Syntax: + * clock add clockval ?count unit?... ?-option value? + * + * Parameters: + * clockval -- Starting time value + * count -- Amount of a unit of time to add + * unit -- Unit of time to add, must be one of: + * years year months month weeks week + * days day hours hour minutes minute + * seconds second + * + * Options: + * -gmt BOOLEAN + * Flag synonymous with '-timezone :GMT' + * -timezone ZONE + * Name of the time zone in which calculations are to be done. + * -locale NAME + * Name of the locale in which calculations are to be done. + * Used to determine the Gregorian change date. + * + * Results: + * Returns a standard Tcl result with the given time adjusted + * by the given offset(s) in order. + * + * Notes: + * It is possible that adding a number of months or years will adjust the + * day of the month as well. For instance, the time at one month after + * 31 January is either 28 or 29 February, because February has fewer + * than 31 days. + * + *---------------------------------------------------------------------- + */ + +int +ClockAddObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = clientData; + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + /* add "week" to units also (because otherwise ambiguous) */ + static const char *const units[] = { + "years", "months", "week", "weeks", + "days", "weekdays", + "hours", "minutes", "seconds", + NULL + }; + enum unitInd { + CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, + CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, + CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS + }; + int unitIndex; /* Index of an option. */ + int i; + Tcl_WideInt offs; - ret = TCL_OK; + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now ?number units?..." + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + ClockInitDateInfo(&yy); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, + CLC_ADD_ARGS); + if (ret != TCL_OK) { + goto done; + } + + /* time together as seconds of the day */ + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + /* seconds are in localSeconds (relative base date), so reset time here */ + yyHour = 0; yyMinutes = 0; yyMeridian = MER24; + + ret = TCL_ERROR; + + /* + * Find each offset and process date increment + */ + + for (i = 2; i < objc; i+=2) { + /* bypass not integers (options, allready processed above) */ + if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) { + continue; + } + if (objv[i]->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + goto done; + } + /* get unit */ + if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, + &unitIndex) != TCL_OK) { + goto done; + } + + /* nothing to do if zero quantity */ + if (!offs) { + continue; + } + + /* if in-between conversion needed (already have relative date/time), + * correct date info, because the date may be changed, + * so refresh it now */ + + if ( yyHaveRel + && ( unitIndex == CLC_ADD_WEEKDAYS + /* some months can be shorter as another */ + || yyRelMonth || yyRelDay + /* day changed */ + || yySeconds + yyRelSeconds > SECONDS_PER_DAY + || yySeconds + yyRelSeconds < 0 + ) + ) { + if (ClockCalcRelTime(info, &opts) != TCL_OK) { + goto done; + } + } + + /* process increment by offset + unit */ + yyHaveRel++; + switch (unitIndex) { + case CLC_ADD_YEARS: + yyRelMonth += offs * 12; + break; + case CLC_ADD_MONTHS: + yyRelMonth += offs; + break; + case CLC_ADD_WEEK: + case CLC_ADD_WEEKS: + yyRelDay += offs * 7; + break; + case CLC_ADD_DAYS: + yyRelDay += offs; + break; + case CLC_ADD_WEEKDAYS: + /* add number of week days (skipping Saturdays and Sundays) + * to a relative days value. */ + offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs); + yyRelDay += offs; + break; + case CLC_ADD_HOURS: + yyRelSeconds += offs * 60 * 60; + break; + case CLC_ADD_MINUTES: + yyRelSeconds += offs * 60; + break; + case CLC_ADD_SECONDS: + yyRelSeconds += offs; + break; + } + } + + /* + * Do relative times (if not yet already processed interim): + */ + + if (yyHaveRel) { + if (ClockCalcRelTime(info, &opts) != TCL_OK) { + goto done; + } + } + + /* Convert date info structure into UTC seconds */ + + ret = ClockScanCommit(clientData, &yy, &opts); done: - return ret; + Tcl_UnsetObjRef(yy.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); + return TCL_OK; } /*---------------------------------------------------------------------- diff --git a/generic/tclDate.h b/generic/tclDate.h index 1519842..e614f9d 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -264,7 +264,7 @@ typedef struct ClockFmtScnCmdArgs { Tcl_Obj *formatObj; /* Format */ Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ - Tcl_Obj *baseObj; /* Base (scan only) */ + Tcl_Obj *baseObj; /* Base (scan and add) or clockValue (format) */ int flags; /* Flags control scanning */ Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/ diff --git a/library/clock.tcl b/library/clock.tcl index 3caa270..ba4676b 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -1948,334 +1948,6 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } { #---------------------------------------------------------------------- # -# clock add -- -# -# Adds an offset to a given time. -# -# Syntax: -# clock add clockval ?count unit?... ?-option value? -# -# Parameters: -# clockval -- Starting time value -# count -- Amount of a unit of time to add -# unit -- Unit of time to add, must be one of: -# years year months month weeks week -# days day hours hour minutes minute -# seconds second -# -# Options: -# -gmt BOOLEAN -# (Deprecated) Flag synonymous with '-timezone :GMT' -# -timezone ZONE -# Name of the time zone in which calculations are to be done. -# -locale NAME -# Name of the locale in which calculations are to be done. -# Used to determine the Gregorian change date. -# -# Results: -# Returns the given time adjusted by the given offset(s) in -# order. -# -# Notes: -# It is possible that adding a number of months or years will adjust the -# day of the month as well. For instance, the time at one month after -# 31 January is either 28 or 29 February, because February has fewer -# than 31 days. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::add { clockval args } { - if { [llength $args] % 2 != 0 } { - set cmdName "clock add" - return -code error \ - -errorcode [list CLOCK wrongNumArgs] \ - "wrong \# args: should be\ - \"$cmdName clockval ?number units?...\ - ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\"" - } - if { [catch { expr {wide($clockval)} } result] } { - return -code error "expected integer but got \"$clockval\"" - } - - set offsets {} - set gmt 0 - set locale c - if {[set timezone [configure -system-tz]] eq ""} { - set timezone [GetSystemTimeZone] - } - - foreach { a b } $args { - if { [string is integer -strict $a] } { - lappend offsets $a $b - } else { - switch -exact -- $a { - -g - -gm - -gmt { - set gmt $b - } - -l - -lo - -loc - -loca - -local - -locale { - set locale [string tolower $b] - } - -t - -ti - -tim - -time - -timez - -timezo - -timezon - - -timezone { - set timezone $b - } - default { - throw [list CLOCK badOption $a] \ - "bad option \"$a\",\ - must be -gmt, -locale or -timezone" - } - } - } - } - - # Check options for validity - - if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } { - return -code error \ - -errorcode [list CLOCK gmtWithTimezone] \ - "cannot use -gmt and -timezone in same call" - } - if { ![string is boolean -strict $gmt] } { - return -code error "expected boolean value but got \"$gmt\"" - } elseif { $gmt } { - set timezone :GMT - } - - EnterLocale $locale - - set changeover [mc GREGORIAN_CHANGE_DATE] - - if {[catch {set timezone [SetupTimeZone $timezone]} retval opts]} { - dict unset opts -errorinfo - return -options $opts $retval - } - - try { - foreach { quantity unit } $offsets { - switch -exact -- $unit { - years - year { - set clockval [AddMonths [expr { 12 * $quantity }] \ - $clockval $timezone $changeover] - } - months - month { - set clockval [AddMonths $quantity $clockval $timezone \ - $changeover] - } - - weeks - week { - set clockval [AddDays [expr { 7 * $quantity }] \ - $clockval $timezone $changeover] - } - days - day { - set clockval [AddDays $quantity $clockval $timezone \ - $changeover] - } - - weekdays - weekday { - set clockval [AddWeekDays $quantity $clockval $timezone \ - $changeover] - } - - hours - hour { - set clockval [expr { 3600 * $quantity + $clockval }] - } - minutes - minute { - set clockval [expr { 60 * $quantity + $clockval }] - } - seconds - second { - set clockval [expr { $quantity + $clockval }] - } - - default { - throw [list CLOCK badUnit $unit] \ - "unknown unit \"$unit\", must be \ - years, months, weeks, days, hours, minutes or seconds" - } - } - } - return $clockval - } trap CLOCK {result opts} { - # Conceal the innards of [clock] when it's an expected error - dict unset opts -errorinfo - return -options $opts $result - } -} - -#---------------------------------------------------------------------- -# -# AddMonths -- -# -# Add a given number of months to a given clock value in a given -# time zone. -# -# Parameters: -# months - Number of months to add (may be negative) -# clockval - Seconds since the epoch before the operation -# timezone - Time zone in which the operation is to be performed -# -# Results: -# Returns the new clock value as a number of seconds since -# the epoch. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AddMonths { months clockval timezone changeover } { - variable DaysInRomanMonthInCommonYear - variable DaysInRomanMonthInLeapYear - variable TZData - - # Convert the time to year, month, day, and fraction of day. - - set date [GetDateFields $clockval $timezone $changeover] - dict set date secondOfDay [expr { - [dict get $date localSeconds] % 86400 - }] - dict set date tzName $timezone - - # Add the requisite number of months - - set m [dict get $date month] - incr m $months - incr m -1 - set delta [expr { $m / 12 }] - set mm [expr { $m % 12 }] - dict set date month [expr { $mm + 1 }] - dict incr date year $delta - - # If the date doesn't exist in the current month, repair it - - if { [IsGregorianLeapYear $date] } { - set hath [lindex $DaysInRomanMonthInLeapYear $mm] - } else { - set hath [lindex $DaysInRomanMonthInCommonYear $mm] - } - if { [dict get $date dayOfMonth] > $hath } { - dict set date dayOfMonth $hath - } - - # Reconvert to a number of seconds - - set date [GetJulianDayFromEraYearMonthDay \ - $date[set date {}]\ - $changeover] - dict set date localSeconds [expr { - -210866803200 - + ( 86400 * wide([dict get $date julianDay]) ) - + [dict get $date secondOfDay] - }] - set date [ConvertLocalToUTC $date[set date {}] $timezone \ - $changeover] - - return [dict get $date seconds] - -} - -#---------------------------------------------------------------------- -# -# AddWeekDays -- -# -# Add a given number of week days (skipping Saturdays and Sundays) -# to a given clock value in a given time zone. -# -# Parameters: -# days - Number of days to add (may be negative) -# clockval - Seconds since the epoch before the operation -# timezone - Time zone in which the operation is to be performed -# changeover - Julian Day on which the Gregorian calendar was adopted -# in the target locale. -# -# Results: -# Returns the new clock value as a number of seconds since the epoch. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AddWeekDays { days clockval timezone changeover } { - - if {$days == 0} { - return $clockval - } - - set day [format $clockval -format %u] - - set weeks [expr {$days / 5}] - set rdays [expr {$days % 5}] - set toAdd [expr {7 * $weeks + $rdays}] - set resDay [expr {$day + ($toAdd % 7)}] - - # Adjust if we start from a weekend - if {$day > 5} { - set adj [expr {5 - $day}] - incr toAdd $adj - incr resDay $adj - } - - # Adjust if we end up on a weekend - if {$resDay > 5} { - incr toAdd 2 - } - - AddDays $toAdd $clockval $timezone $changeover -} - -#---------------------------------------------------------------------- -# -# AddDays -- -# -# Add a given number of days to a given clock value in a given time -# zone. -# -# Parameters: -# days - Number of days to add (may be negative) -# clockval - Seconds since the epoch before the operation -# timezone - Time zone in which the operation is to be performed -# changeover - Julian Day on which the Gregorian calendar was adopted -# in the target locale. -# -# Results: -# Returns the new clock value as a number of seconds since the epoch. -# -# Side effects: -# None. -# -#---------------------------------------------------------------------- - -proc ::tcl::clock::AddDays { days clockval timezone changeover } { - variable TZData - - # Convert the time to Julian Day - - set date [GetDateFields $clockval $timezone $changeover] - dict set date secondOfDay [expr { - [dict get $date localSeconds] % 86400 - }] - dict set date tzName $timezone - - # Add the requisite number of days - - dict incr date julianDay $days - - # Reconvert to a number of seconds - - dict set date localSeconds [expr { - -210866803200 - + ( 86400 * wide([dict get $date julianDay]) ) - + [dict get $date secondOfDay] - }] - set date [ConvertLocalToUTC $date[set date {}] $timezone \ - $changeover] - - return [dict get $date seconds] - -} - -#---------------------------------------------------------------------- -# # ChangeCurrentLocale -- # # The global locale was changed within msgcat. diff --git a/library/init.tcl b/library/init.tcl index f1f1bb4..405a400 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 mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} { + foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} { 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 index 16664b2..733db1a 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -318,6 +318,44 @@ proc test-freescan {{reptime 1000}} { } {puts [clock format $_(r) -locale en]} } +proc test-add {{reptime 1000}} { + _test_run $reptime { + # Add : years + {clock add 1246379415 5 years -gmt 1} + # Add : months + {clock add 1246379415 18 months -gmt 1} + # Add : weeks + {clock add 1246379415 20 weeks -gmt 1} + # Add : days + {clock add 1246379415 385 days -gmt 1} + # Add : weekdays + {clock add 1246379415 3 weekdays -gmt 1} + + # Add : hours + {clock add 1246379415 5 hours -gmt 1} + # Add : minutes + {clock add 1246379415 55 minutes -gmt 1} + # Add : seconds + {clock add 1246379415 100 seconds -gmt 1} + + # Add : +/- in gmt + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1} + # Add : +/- in system timezone + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET} + + # Add : gmt + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1} + # Add : system timezone + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET} + + # Add : all in gmt + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1} + # Add : all in system timezone + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} + + } {puts [clock format $_(r) -locale en]} +} + proc test-other {{reptime 1000}} { _test_run $reptime { # Bad zone @@ -338,6 +376,7 @@ proc test {{reptime 1000}} { test-format $reptime test-scan $reptime test-freescan $reptime + test-add $reptime test-other $reptime puts \n**OK** diff --git a/tests/clock.test b/tests/clock.test index d9c491a..b540024 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -254,7 +254,7 @@ proc ::testClock::registry { cmd path key } { test clock-1.0 "clock format - wrong # args" { list [catch {clock format} msg] $msg $::errorCode -} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}} +} {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}} test clock-1.1 "clock format - bad time" { list [catch {clock format foo} msg] $msg @@ -270,10 +270,11 @@ test clock-1.3 "clock format - empty val" { test clock-1.4 "clock format - bad flag" {*}{ -body { - list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode + # range error message for possible extensions: + list [catch {clock format 0 -oops badflag} msg] [string range $msg 0 60] $::errorCode } -match glob - -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}} + -result {1 {bad option "-oops": must be -format, -gmt, -locale, -timezone} {CLOCK badOption -oops}} } test clock-1.5 "clock format - bad timezone" { @@ -288,6 +289,16 @@ test clock-1.7 "clock format - option abbreviations" { clock format 0 -g true -f "%Y-%m-%d" } 1970-01-01 +test clock-1.8 "clock format -now" { + # give one second more for test (if on boundary of the current second): + set n [clock format [clock seconds] -g 1 -f "%s"] + expr {[clock format -now -g 1 -f "%s"] in [list $n [incr n]]} +} 1 + +test clock-1.9 "clock arguments: option doubly present" { + list [catch {clock format 0 -gmt 1 -gmt 0} result] $result +} {1 {bad option "-gmt": doubly present}} + # BEGIN testcases2 # Test formatting of Gregorian year, month, day, all formats -- cgit v0.12 From 91074e4788ef3e61e1a86ab926f27bfc23f6e067 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 23:02:14 +0000 Subject: small amend (reset have rel flag) --- generic/tclClock.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tclClock.c b/generic/tclClock.c index 791898b..efa9120 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3623,6 +3623,8 @@ repeat_rel: goto repeat_rel; } } + + yyHaveRel = 0; } /* -- cgit v0.12 From 7013db7f737f3f8279a9f313e53c8dc467162cf3 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 10 Jan 2017 23:09:23 +0000 Subject: amend lost changes after rebase to fossil --- library/clock.tcl | 1 + tests/clock.test | 1 + 2 files changed, 2 insertions(+) diff --git a/library/clock.tcl b/library/clock.tcl index ba4676b..94d2341 100755 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -10,6 +10,7 @@ #---------------------------------------------------------------------- # # Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny +# Copyright (c) 2015 by Sergey G. Brester aka sebres. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # diff --git a/tests/clock.test b/tests/clock.test index b540024..9e86c97 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -7,6 +7,7 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# Copyright (c) 2015 by Sergey G. Brester aka sebres. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -- cgit v0.12 From 0be426fec21fe7b763b7486ec2c6d11d17fb19e3 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 11 Jan 2017 16:35:41 +0000 Subject: code review: small optimization of msgcat::mcget, prevents infinite loop if at all no translation --- library/msgcat/msgcat.tcl | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 1260139..f9f57db 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -245,8 +245,6 @@ proc msgcat::mc {src args} { # format command. proc msgcat::mcget {ns loc args} { - variable Msgs - if {$loc eq {C}} { set loclist [PackagePreferences $ns] set loc [lindex $loclist 0] @@ -270,18 +268,20 @@ proc msgcat::mcget {ns loc args} { # search translation for each locale (regarding parent namespaces) for {set nscur $ns} {$nscur != ""} {set nscur [namespace parent $nscur]} { foreach loc $loclist { - if {[dict exists $Msgs $nscur $loc $src]} { - if {[llength $args] > 1} { - return [format [dict get $Msgs $nscur $loc $src] \ - {*}[lrange $args 1 end]] - } else { - return [dict get $Msgs $nscur $loc $src] + set msgs [mcget $nscur $loc] + if {![catch { set val [dict get $msgs $src] }]} { + if {[llength $args] == 1} { + return $val } + return [format $val {*}[lrange $args 1 end]] } } } - # get with package default locale - mcget $ns [lindex $loclist 0] {*}$args + # no translation : + if {[llength $args] == 1} { + return $src + } + return [format $src {*}[lrange $args 1 end]] } # msgcat::mcexists -- @@ -942,8 +942,10 @@ proc msgcat::Merge {ns locales} { set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]] } } else { - catch { + if {[catch { set mrgcat [dict get $Msgs $ns $loc] + }]} { + set mrgcat [dict create] } } dict set Merged $ns $loc $mrgcat -- cgit v0.12 From b2190d273f42dc51a6455279afdf00695c45c12b Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 11 Jan 2017 16:36:28 +0000 Subject: code review and inline documentation --- generic/tclClock.c | 27 +++++ generic/tclClockFmt.c | 323 +++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 323 insertions(+), 27 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index efa9120..c63f425 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -412,7 +412,19 @@ NormTimezoneObj( /* *---------------------------------------------------------------------- + * + * ClockGetSystemLocale -- + * + * Returns system locale. + * + * Executes ::tcl::clock::GetSystemLocale in given interpreter. + * + * Results: + * Returns system locale tcl object. + * + *---------------------------------------------------------------------- */ + static inline Tcl_Obj * ClockGetSystemLocale( ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */ @@ -426,7 +438,19 @@ ClockGetSystemLocale( } /* *---------------------------------------------------------------------- + * + * ClockGetCurrentLocale -- + * + * Returns current locale. + * + * Executes ::tcl::clock::mclocale in given interpreter. + * + * Results: + * Returns current locale tcl object. + * + *---------------------------------------------------------------------- */ + static inline Tcl_Obj * ClockGetCurrentLocale( ClockClientData *dataPtr, /* Client data containing literal pool */ @@ -978,6 +1002,9 @@ ClockGetTZData( * * Returns system (current) timezone. * + * If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone + * in given interpreter and caches its result. + * * Results: * Returns normalized timezone object. * diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index ff16714..d875bd4 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -41,6 +41,24 @@ CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); * Clock scan and format facilities. */ +/* + *---------------------------------------------------------------------- + * + * _str2int -- , _str2wideInt -- + * + * Fast inline-convertion of string to signed int or wide int by given + * start/end. + * + * The given string should contain numbers chars only (because already + * pre-validated within parsing routines) + * + * Results: + * Returns a standard Tcl result. + * TCL_OK - by successful conversion, TCL_ERROR by (wide) int overflow + * + *---------------------------------------------------------------------- + */ + static inline int _str2int( int *out, @@ -101,6 +119,22 @@ _str2wideInt( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * _itoaw -- , _witoaw -- + * + * Fast inline-convertion of signed int or wide int to string, using + * given padding with specified padchar and width (or without padding). + * + * This is a very fast replacement for sprintf("%02d"). + * + * Results: + * Returns position in buffer after end of conversion result. + * + *---------------------------------------------------------------------- + */ + static inline char * _itoaw( char *buf, @@ -257,7 +291,15 @@ _witoaw( } /* - *---------------------------------------------------------------------- + * Global GC as LIFO for released scan/format object storages. + * + * Used to holds last released CLOCK_FMT_SCN_STORAGE_GC_SIZE formats + * (after last reference from Tcl-object will be removed). This is helpful + * to avoid continuous (re)creation and compiling by some dynamically resp. + * variable format objects, that could be often reused. + * + * As long as format storage is used resp. belongs to GC, it takes place in + * FmtScnHashTable also. */ #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 @@ -268,6 +310,24 @@ static struct { unsigned int count; } ClockFmtScnStorage_GC = {NULL, NULL, 0}; +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageGC_In -- + * + * Adds an format storage object to GC. + * + * If current GC is full (size larger as CLOCK_FMT_SCN_STORAGE_GC_SIZE) + * this removes last unused storage at begin of GC stack (LIFO). + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static inline void ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) { @@ -291,6 +351,22 @@ ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) ClockFmtScnStorageDelete(delEnt); } } + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorage_GC_Out -- + * + * Restores (for reusing) given format storage object from GC. + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static inline void ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) { @@ -304,13 +380,19 @@ ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) #endif + /* - *---------------------------------------------------------------------- + * Global format storage hash table of type ClockFmtScnStorageHashKeyType + * (contains list of scan/format object storages, shared across all threads). + * + * Used for fast searching by format string. */ - static Tcl_HashTable FmtScnHashTable; static int initialized = 0; +/* + * Wrappers between pointers to hash entry and format storage object + */ static inline Tcl_HashEntry * HashEntry4FmtScn(ClockFmtScnStorage *fss) { return (Tcl_HashEntry*)(fss + 1); @@ -320,8 +402,18 @@ FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) { return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage)); }; -/* - * Format storage hash (list of formats shared across all threads). +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageAllocProc -- + * + * Allocate space for a hash entry containing format storage together + * with the string key. + * + * Results: + * The return value is a pointer to the created entry. + * + *---------------------------------------------------------------------- */ static Tcl_HashEntry * @@ -353,6 +445,19 @@ ClockFmtScnStorageAllocProc( return hPtr; } +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageFreeProc -- + * + * Free format storage object and space of given hash entry. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static void ClockFmtScnStorageFreeProc( Tcl_HashEntry *hPtr) @@ -373,6 +478,19 @@ ClockFmtScnStorageFreeProc( ckfree(fss); } +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageDelete -- + * + * Delete format storage object. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) { Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); @@ -392,7 +510,7 @@ static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; /* - * Type definition. + * Type definition of clock-format tcl object type. */ Tcl_ObjType ClockFmtObjType = { @@ -409,9 +527,6 @@ Tcl_ObjType ClockFmtObjType = { #define ObjLocFmtKey(objPtr) \ (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2)) -/* - *---------------------------------------------------------------------- - */ static void ClockFmtObj_DupInternalRep(srcPtr, copyPtr) Tcl_Obj *srcPtr; @@ -442,9 +557,7 @@ ClockFmtObj_DupInternalRep(srcPtr, copyPtr) copyPtr->length = srcPtr->length; } } -/* - *---------------------------------------------------------------------- - */ + static void ClockFmtObj_FreeInternalRep(objPtr) Tcl_Obj *objPtr; @@ -472,9 +585,7 @@ ClockFmtObj_FreeInternalRep(objPtr) } objPtr->typePtr = NULL; }; -/* - *---------------------------------------------------------------------- - */ + static int ClockFmtObj_SetFromAny(interp, objPtr) Tcl_Interp *interp; @@ -494,9 +605,7 @@ ClockFmtObj_SetFromAny(interp, objPtr) return TCL_OK; }; -/* - *---------------------------------------------------------------------- - */ + static void ClockFmtObj_UpdateString(objPtr) Tcl_Obj *objPtr; @@ -518,7 +627,25 @@ ClockFmtObj_UpdateString(objPtr) /* *---------------------------------------------------------------------- + * + * ClockFrmObjGetLocFmtKey -- + * + * Retrieves format key object used to search localized format. + * + * This is normally stored in second pointer of internal representation. + * If format object is not localizable, it is equal the given format + * pointer and the first pointer of internal representation may be NULL. + * + * Results: + * Returns tcl object with key or format object if not localizable. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the key inside its internal representation. + * + *---------------------------------------------------------------------- */ + MODULE_SCOPE Tcl_Obj* ClockFrmObjGetLocFmtKey( Tcl_Interp *interp, @@ -545,6 +672,25 @@ ClockFrmObjGetLocFmtKey( /* *---------------------------------------------------------------------- + * + * FindOrCreateFmtScnStorage -- + * + * Retrieves format storage for given string format. + * + * This will find the given format in the global storage hash table + * or create a format storage object on demaind and save the + * reference in the first pointer of internal representation of given + * object. + * + * Results: + * Returns scan/format storage pointer to ClockFmtScnStorage. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the format storage reference inside its internal representation. + * Increments objRefCount of the ClockFmtScnStorage reference. + * + *---------------------------------------------------------------------- */ static ClockFmtScnStorage * @@ -609,16 +755,16 @@ FindOrCreateFmtScnStorage( * * Tcl_GetClockFrmScnFromObj -- * - * Returns a clock format/scan representation of (*objPtr), if possible. - * If something goes wrong, NULL is returned, and if interp is non-NULL, - * an error message is written there. + * Returns a clock format/scan representation of (*objPtr), if possible. + * If something goes wrong, NULL is returned, and if interp is non-NULL, + * an error message is written there. * * Results: - * Valid representation of type ClockFmtScnStorage. + * Valid representation of type ClockFmtScnStorage. * * Side effects: - * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr) - * and in global hash table, shared across all threads. + * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr) + * and in global hash table, shared across all threads. * *---------------------------------------------------------------------- */ @@ -644,7 +790,27 @@ Tcl_GetClockFrmScnFromObj( return fss; } - +/* + *---------------------------------------------------------------------- + * + * ClockLocalizeFormat -- + * + * Wrap the format object in options to the localized format, + * corresponding given locale. + * + * This searches localized format in locale catalog, and if not yet + * exists, it executes ::tcl::clock::LocalizeFormat in given interpreter + * and caches its result in the locale catalog. + * + * Results: + * Localized format object. + * + * Side effects: + * Caches the localized format inside locale catalog. + * + *---------------------------------------------------------------------- + */ + MODULE_SCOPE Tcl_Obj * ClockLocalizeFormat( ClockFmtScnCmdArgs *opts) @@ -713,6 +879,22 @@ clean: return (opts->formatObj = valObj); } +/* + *---------------------------------------------------------------------- + * + * FindTokenBegin -- + * + * Find begin of given scan token in string, corresponding token type. + * + * Results: + * Position of token inside string if found. Otherwise - end of string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + static const char * FindTokenBegin( register const char *p, @@ -748,12 +930,22 @@ FindTokenBegin( return p; } -/* +/* + *---------------------------------------------------------------------- + * * DetermineGreedySearchLen -- * - * Determine min/max lengths as exact as possible (speed, greedy match) + * Determine min/max lengths as exact as possible (speed, greedy match). * + * Results: + * None. Lengths are stored in *minLenPtr, *maxLenPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- */ + static void DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok, @@ -836,6 +1028,23 @@ DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, *maxLenPtr = maxLen; } +/* + *---------------------------------------------------------------------- + * + * ObjListSearch -- + * + * Find largest part of the input string from start regarding min and + * max lengths in the given list (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found, TCL_RETURN - not matched, TCL_ERROR in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + static inline int ObjListSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, int *val, @@ -909,6 +1118,26 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } #endif +/* + *---------------------------------------------------------------------- + * + * ClockMCGetListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * given literal index mcKey (and builds it on demand). + * + * Searches localized index in locale catalog, and if not yet exists, + * creates string indexed tree and stores it in the locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + static TclStrIdxTree * ClockMCGetListIdxTree( ClockFmtScnCmdArgs *opts, @@ -960,6 +1189,27 @@ done: return idxTree; } +/* + *---------------------------------------------------------------------- + * + * ClockMCGetMultiListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * multiple lists by literal indices mcKeys (and builds it on demand). + * + * Searches localized index in locale catalog for mcKey, and if not + * yet exists, creates string indexed tree and stores it in the + * locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + static TclStrIdxTree * ClockMCGetMultiListIdxTree( ClockFmtScnCmdArgs *opts, @@ -1016,6 +1266,25 @@ done: return idxTree; } +/* + *---------------------------------------------------------------------- + * + * ClockStrIdxTreeSearch -- + * + * Find largest part of the input string from start regarding lengths + * in the given localized string indexed tree (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found and the index stored in *val, + * TCL_RETURN - not matched or ambigous, + * TCL_ERROR - in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + static inline int ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, TclStrIdxTree *idxTree, int *val, -- cgit v0.12 From 1ff982ffd6785745b647bbe0bb46aca7e13ace8e Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 9 Feb 2017 11:34:43 +0000 Subject: =?UTF-8?q?resolve=20warning:=20enumeration=20value=20=E2=80=98TMR?= =?UTF-8?q?T=5FLAST=E2=80=99=20not=20handled=20in=20switch=20(impossible?= =?UTF-8?q?=20to=20handle=20in=20switch=20because=20of=20break);?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclCmdMZ.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index c660596..319799c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4089,7 +4089,7 @@ Tcl_TimeRateObjCmd( i++; break; } - switch ((enum options) index) { + switch (index) { case TMRT_EV_DIRECT: direct = objv[i]; break; -- cgit v0.12 From fb811680f60f0555a27685601c519ff931956593 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 9 Feb 2017 11:36:17 +0000 Subject: [timerate] bug fix: missing scale conversion by Mac OSX on platform where high resolution clicks are not microseconds based; [win] use high resolution timer for the wide clicks and microseconds directly, prevent several forwards/backwards conversions; [win, unix, mac-osx] normalize some functions for common usage in different time units (clicks, micro- and nanoseconds) --- generic/tclClock.c | 9 +-- generic/tclCmdMZ.c | 24 +++++--- generic/tclInt.h | 16 ++++++ unix/tclUnixTime.c | 71 +++++++++++++++++++++++ win/tclWinTime.c | 166 ++++++++++++++++++++++++++++++++++++++++++----------- 5 files changed, 238 insertions(+), 48 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 27009fd..5da9511 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1760,8 +1760,7 @@ ClockClicksObjCmd( #endif break; case CLICKS_MICROS: - Tcl_GetTime(&now); - clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec; + clicks = TclpGetMicroseconds(); break; } @@ -1831,15 +1830,11 @@ ClockMicrosecondsObjCmd( int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter values */ { - Tcl_Time now; - if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj( - ((Tcl_WideInt) now.sec * 1000000) + now.usec)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 319799c..b0212c3 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4215,16 +4215,19 @@ usage: } /* get start and stop time */ -#ifndef TCL_WIDE_CLICKS +#ifdef TCL_WIDE_CLICKS + start = middle = TclpGetWideClicks(); + /* time to stop execution (in wide clicks) */ + stop = start + (maxms * 1000 / TclpWideClickInMicrosec()); +#else Tcl_GetTime(&now); start = now.sec; start *= 1000000; start += now.usec; -#else - start = TclpGetWideClicks(); + middle = start; + /* time to stop execution (in microsecs) */ + stop = start + maxms * 1000; #endif /* start measurement */ - stop = start + maxms * 1000; - middle = start; while (1) { /* eval single iteration */ count++; @@ -4246,11 +4249,11 @@ usage: if (--threshold > 0) continue; /* check stop time reached, estimate new threshold */ - #ifndef TCL_WIDE_CLICKS + #ifdef TCL_WIDE_CLICKS + middle = TclpGetWideClicks(); + #else Tcl_GetTime(&now); middle = now.sec; middle *= 1000000; middle += now.usec; - #else - middle = TclpGetWideClicks(); #endif if (middle >= stop) { break; @@ -4274,6 +4277,11 @@ usage: middle -= start; /* execution time in microsecs */ + #ifdef TCL_WIDE_CLICKS + /* convert execution time in wide clicks to microsecs */ + middle *= TclpWideClickInMicrosec(); + #endif + /* if not calibrate */ if (!calibrate) { /* minimize influence of measurement overhead */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 1b37d84..fb0bcb7 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3189,7 +3189,23 @@ MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); +MODULE_SCOPE double TclpWideClickInMicrosec(void); +#else +# ifdef _WIN32 +# define TCL_WIDE_CLICKS 1 +MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * 1000) +# define TclpWideClickInMicrosec() (1) +# endif #endif +#ifndef _WIN32 +MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); +#else +# define TclpGetMicroseconds() \ + TclpGetWideClicks() +#endif + MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index d634449..8ec6e8a 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -84,6 +84,32 @@ TclpGetSeconds(void) /* *---------------------------------------------------------------------- * + * TclpGetMicroseconds -- + * + * This procedure returns the number of microseconds from the epoch. + * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT. + * + * Results: + * Number of microseconds from the epoch. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_WideInt +TclpGetMicroseconds(void) +{ + Tcl_Time time; + + tclGetTimeProcPtr(&time, tclTimeClientData); + return ((Tcl_WideInt)time.sec)*1000000 + time.usec; +} + +/* + *---------------------------------------------------------------------- + * * TclpGetClicks -- * * This procedure returns a value that represents the highest resolution @@ -216,6 +242,51 @@ TclpWideClicksToNanoseconds( return nsec; } + +/* + *---------------------------------------------------------------------- + * + * TclpWideClickInMicrosec -- + * + * This procedure return scale to convert click values from the + * TclpGetWideClicks native resolution to microsecond resolution + * and back. + * + * Results: + * 1 click in microseconds as double. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +double +TclpWideClickInMicrosec(void) +{ + if (tclGetTimeProcPtr != NativeGetTime) { + return 1.0; + } else { +#ifdef MAC_OSX_TCL + static int initialized = 0; + static double scale = 0.0; + + if (initialized) { + return scale; + } else { + mach_timebase_info_data_t tb; + + mach_timebase_info(&tb); + /* value of tb.numer / tb.denom = 1 click in nanoseconds */ + scale = ((double)tb.numer) / tb.denom / 1000; + initialized = 1; + return scale; + } +#else +#error Wide high-resolution clicks not implemented on this platform +#endif + } +} #endif /* TCL_WIDE_CLICKS */ /* diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 81d9458..06ea6cd 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -123,6 +123,7 @@ static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter, Tcl_WideUInt fileTime); static void NativeScaleTime(Tcl_Time* timebuf, ClientData clientData); +static Tcl_WideInt NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, ClientData clientData); @@ -154,10 +155,19 @@ ClientData tclTimeClientData = NULL; unsigned long TclpGetSeconds(void) { - Tcl_Time t; + Tcl_WideInt usecSincePosixEpoch; - tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ - return t.sec; + /* Try to use high resolution timer */ + if ( tclGetTimeProcPtr == NativeGetTime + && (usecSincePosixEpoch = NativeGetMicroseconds()) + ) { + return usecSincePosixEpoch / 1000000; + } else { + Tcl_Time t; + + tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */ + return t.sec; + } } /* @@ -182,19 +192,66 @@ TclpGetSeconds(void) unsigned long TclpGetClicks(void) { - /* - * Use the Tcl_GetTime abstraction to get the time in microseconds, as - * nearly as we can, and return it. - */ + Tcl_WideInt usecSincePosixEpoch; - Tcl_Time now; /* Current Tcl time */ - unsigned long retval; /* Value to return */ + /* Try to use high resolution timer */ + if ( tclGetTimeProcPtr == NativeGetTime + && (usecSincePosixEpoch = NativeGetMicroseconds()) + ) { + return (unsigned long)usecSincePosixEpoch; + } else { + /* + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. + */ - tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ + Tcl_Time now; /* Current Tcl time */ - retval = (now.sec * 1000000) + now.usec; - return retval; + tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ + return (unsigned long)(now.sec * 1000000) + now.usec; + } +} + +/* + *---------------------------------------------------------------------- + * + * TclpGetWideClicks -- + * + * This procedure returns a WideInt value that represents the highest + * resolution clock in microseconds available on the system. + * + * Results: + * Number of microseconds (from the epoch). + * + * Side effects: + * This should be used for time-delta resp. for measurement purposes + * only, because on some platforms can return microseconds from some + * start time (not from the epoch). + * + *---------------------------------------------------------------------- + */ + +Tcl_WideInt +TclpGetWideClicks(void) +{ + Tcl_WideInt usecSincePosixEpoch; + + /* Try to use high resolution timer */ + if ( tclGetTimeProcPtr == NativeGetTime + && (usecSincePosixEpoch = NativeGetMicroseconds()) + ) { + return usecSincePosixEpoch; + } else { + /* + * Use the Tcl_GetTime abstraction to get the time in microseconds, as + * nearly as we can, and return it. + */ + + Tcl_Time now; + tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ + return (((Tcl_WideInt)now.sec) * 1000000) + now.usec; + } } /* @@ -223,7 +280,17 @@ void Tcl_GetTime( Tcl_Time *timePtr) /* Location to store time information. */ { - tclGetTimeProcPtr(timePtr, tclTimeClientData); + Tcl_WideInt usecSincePosixEpoch; + + /* Try to use high resolution timer */ + if ( tclGetTimeProcPtr == NativeGetTime + && (usecSincePosixEpoch = NativeGetMicroseconds()) + ) { + timePtr->sec = (long) (usecSincePosixEpoch / 1000000); + timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + } else { + tclGetTimeProcPtr(timePtr, tclTimeClientData); + } } /* @@ -256,13 +323,14 @@ NativeScaleTime( /* *---------------------------------------------------------------------- * - * NativeGetTime -- + * NativeGetMicroseconds -- * - * TIP #233: Gets the current system time in seconds and microseconds - * since the beginning of the epoch: 00:00 UCT, January 1, 1970. + * Gets the current system time in microseconds since the beginning + * of the epoch: 00:00 UCT, January 1, 1970. * * Results: - * Returns the current time in timePtr. + * Returns the wide integer with number of microseconds from the epoch, or + * 0 if high resolution timer is not available. * * Side effects: * On the first call, initializes a set of static variables to keep track @@ -275,13 +343,9 @@ NativeScaleTime( *---------------------------------------------------------------------- */ -static void -NativeGetTime( - Tcl_Time *timePtr, - ClientData clientData) +static Tcl_WideInt +NativeGetMicroseconds(void) { - struct _timeb t; - /* * Initialize static storage on the first trip through. * @@ -432,9 +496,7 @@ NativeGetTime( if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) { usecSincePosixEpoch = (fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10; - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - return; + return usecSincePosixEpoch; } /* @@ -455,19 +517,57 @@ NativeGetTime( * 10000000 / curCounterFreq.QuadPart); usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10; - timePtr->sec = (long) (usecSincePosixEpoch / 1000000); - timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); - return; + return usecSincePosixEpoch; } } /* - * High resolution timer is not available. Just use ftime. + * High resolution timer is not available. */ + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * NativeGetTime -- + * + * TIP #233: Gets the current system time in seconds and microseconds + * since the beginning of the epoch: 00:00 UCT, January 1, 1970. + * + * Results: + * Returns the current time in timePtr. + * + * Side effects: + * See NativeGetMicroseconds for more information. + * + *---------------------------------------------------------------------- + */ - _ftime(&t); - timePtr->sec = (long)t.time; - timePtr->usec = t.millitm * 1000; +static void +NativeGetTime( + Tcl_Time *timePtr, + ClientData clientData) +{ + Tcl_WideInt usecSincePosixEpoch; + + /* + * Try to use high resolution timer. + */ + if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) { + timePtr->sec = (long) (usecSincePosixEpoch / 1000000); + timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000); + } else { + /* + * High resolution timer is not available. Just use ftime. + */ + + struct _timeb t; + + _ftime(&t); + timePtr->sec = (long)t.time; + timePtr->usec = t.millitm * 1000; + } } /* -- cgit v0.12 From c88fb138612db4499a9e841453cd14bfd5db7224 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 9 Feb 2017 13:45:14 +0000 Subject: =?UTF-8?q?[win]=20accomplished=20winTime=20module=20using=20very?= =?UTF-8?q?=20fast=20wide=20clicks,=20with=20denominator=20scale=20to/from?= =?UTF-8?q?=20microseconds,=20and=20therefore=20more=20precise=20"timerate?= =?UTF-8?q?"=20results=20under=20windows=20(using=20similar=20mechanisms?= =?UTF-8?q?=20as=20by=20Mac=20OSX).=20Especially=20multi-threaded,=20becau?= =?UTF-8?q?se=20it=20works=20without=20lock=20opposite=20to=20microseconds?= =?UTF-8?q?=20(that=20use=20crictical=20section,=20because=20of=20the=20ca?= =?UTF-8?q?libration=20thread).=20The=20reason=20for=20usage=20of=20wide?= =?UTF-8?q?=20clicks=20instead=20microseconds=20explains=20following=20exa?= =?UTF-8?q?mple=20(shows=2020%=20performance=20deference):=20%=20timerate?= =?UTF-8?q?=20-calibrate=20{}=20%=20timerate=20{clock=20microseconds}=2050?= =?UTF-8?q?00=200.297037=20=C2=B5s/#=2014465901=20#=203366585=20#/sec=2042?= =?UTF-8?q?96.906=20nett-ms=20%=20timerate=20{clock=20clicks}=205000=200.2?= =?UTF-8?q?47797=20=C2=B5s/#=2016869084=20#=204035554=20#/sec=204180.116?= =?UTF-8?q?=20nett-ms?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclInt.h | 10 ++---- win/tclWinTime.c | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 103 insertions(+), 14 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index fb0bcb7..3c21de0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3186,6 +3186,7 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer, MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); + #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); @@ -3194,17 +3195,12 @@ MODULE_SCOPE double TclpWideClickInMicrosec(void); # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); +MODULE_SCOPE double TclpWideClickInMicrosec(void); # define TclpWideClicksToNanoseconds(clicks) \ - ((double)(clicks) * 1000) -# define TclpWideClickInMicrosec() (1) + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif -#ifndef _WIN32 MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void); -#else -# define TclpGetMicroseconds() \ - TclpGetWideClicks() -#endif MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); MODULE_SCOPE void * TclpThreadCreateKey(void); diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 06ea6cd..7cbc1ba 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -110,6 +110,17 @@ static TimeInfo timeInfo = { }; /* + * Scale to convert wide click values from the TclpGetWideClicks native + * resolution to microsecond resolution and back. + */ +static struct { + int initialized; /* 1 if initialized, 0 otherwise */ + int perfCounter; /* 1 if performance counter usable for wide clicks */ + double microsecsScale; /* Denominator scale between clock / microsecs */ +} wideClick = {0, 0.0}; + + +/* * Declarations for functions defined later in this file. */ @@ -221,7 +232,7 @@ TclpGetClicks(void) * resolution clock in microseconds available on the system. * * Results: - * Number of microseconds (from the epoch). + * Number of microseconds (from some start time). * * Side effects: * This should be used for time-delta resp. for measurement purposes @@ -234,6 +245,87 @@ TclpGetClicks(void) Tcl_WideInt TclpGetWideClicks(void) { + LARGE_INTEGER curCounter; + + if (!wideClick.initialized) { + LARGE_INTEGER perfCounterFreq; + + /* + * The frequency of the performance counter is fixed at system boot and + * is consistent across all processors. Therefore, the frequency need + * only be queried upon application initialization. + */ + if (QueryPerformanceFrequency(&perfCounterFreq)) { + wideClick.perfCounter = 1; + wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart; + } else { + /* fallback using microseconds */ + wideClick.perfCounter = 0; + wideClick.microsecsScale = 1; + } + + wideClick.initialized = 1; + } + if (wideClick.perfCounter) { + if (QueryPerformanceCounter(&curCounter)) { + return (Tcl_WideInt)curCounter.QuadPart; + } + /* fallback using microseconds */ + wideClick.perfCounter = 0; + wideClick.microsecsScale = 1; + return TclpGetMicroseconds(); + } else { + return TclpGetMicroseconds(); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclpWideClickInMicrosec -- + * + * This procedure return scale to convert wide click values from the + * TclpGetWideClicks native resolution to microsecond resolution + * and back. + * + * Results: + * 1 click in microseconds as double. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +double +TclpWideClickInMicrosec(void) +{ + if (!wideClick.initialized) { + (void)TclpGetWideClicks(); /* initialize */ + } + return wideClick.microsecsScale; +} + +/* + *---------------------------------------------------------------------- + * + * TclpGetMicroseconds -- + * + * This procedure returns a WideInt value that represents the highest + * resolution clock in microseconds available on the system. + * + * Results: + * Number of microseconds (from the epoch). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_WideInt +TclpGetMicroseconds(void) +{ Tcl_WideInt usecSincePosixEpoch; /* Try to use high resolution timer */ @@ -346,6 +438,9 @@ NativeScaleTime( static Tcl_WideInt NativeGetMicroseconds(void) { + static LARGE_INTEGER posixEpoch; + /* Posix epoch expressed as 100-ns ticks since + * the windows epoch. */ /* * Initialize static storage on the first trip through. * @@ -356,6 +451,10 @@ NativeGetMicroseconds(void) if (!timeInfo.initialized) { TclpInitLock(); if (!timeInfo.initialized) { + + posixEpoch.LowPart = 0xD53E8000; + posixEpoch.HighPart = 0x019DB1DE; + timeInfo.perfCounterAvailable = QueryPerformanceFrequency(&timeInfo.nominalFreq); @@ -468,15 +567,9 @@ NativeGetMicroseconds(void) /* Current performance counter. */ Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns * ticks since the Windows epoch. */ - static LARGE_INTEGER posixEpoch; - /* Posix epoch expressed as 100-ns ticks since - * the windows epoch. */ Tcl_WideInt usecSincePosixEpoch; /* Current microseconds since Posix epoch. */ - posixEpoch.LowPart = 0xD53E8000; - posixEpoch.HighPart = 0x019DB1DE; - QueryPerformanceCounter(&curCounter); /* -- cgit v0.12 From 4f047ce7e36ab348d5c3d492e85eda950903e070 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 6 Mar 2017 20:32:54 +0000 Subject: msgcat.test: fixed mcpackagelocale syntax usage test case (msgcat-12.1) --- tests/msgcat.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/msgcat.test b/tests/msgcat.test index 1c3ce58..584e420 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -811,7 +811,7 @@ namespace eval ::msgcat::test { test msgcat-12.1 {mcpackagelocale no subcommand} -body { mcpackagelocale } -returnCodes 1\ - -result {wrong # args: should be "mcpackagelocale subcommand ?locale?"} + -result {wrong # args: should be "mcpackagelocale subcommand ?locale? ?ns?"} test msgcat-12.2 {mclpackagelocale wrong subcommand} -body { mcpackagelocale junk -- cgit v0.12 From 9871b8eb6c3ac265b079b3f84861fad27bf3a6ec Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 6 Mar 2017 21:01:53 +0000 Subject: tclEmptyStringRep -> &tclEmptyString --- generic/tclStrIdxTree.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 773eb6a..d9b5da0 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -397,7 +397,7 @@ StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr) { /* currently only dummy empty string possible */ objPtr->length = 0; - objPtr->bytes = tclEmptyStringRep; + objPtr->bytes = &tclEmptyString; }; MODULE_SCOPE TclStrIdxTree * -- cgit v0.12 From db083499bfff8aee794512e3da2f0ad2f201f6b0 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 7 Mar 2017 11:35:03 +0000 Subject: timerate: don't calculate threshold by too few iterations, because sometimes first iteration(s) can be too fast (cached, delayed clean up, etc). --- generic/tclCmdMZ.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 14ff5f0..b62ccf8 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4282,6 +4282,13 @@ usage: if (middle >= stop) { break; } + + /* don't calculate threshold by few iterations, because sometimes + * first iteration(s) can be too fast (cached, delayed clean up, etc) */ + if (count < 10) { + threshold = 1; continue; + } + /* average iteration time in microsecs */ threshold = (middle - start) / count; if (threshold > maxIterTm) { -- cgit v0.12 From 87313fd6795a5c95c6788ed3b8d3443bdf3740a2 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 9 May 2017 22:24:44 +0000 Subject: add missing compile functionality (TclPreserveByteCode/TclReleaseByteCode back-ported as inline from trunk) --- generic/tclCompile.h | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c04fc0e..90edf07 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1159,6 +1159,25 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *isScalarPtr); + +static inline void +TclPreserveByteCode( + register ByteCode *codePtr) +{ + codePtr->refCount++; +} + +static inline void +TclReleaseByteCode( + register ByteCode *codePtr) +{ + if (codePtr->refCount-- > 1) { + return; + } + /* Just dropped to refcount==0. Clean up. */ + TclCleanupByteCode(codePtr); +} + MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); -- cgit v0.12 From c5c51d5048a415066a886933e01a6de6eaaa0c54 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 12:29:42 +0000 Subject: clock.test normalized (compared with trunk) --- tests/clock.test | 135 ++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 95 insertions(+), 40 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 103f254..9e86c97 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36,9 +36,9 @@ testConstraint y2038 \ # TEST PLAN # clock-1: -# [clock format] - tests of bad and empty arguments +# [clock format] - tests of bad and empty arguments # -# clock-2 +# clock-2 # formatting of year, month and day of month # # clock-3 @@ -196,7 +196,7 @@ namespace eval ::tcl::clock { l li lii liii liv lv lvi lvii lviii lix lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix - lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii + lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii lxxxix xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix c @@ -273,7 +273,7 @@ test clock-1.4 "clock format - bad flag" {*}{ -body { # range error message for possible extensions: list [catch {clock format 0 -oops badflag} msg] [string range $msg 0 60] $::errorCode - } + } -match glob -result {1 {bad option "-oops": must be -format, -gmt, -locale, -timezone} {CLOCK badOption -oops}} } @@ -35143,6 +35143,10 @@ test clock-29.1800 {time parsing} { } 86399 # END testcases29 + +# BEGIN testcases30 + +# Test [clock add] test clock-30.1 {clock add years} { set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC] set f [clock add $t 1 year -timezone :UTC] @@ -35369,10 +35373,61 @@ test clock-30.25 {clock add seconds at DST conversion} { set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \ -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00] } {2004-10-31 01:00:00 -0500} +test clock-30.26 {clock add weekdays} { + set t [clock scan {2013-11-20}] ;# Wednesday + set f1 [clock add $t 3 weekdays] + set x1 [clock format $f1 -format {%Y-%m-%d}] +} {2013-11-25} +test clock-30.27 {clock add weekdays starting on Saturday} { + set t [clock scan {2013-11-23}] ;# Saturday + set f1 [clock add $t 1 weekday] + set x1 [clock format $f1 -format {%Y-%m-%d}] +} {2013-11-25} +test clock-30.28 {clock add weekdays starting on Sunday} { + set t [clock scan {2013-11-24}] ;# Sunday + set f1 [clock add $t 1 weekday] + set x1 [clock format $f1 -format {%Y-%m-%d}] +} {2013-11-25} +test clock-30.29 {clock add 0 weekdays starting on a weekend} { + set t [clock scan {2016-02-27}] ;# Saturday + set f1 [clock add $t 0 weekdays] + set x1 [clock format $f1 -format {%Y-%m-%d}] +} {2016-02-27} +test clock-30.30 {clock add weekdays and back} -body { + set n [clock seconds] + # we start on each day of the week + for {set i 0} {$i < 7} {incr i} { + set start [clock add $n $i days] + set startu [clock format $start -format %u] + # add 0 - 100 weekdays + for {set j 0} {$j < 100} {incr j} { + set forth [clock add $start $j weekdays] + set back [clock add $forth -$j weekdays] + # If $s was a weekday or $j was 0, $b must be the same day. + # Otherwise, $b must be the immediately preceeding Friday + set fail 0 + if {$j == 0 || $startu < 6} { + if {$start != $back} { set fail 1} + } else { + set friday [clock add $start -[expr {$startu % 5}] days] + if {$friday != $back} { set fail 1 } + } + if {$fail} { + set sdate [clock format $start -format {%Y-%m-%d}] + set bdate [clock format $back -format {%Y-%m-%d}] + return "$sdate + $j - $j := $bdate" + } + } + } + return "OK" +} -result {OK} + +# END testcases30 + test clock-31.1 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35395,7 +35450,7 @@ test clock-31.1 {system locale} \ test clock-31.2 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35418,7 +35473,7 @@ test clock-31.2 {system locale} \ test clock-31.3 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35441,7 +35496,7 @@ test clock-31.3 {system locale} \ test clock-31.4 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35478,7 +35533,7 @@ test clock-31.4 {system locale} \ test clock-31.5 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35515,7 +35570,7 @@ test clock-31.5 {system locale} \ test clock-31.6 {system locale} \ -constraints win \ - -setup { + -setup { namespace eval ::tcl::clock { namespace import -force ::testClock::registry } @@ -35585,7 +35640,7 @@ test clock-32.1 {scan/format across the Gregorian change} { } set problems } {} - + # Legacy tests # clock clicks @@ -35619,7 +35674,7 @@ test clock-33.5 {clock clicks tests, millisecond timing test} { # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? - "ok" : + "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { @@ -35631,7 +35686,7 @@ test clock-33.5a {clock tests, millisecond timing test} { # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? - "ok" : + "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { @@ -35984,31 +36039,31 @@ test clock-34.47 {ago with multiple relative units} { } 180000 test clock-34.48 {more than one ToD} {*}{ - -body {clock scan {10:00 11:00}} + -body {clock scan {10:00 11:00}} -returnCodes error -result {unable to convert date-time string "10:00 11:00": more than one time of day in string} } test clock-34.49 {more than one date} {*}{ - -body {clock scan {1/1/2001 2/2/2002}} + -body {clock scan {1/1/2001 2/2/2002}} -returnCodes error -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string} } test clock-34.50 {more than one time zone} {*}{ - -body {clock scan {10:00 EST CST}} + -body {clock scan {10:00 EST CST}} -returnCodes error -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string} } test clock-34.51 {more than one weekday} {*}{ - -body {clock scan {Monday Tuesday}} + -body {clock scan {Monday Tuesday}} -returnCodes error -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string} } test clock-34.52 {more than one ordinal month} {*}{ - -body {clock scan {next January next March}} + -body {clock scan {next January next March}} -returnCodes error -result {unable to convert date-time string "next January next March": more than one ordinal month in string} } @@ -36202,7 +36257,7 @@ test clock-38.2 {make sure TZ is not cached after unset} \ } } \ -result 1 - + test clock-39.1 {regression - synonym timezones} { clock format 0 -format {%H:%M:%S} -timezone :US/Eastern @@ -36274,7 +36329,7 @@ test clock-44.1 {regression test - time zone name containing hyphen } \ } } \ -result {12:34:56-0500} - + test clock-45.1 {regression test - time zone containing only two digits} \ -body { clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z @@ -36319,7 +36374,7 @@ test clock-48.1 {Bug 1185933: 'i' destroyed by clock init} -setup { test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \ -body { - list [catch { + list [catch { clock format -86400 -timezone :localtime -format %Y } result] $result } \ @@ -36558,7 +36613,7 @@ test clock-56.1 {use of zoneinfo, version 1} {*}{ } -result {2004-01-01 00:00:00 MST} } - + test clock-56.2 {use of zoneinfo, version 2} {*}{ -setup { clock format [clock seconds] @@ -36608,7 +36663,7 @@ test clock-56.2 {use of zoneinfo, version 2} {*}{ removeFile PhoenixTwo $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo - } + } -body { clock format 1072940400 -timezone :Test/PhoenixTwo \ -format {%Y-%m-%d %H:%M:%S %Z} @@ -36818,7 +36873,7 @@ test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{ removeFile TijuanaTwo $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo - } + } -body { clock format 2224738800 -timezone :Test/TijuanaTwo \ -format {%Y-%m-%d %H:%M:%S %Z} @@ -36970,7 +37025,7 @@ test clock-56.4 {Bug 3470928} {*}{ removeFile Windhoek $tzdir2 removeDirectory Test $tzdir removeDirectory zoneinfo - } + } -result {Sun Jan 08 22:30:06 WAST 2012} } @@ -36981,7 +37036,7 @@ test clock-57.1 {clock scan - abbreviated options} { test clock-58.1 {clock l10n - Japanese localisation} {*}{ -setup { proc backslashify { string } { - + set retval {} foreach char [split $string {}] { scan $char %c ccode @@ -37087,52 +37142,52 @@ test clock-59.1 {military time zones} { test clock-60.1 {case insensitive weekday names} { clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.2 {case insensitive weekday names} { clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.3 {case insensitive weekday names} { clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] test clock-60.4 {case insensitive weekday names} { clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.5 {case insensitive weekday names} { clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.6 {case insensitive weekday names} { clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a" -} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] +} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] test clock-60.7 {case insensitive month names} { clock scan "1 january 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.8 {case insensitive month names} { clock scan "1 January 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.9 {case insensitive month names} { clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] test clock-60.10 {case insensitive month names} { clock scan "1 december 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-60.11 {case insensitive month names} { clock scan "1 December 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-60.12 {case insensitive month names} { clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y" -} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] +} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] test clock-61.1 {overflow of a wide integer on output} {*}{ -body { clock format 0x8000000000000000 -format %s -gmt true - } + } -result {integer value too large to represent} -returnCodes error } test clock-61.2 {overflow of a wide integer on output} {*}{ -body { clock format -0x8000000000000001 -format %s -gmt true - } + } -result {integer value too large to represent} -returnCodes error } -- cgit v0.12 From 8482cde58cabe42d58e50e08a72e9b78298df93c Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 12:29:49 +0000 Subject: resolving differences between 8.6 and trunk --- generic/tclDictObj.c | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 4088883..593f5a3 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -145,7 +145,7 @@ typedef struct Dict { * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ - int refcount; /* Reference counter (see above) */ + size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ @@ -395,7 +395,7 @@ DupDictInternalRep( newDict->epoch = 0; newDict->chain = NULL; - newDict->refcount = 1; + newDict->refCount = 1; /* * Store in the object. @@ -430,8 +430,7 @@ FreeDictInternalRep( { Dict *dict = DICT(dictPtr); - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } dictPtr->typePtr = NULL; @@ -716,7 +715,7 @@ SetDictFromAny( TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; @@ -1120,7 +1119,7 @@ Tcl_DictObjFirst( searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; - dict->refcount++; + dict->refCount++; if (keyPtrPtr != NULL) { *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); } @@ -1234,8 +1233,7 @@ Tcl_DictObjDone( if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } } @@ -1387,7 +1385,7 @@ Tcl_NewDictObj(void) InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1437,7 +1435,7 @@ Tcl_DbNewDictObj( InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; -- cgit v0.12 From efee121d8db22043e295d65a80ec3486ee0ac6fb Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 12:29:54 +0000 Subject: Ensemble "clock" fixed after merge with kbk's clock ensemble solution. All commands (including new) compiled now also in ensemble (implemented without TclMakeEnsemble, because it can be extended via new map entries). Ensemble handling partially cherry-picked from new performance branch (TODO: check temporary "-compile" option can be reverted if it becomes ready/merged). --- generic/tclClock.c | 66 +++++++++++++++++++++++++-------------------------- generic/tclEnsemble.c | 20 +++++++++++++--- library/init.tcl | 15 ++++++++---- 3 files changed, 61 insertions(+), 40 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 8e176b6..ad3d6e7 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -17,6 +17,7 @@ #include "tclInt.h" #include "tclStrIdxTree.h" #include "tclDate.h" +#include "tclCompile.h" /* * Windows has mktime. The configurators do not check. @@ -152,21 +153,29 @@ struct ClockCommand { Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ + CompileProc *compileProc; /* The compiler for the command. */ + ClientData clientData; /* Any clientData to give the command (if NULL + * a reference to ClockClientData will be sent) */ }; static const struct ClockCommand clockCommands[] = { - { "getenv", ClockGetenvObjCmd }, - { "format", ClockFormatObjCmd }, - { "scan", ClockScanObjCmd }, - { "configure", ClockConfigureObjCmd }, - { "Oldscan", TclClockOldscanObjCmd }, - { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, - { "GetDateFields", ClockGetdatefieldsObjCmd }, - { "GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd }, - { "GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd }, - { NULL, NULL } + {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, + {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, + {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, + {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, + {"configure", ClockConfigureObjCmd, NULL, NULL}, + {"Oldscan", TclClockOldscanObjCmd, NULL, NULL}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, + {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, + {NULL, NULL, NULL, NULL} }; /* @@ -195,22 +204,10 @@ TclClockInit( char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ + Command *cmdPtr; ClockClientData *data; int i; - /* Structure of the 'clock' ensemble */ - - static const EnsembleImplMap clockImplMap[] = { - {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0}, - {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, - {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, - {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - /* * Safe interps get [::clock] as alias to a master, so do not need their * own copies of the support routines. @@ -258,21 +255,24 @@ TclClockInit( /* * Install the commands. - * TODO - Let Tcl_MakeEnsemble do this? */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { + ClientData clientData; + strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); - data->refCount++; - Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data, - ClockDeleteCmdProc); + if (!(clientData = clockCmdPtr->clientData)) { + clientData = data; + data->refCount++; + } + cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName, + clockCmdPtr->objCmdProc, clientData, + clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); + cmdPtr->compileProc = clockCmdPtr->compileProc ? + clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; } - - /* Make the clock ensemble */ - - TclMakeEnsemble(interp, "clock", clockImplMap); } /* diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index c1b0890..2480685 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -55,11 +55,12 @@ enum EnsSubcmds { }; static const char *const ensembleCreateOptions[] = { - "-command", "-map", "-parameters", "-prefixes", "-subcommands", - "-unknown", NULL + "-command", "-compile", "-map", "-parameters", "-prefixes", + "-subcommands", "-unknown", NULL }; enum EnsCreateOpts { - CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN + CRT_CMD, CRT_COMPILE, CRT_MAP, CRT_PARAM, CRT_PREFIX, + CRT_SUBCMDS, CRT_UNKNOWN }; static const char *const ensembleConfigOptions[] = { @@ -183,6 +184,7 @@ TclNamespaceEnsembleCmd( int permitPrefix = 1; Tcl_Obj *unknownObj = NULL; Tcl_Obj *paramObj = NULL; + int ensCompFlag = -1; /* * Check that we've got option-value pairs... [Bug 1558654] @@ -325,6 +327,12 @@ TclNamespaceEnsembleCmd( return TCL_ERROR; } continue; + case CRT_COMPILE: + if (Tcl_GetBooleanFromObj(interp, objv[1], + &ensCompFlag) != TCL_OK) { + return TCL_ERROR; + }; + continue; case CRT_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { @@ -350,6 +358,12 @@ TclNamespaceEnsembleCmd( Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); + /* + * Ensemble should be compiled if it has map (performance purposes) + */ + if (ensCompFlag > 0 && mapObj != NULL) { + Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE); + } /* * Tricky! Must ensure that the result is not shared (command delete diff --git a/library/init.tcl b/library/init.tcl index 87e84e4..824f66f 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -45,6 +45,7 @@ if {![info exists auto_path]} { set auto_path "" } } + namespace eval tcl { variable Dir foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { @@ -169,9 +170,16 @@ if {[interp issafe]} { namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] - proc ::tcl::initClock {} { - # Auto-loading stubs for 'clock.tcl' + proc clock args { + set cmdmap [dict create] + foreach cmd {add clicks format microseconds milliseconds scan seconds configure} { + dict set cmdmap $cmd ::tcl::clock::$cmd + } + namespace eval ::tcl::clock [list namespace ensemble create -command \ + [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ + -map $cmdmap -compile 1] + # Auto-loading stubs for 'clock.tcl' foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} { proc ::tcl::clock::$cmd args { variable TclLibDir @@ -180,9 +188,8 @@ if {[interp issafe]} { } } - rename ::tcl::initClock {} + return [uplevel 1 [info level 0]] } - ::tcl::initClock } # Conditionalize for presence of exec. -- cgit v0.12 From b0cef09790ace51d01d8e0aa6ad9bea27c745cb4 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 12:29:59 +0000 Subject: Fixed wrong args message (e.g. "clock format ..." instead of "::tcl::clock::format") if failed through compiled ensemble execution. --- generic/tclClock.c | 14 +++++++------- tests/clock.test | 4 ++++ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index ad3d6e7..a066f73 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2865,7 +2865,7 @@ ClockClicksObjCmd( } break; default: - Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); + Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?"); return TCL_ERROR; } @@ -2918,7 +2918,7 @@ ClockMillisecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds"); return TCL_ERROR; } Tcl_GetTime(&now); @@ -2953,7 +2953,7 @@ ClockMicrosecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); @@ -3223,7 +3223,7 @@ ClockFormatObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now " + Tcl_WrongNumArgs(interp, 0, NULL, "clock format clockval|-now " "?-format string? " "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"); @@ -3298,7 +3298,7 @@ ClockScanObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, "string " + Tcl_WrongNumArgs(interp, 0, NULL, "clock scan string " "?-base seconds? " "?-format string? " "?-gmt boolean? " @@ -3857,7 +3857,7 @@ ClockAddObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now ?number units?..." + Tcl_WrongNumArgs(interp, 0, NULL, "clock add clockval|-now ?number units?..." "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); @@ -4014,7 +4014,7 @@ ClockSecondsObjCmd( Tcl_Time now; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds"); return TCL_ERROR; } Tcl_GetTime(&now); diff --git a/tests/clock.test b/tests/clock.test index 9e86c97..214d4cb 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -257,6 +257,10 @@ test clock-1.0 "clock format - wrong # args" { list [catch {clock format} msg] $msg $::errorCode } {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}} +test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" { + list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode +} {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}} + test clock-1.1 "clock format - bad time" { list [catch {clock format foo} msg] $msg } {1 {expected integer but got "foo"}} -- cgit v0.12 From 121d3dc202dfea843898ea9d3327b58c3d72bd4b Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 12:30:04 +0000 Subject: Fixed possible wrong current date for CET / CEST test cases. --- tests/clock.test | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 214d4cb..0737558 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36191,7 +36191,7 @@ test clock-36.3 {clock scan next monthname} { } "05.2001" test clock-37.1 {%s gmt testing} { - set s [clock seconds] + set s [clock scan "2017-05-10 09:00:00" -gmt 1] set a [clock format $s -format %s -gmt 0] set b [clock format $s -format %s -gmt 1] set c [clock scan $s -format %s -gmt 0] @@ -36200,8 +36200,8 @@ test clock-37.1 {%s gmt testing} { # depend on the time zone. list [expr {$b-$a}] [expr {$d-$c}] } {0 0} -test clock-37.2 {%Es gmt testing} { - set s [clock seconds] +test clock-37.2 {%Es gmt testing CET} { + set s [clock scan "2017-01-10 09:00:00" -gmt 1] set a [clock format $s -format %Es -timezone CET] set b [clock format $s -format %Es -gmt 1] set c [clock scan $s -format %Es -timezone CET] @@ -36209,6 +36209,15 @@ test clock-37.2 {%Es gmt testing} { # %Es depend on the time zone (local seconds instead of posix seconds). list [expr {$b-$a}] [expr {$d-$c}] } {-3600 3600} +test clock-37.3 {%Es gmt testing CEST} { + set s [clock scan "2017-05-10 09:00:00" -gmt 1] + set a [clock format $s -format %Es -timezone CET] + set b [clock format $s -format %Es -gmt 1] + set c [clock scan $s -format %Es -timezone CET] + set d [clock scan $s -format %Es -gmt 1] + # %Es depend on the time zone (local seconds instead of posix seconds). + list [expr {$b-$a}] [expr {$d-$c}] +} {-7200 7200} test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \ -setup { -- cgit v0.12 From 480f38bf836d09cc2dd8b9a9ee956420746a7ef5 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 10 May 2017 13:02:17 +0000 Subject: Added files missing after merge/back-port (rebase with merge point) --- generic/tclClockFmt.c | 3135 +++++++++++++++++++++++++++++++++++++++++++++ generic/tclDate.h | 512 ++++++++ generic/tclStrIdxTree.c | 520 ++++++++ generic/tclStrIdxTree.h | 169 +++ tests-perf/clock.perf.tcl | 385 ++++++ 5 files changed, 4721 insertions(+) create mode 100644 generic/tclClockFmt.c create mode 100644 generic/tclDate.h create mode 100644 generic/tclStrIdxTree.c create mode 100644 generic/tclStrIdxTree.h create mode 100644 tests-perf/clock.perf.tcl diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c new file mode 100644 index 0000000..d875bd4 --- /dev/null +++ b/generic/tclClockFmt.c @@ -0,0 +1,3135 @@ +/* + * tclClockFmt.c -- + * + * Contains the date format (and scan) routines. This code is back-ported + * from the time and date facilities of tclSE engine, by Serg G. Brester. + * + * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclStrIdxTree.h" +#include "tclDate.h" + +/* + * Miscellaneous forward declarations and functions used within this file + */ + +static void +ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr); +static int +ClockFmtObj_SetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void +ClockFmtObj_UpdateString(Tcl_Obj *objPtr); + + +TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ + +static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); + +static void ClockFrmScnFinalize(ClientData clientData); + +/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); + +/* + * Clock scan and format facilities. + */ + +/* + *---------------------------------------------------------------------- + * + * _str2int -- , _str2wideInt -- + * + * Fast inline-convertion of string to signed int or wide int by given + * start/end. + * + * The given string should contain numbers chars only (because already + * pre-validated within parsing routines) + * + * Results: + * Returns a standard Tcl result. + * TCL_OK - by successful conversion, TCL_ERROR by (wide) int overflow + * + *---------------------------------------------------------------------- + */ + +static inline int +_str2int( + int *out, + register + const char *p, + const char *e, + int sign) +{ + register int val = 0, prev = 0; + if (sign >= 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + +static inline int +_str2wideInt( + Tcl_WideInt *out, + register + const char *p, + const char *e, + int sign) +{ + register Tcl_WideInt val = 0, prev = 0; + if (sign >= 0) { + while (p < e) { + val = val * 10 + (*p++ - '0'); + if (val < prev) { + return TCL_ERROR; + } + prev = val; + } + } else { + while (p < e) { + val = val * 10 - (*p++ - '0'); + if (val > prev) { + return TCL_ERROR; + } + prev = val; + } + } + *out = val; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * _itoaw -- , _witoaw -- + * + * Fast inline-convertion of signed int or wide int to string, using + * given padding with specified padchar and width (or without padding). + * + * This is a very fast replacement for sprintf("%02d"). + * + * Results: + * Returns position in buffer after end of conversion result. + * + *---------------------------------------------------------------------- + */ + +static inline char * +_itoaw( + char *buf, + register int val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + while (width <= 9 && val >= wrange[width]) { + width++; + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + while (width <= 9 && val <= -wrange[width]) { + width++; + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + +static inline char * +_witoaw( + char *buf, + register Tcl_WideInt val, + char padchar, + unsigned short int width) +{ + register char *p; + static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; + + /* positive integer */ + + if (val >= 0) + { + /* check resp. recalculate width */ + if (val >= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 >= wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val >= wrange[width]) { + width++; + } + } + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val > 0); + /* fulling with pad-char */ + while (p >= buf) { + *p-- = padchar; + } + + return buf + width; + } + + /* negative integer */ + + if (!width) width++; + /* check resp. recalculate width (regarding sign) */ + width--; + if (val <= 10000000000L) { + Tcl_WideInt val2; + val2 = val / 10000000000L; + while (width <= 9 && val2 <= -wrange[width]) { + width++; + } + width += 10; + } else { + while (width <= 9 && val <= -wrange[width]) { + width++; + } + } + width++; + /* number to string backwards */ + p = buf + width; + *p-- = '\0'; + /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ + if (-1 % 10 == -1) { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' - c; + } while (val < 0); + } else { + do { + register char c = (val % 10); val /= 10; + *p-- = '0' + c; + } while (val < 0); + } + /* sign by 0 padding */ + if (padchar != '0') { *p-- = '-'; } + /* fulling with pad-char */ + while (p >= buf + 1) { + *p-- = padchar; + } + /* sign by non 0 padding */ + if (padchar == '0') { *p = '-'; } + + return buf + width; +} + +/* + * Global GC as LIFO for released scan/format object storages. + * + * Used to holds last released CLOCK_FMT_SCN_STORAGE_GC_SIZE formats + * (after last reference from Tcl-object will be removed). This is helpful + * to avoid continuous (re)creation and compiling by some dynamically resp. + * variable format objects, that could be often reused. + * + * As long as format storage is used resp. belongs to GC, it takes place in + * FmtScnHashTable also. + */ + +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + +static struct { + ClockFmtScnStorage *stackPtr; + ClockFmtScnStorage *stackBound; + unsigned int count; +} ClockFmtScnStorage_GC = {NULL, NULL, 0}; + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageGC_In -- + * + * Adds an format storage object to GC. + * + * If current GC is full (size larger as CLOCK_FMT_SCN_STORAGE_GC_SIZE) + * this removes last unused storage at begin of GC stack (LIFO). + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry) +{ + /* add new entry */ + TclSpliceIn(entry, ClockFmtScnStorage_GC.stackPtr); + if (ClockFmtScnStorage_GC.stackBound == NULL) { + ClockFmtScnStorage_GC.stackBound = entry; + } + ClockFmtScnStorage_GC.count++; + + /* if GC ist full */ + if (ClockFmtScnStorage_GC.count > CLOCK_FMT_SCN_STORAGE_GC_SIZE) { + + /* GC stack is LIFO: delete first inserted entry */ + ClockFmtScnStorage *delEnt = ClockFmtScnStorage_GC.stackBound; + ClockFmtScnStorage_GC.stackBound = delEnt->prevPtr; + TclSpliceOut(delEnt, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + delEnt->prevPtr = delEnt->nextPtr = NULL; + /* remove it now */ + ClockFmtScnStorageDelete(delEnt); + } +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorage_GC_Out -- + * + * Restores (for reusing) given format storage object from GC. + * + * Assumes caller holds the ClockFmtMutex. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry) +{ + TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr); + ClockFmtScnStorage_GC.count--; + if (ClockFmtScnStorage_GC.stackBound == entry) { + ClockFmtScnStorage_GC.stackBound = entry->prevPtr; + } + entry->prevPtr = entry->nextPtr = NULL; +} + +#endif + + +/* + * Global format storage hash table of type ClockFmtScnStorageHashKeyType + * (contains list of scan/format object storages, shared across all threads). + * + * Used for fast searching by format string. + */ +static Tcl_HashTable FmtScnHashTable; +static int initialized = 0; + +/* + * Wrappers between pointers to hash entry and format storage object + */ +static inline Tcl_HashEntry * +HashEntry4FmtScn(ClockFmtScnStorage *fss) { + return (Tcl_HashEntry*)(fss + 1); +}; +static inline ClockFmtScnStorage * +FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) { + return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage)); +}; + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageAllocProc -- + * + * Allocate space for a hash entry containing format storage together + * with the string key. + * + * Results: + * The return value is a pointer to the created entry. + * + *---------------------------------------------------------------------- + */ + +static Tcl_HashEntry * +ClockFmtScnStorageAllocProc( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ +{ + ClockFmtScnStorage *fss; + + const char *string = (const char *) keyPtr; + Tcl_HashEntry *hPtr; + unsigned int size, + allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry); + + allocsize += (size = strlen(string) + 1); + if (size > sizeof(hPtr->key)) { + allocsize -= sizeof(hPtr->key); + } + + fss = ckalloc(allocsize); + + /* initialize */ + memset(fss, 0, sizeof(*fss)); + + hPtr = HashEntry4FmtScn(fss); + memcpy(&hPtr->key.string, string, size); + hPtr->clientData = 0; /* currently unused */ + + return hPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageFreeProc -- + * + * Free format storage object and space of given hash entry. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockFmtScnStorageFreeProc( + Tcl_HashEntry *hPtr) +{ + ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr); + + if (fss->scnTok != NULL) { + ckfree(fss->scnTok); + fss->scnTok = NULL; + fss->scnTokC = 0; + } + if (fss->fmtTok != NULL) { + ckfree(fss->fmtTok); + fss->fmtTok = NULL; + fss->fmtTokC = 0; + } + + ckfree(fss); +} + +/* + *---------------------------------------------------------------------- + * + * ClockFmtScnStorageDelete -- + * + * Delete format storage object. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + /* + * This will delete a hash entry and call "ckfree" for storage self, if + * some additionally handling required, freeEntryProc can be used instead + */ + Tcl_DeleteHashEntry(hPtr); +} + + +/* + * Derivation of tclStringHashKeyType with another allocEntryProc + */ + +static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; + + +/* + * Type definition of clock-format tcl object type. + */ + +Tcl_ObjType ClockFmtObjType = { + "clock-format", /* name */ + ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ + ClockFmtObj_DupInternalRep, /* dupIntRepProc */ + ClockFmtObj_UpdateString, /* updateStringProc */ + ClockFmtObj_SetFromAny /* setFromAnyProc */ +}; + +#define ObjClockFmtScn(objPtr) \ + (*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1)) + +#define ObjLocFmtKey(objPtr) \ + (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2)) + +static void +ClockFmtObj_DupInternalRep(srcPtr, copyPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *copyPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr); + + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + fss->objRefCount++; + Tcl_MutexUnlock(&ClockFmtMutex); + } + + ObjClockFmtScn(copyPtr) = fss; + /* regards special case - format not localizable */ + if (ObjLocFmtKey(srcPtr) != srcPtr) { + Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr)); + } else { + ObjLocFmtKey(copyPtr) = copyPtr; + } + copyPtr->typePtr = &ClockFmtObjType; + + + /* if no format representation, dup string representation */ + if (fss == NULL) { + copyPtr->bytes = ckalloc(srcPtr->length + 1); + memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1); + copyPtr->length = srcPtr->length; + } +} + +static void +ClockFmtObj_FreeInternalRep(objPtr) + Tcl_Obj *objPtr; +{ + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + if (fss != NULL) { + Tcl_MutexLock(&ClockFmtMutex); + /* decrement object reference count of format/scan storage */ + if (--fss->objRefCount <= 0) { + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* don't remove it right now (may be reusable), just add to GC */ + ClockFmtScnStorageGC_In(fss); + #else + /* remove storage (format representation) */ + ClockFmtScnStorageDelete(fss); + #endif + } + Tcl_MutexUnlock(&ClockFmtMutex); + } + ObjClockFmtScn(objPtr) = NULL; + if (ObjLocFmtKey(objPtr) != objPtr) { + Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); + } else { + ObjLocFmtKey(objPtr) = NULL; + } + objPtr->typePtr = NULL; +}; + +static int +ClockFmtObj_SetFromAny(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + /* validate string representation before free old internal represenation */ + (void)TclGetString(objPtr); + + /* free old internal represenation */ + if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) + objPtr->typePtr->freeIntRepProc(objPtr); + + /* initial state of format object */ + ObjClockFmtScn(objPtr) = NULL; + ObjLocFmtKey(objPtr) = NULL; + objPtr->typePtr = &ClockFmtObjType; + + return TCL_OK; +}; + +static void +ClockFmtObj_UpdateString(objPtr) + Tcl_Obj *objPtr; +{ + char *name = "UNKNOWN"; + int len; + ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); + + if (fss != NULL) { + Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); + name = hPtr->key.string; + } + len = strlen(name); + objPtr->length = len, + objPtr->bytes = ckalloc((size_t)++len); + if (objPtr->bytes) + memcpy(objPtr->bytes, name, len); +} + +/* + *---------------------------------------------------------------------- + * + * ClockFrmObjGetLocFmtKey -- + * + * Retrieves format key object used to search localized format. + * + * This is normally stored in second pointer of internal representation. + * If format object is not localizable, it is equal the given format + * pointer and the first pointer of internal representation may be NULL. + * + * Results: + * Returns tcl object with key or format object if not localizable. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the key inside its internal representation. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj* +ClockFrmObjGetLocFmtKey( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + Tcl_Obj *keyObj; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + keyObj = ObjLocFmtKey(objPtr); + if (keyObj) { + return keyObj; + } + + keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr)); + Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj); + + return keyObj; +} + +/* + *---------------------------------------------------------------------- + * + * FindOrCreateFmtScnStorage -- + * + * Retrieves format storage for given string format. + * + * This will find the given format in the global storage hash table + * or create a format storage object on demaind and save the + * reference in the first pointer of internal representation of given + * object. + * + * Results: + * Returns scan/format storage pointer to ClockFmtScnStorage. + * + * Side effects: + * Converts given format object to ClockFmtObjType on demand for caching + * the format storage reference inside its internal representation. + * Increments objRefCount of the ClockFmtScnStorage reference. + * + *---------------------------------------------------------------------- + */ + +static ClockFmtScnStorage * +FindOrCreateFmtScnStorage( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + const char *strFmt = TclGetString(objPtr); + ClockFmtScnStorage *fss = NULL; + int new; + Tcl_HashEntry *hPtr; + + Tcl_MutexLock(&ClockFmtMutex); + + /* if not yet initialized */ + if (!initialized) { + /* initialize type */ + memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType)); + ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc; + ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; + + /* initialize hash table */ + Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, + &ClockFmtScnStorageHashKeyType); + + initialized = 1; + Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL); + } + + /* get or create entry (and alocate storage) */ + hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); + if (hPtr != NULL) { + + fss = FmtScn4HashEntry(hPtr); + + #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* unlink if it is currently in GC */ + if (new == 0 && fss->objRefCount == 0) { + ClockFmtScnStorage_GC_Out(fss); + } + #endif + + /* new reference, so increment in lock right now */ + fss->objRefCount++; + + ObjClockFmtScn(objPtr) = fss; + } + + Tcl_MutexUnlock(&ClockFmtMutex); + + if (fss == NULL && interp != NULL) { + Tcl_AppendResult(interp, "retrieve clock format failed \"", + strFmt ? strFmt : "", "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetClockFrmScnFromObj -- + * + * Returns a clock format/scan representation of (*objPtr), if possible. + * If something goes wrong, NULL is returned, and if interp is non-NULL, + * an error message is written there. + * + * Results: + * Valid representation of type ClockFmtScnStorage. + * + * Side effects: + * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr) + * and in global hash table, shared across all threads. + * + *---------------------------------------------------------------------- + */ + +ClockFmtScnStorage * +Tcl_GetClockFrmScnFromObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + ClockFmtScnStorage *fss; + + if (objPtr->typePtr != &ClockFmtObjType) { + if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) { + return NULL; + } + } + + fss = ObjClockFmtScn(objPtr); + + if (fss == NULL) { + fss = FindOrCreateFmtScnStorage(interp, objPtr); + } + + return fss; +} +/* + *---------------------------------------------------------------------- + * + * ClockLocalizeFormat -- + * + * Wrap the format object in options to the localized format, + * corresponding given locale. + * + * This searches localized format in locale catalog, and if not yet + * exists, it executes ::tcl::clock::LocalizeFormat in given interpreter + * and caches its result in the locale catalog. + * + * Results: + * Localized format object. + * + * Side effects: + * Caches the localized format inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj * +ClockLocalizeFormat( + ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = opts->clientData; + Tcl_Obj *valObj = NULL, *keyObj; + + keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); + + /* special case - format object is not localizable */ + if (keyObj == opts->formatObj) { + return opts->formatObj; + } + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to find in cache within locale mc-catalog */ + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + keyObj, &valObj) != TCL_OK) { + return NULL; + } + + /* call LocalizeFormat locale format fmtkey */ + if (valObj == NULL) { + Tcl_Obj *callargs[4]; + callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; + callargs[1] = opts->localeObj; + callargs[2] = opts->formatObj; + callargs[3] = keyObj; + Tcl_IncrRefCount(keyObj); + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + ) { + goto clean; + } + + valObj = Tcl_GetObjResult(opts->interp); + + /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ + if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, + keyObj, valObj) != TCL_OK + ) { + valObj = NULL; + goto clean; + } + + /* check special case - format object is not localizable */ + if (valObj == opts->formatObj) { + /* mark it as unlocalizable, by setting self as key (without refcount incr) */ + if (opts->formatObj->typePtr == &ClockFmtObjType) { + Tcl_UnsetObjRef(ObjLocFmtKey(opts->formatObj)); + ObjLocFmtKey(opts->formatObj) = opts->formatObj; + } + } +clean: + + Tcl_UnsetObjRef(keyObj); + if (valObj) { + Tcl_ResetResult(opts->interp); + } + } + + return (opts->formatObj = valObj); +} + +/* + *---------------------------------------------------------------------- + * + * FindTokenBegin -- + * + * Find begin of given scan token in string, corresponding token type. + * + * Results: + * Position of token inside string if found. Otherwise - end of string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static const char * +FindTokenBegin( + register const char *p, + register const char *end, + ClockScanToken *tok) +{ + char c; + if (p < end) { + /* next token a known token type */ + switch (tok->map->type) { + case CTOKT_DIGIT: + /* should match at least one digit */ + while (!isdigit(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_WORD: + c = *(tok->tokWord.start); + /* should match at least to the first char of this word */ + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_SPACE: + while (!isspace(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {}; + return p; + break; + case CTOKT_CHAR: + c = *((char *)tok->map->data); + while (*p != c && (p = TclUtfNext(p)) < end) {}; + return p; + break; + } + } + return p; +} + +/* + *---------------------------------------------------------------------- + * + * DetermineGreedySearchLen -- + * + * Determine min/max lengths as exact as possible (speed, greedy match). + * + * Results: + * None. Lengths are stored in *minLenPtr, *maxLenPtr. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok, + int *minLenPtr, int *maxLenPtr) +{ + register int minLen = tok->map->minSize; + register int maxLen; + register const char *p = yyInput + minLen, + *end = info->dateEnd; + + /* if still tokens available, try to correct minimum length */ + if ((tok+1)->map) { + end -= tok->endDistance + yySpaceCount; + /* find position of next known token */ + p = FindTokenBegin(p, end, tok+1); + if (p < end) { + minLen = p - yyInput; + } + } + + /* max length to the end regarding distance to end (min-width of following tokens) */ + maxLen = end - yyInput; + /* several amendments */ + if (maxLen > tok->map->maxSize) { + maxLen = tok->map->maxSize; + }; + if (minLen < tok->map->minSize) { + minLen = tok->map->minSize; + } + if (minLen > maxLen) { + maxLen = minLen; + } + if (maxLen > info->dateEnd - yyInput) { + maxLen = info->dateEnd - yyInput; + } + + /* check digits rigth now */ + if (tok->map->type == CTOKT_DIGIT) { + p = yyInput; + end = p + maxLen; + if (end > info->dateEnd) { end = info->dateEnd; }; + while (isdigit(UCHAR(*p)) && p < end) { p++; }; + maxLen = p - yyInput; + } + + /* try to get max length more precise for greedy match, + * check the next ahead token available there */ + if (minLen < maxLen && tok->lookAhTok) { + ClockScanToken *laTok = tok + tok->lookAhTok + 1; + p = yyInput + maxLen; + /* regards all possible spaces here (because they are optional) */ + end = p + tok->lookAhMax + yySpaceCount + 1; + if (end > info->dateEnd) { + end = info->dateEnd; + } + p += tok->lookAhMin; + if (laTok->map && p < end) { + const char *f; + /* try to find laTok between [lookAhMin, lookAhMax] */ + while (minLen < maxLen) { + f = FindTokenBegin(p, end, laTok); + /* if found (not below lookAhMax) */ + if (f < end) { + break; + } + /* try again with fewer length */ + maxLen--; + p--; + end--; + } + } else if (p > end) { + maxLen -= (p - end); + if (maxLen < minLen) { + maxLen = minLen; + } + } + } + + *minLenPtr = minLen; + *maxLenPtr = maxLen; +} + +/* + *---------------------------------------------------------------------- + * + * ObjListSearch -- + * + * Find largest part of the input string from start regarding min and + * max lengths in the given list (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found, TCL_RETURN - not matched, TCL_ERROR in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + +static inline int +ObjListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int *val, + Tcl_Obj **lstv, int lstc, + int minLen, int maxLen) +{ + int i, l, lf = -1; + const char *s, *f, *sf; + /* search in list */ + for (i = 0; i < lstc; i++) { + s = TclGetString(lstv[i]); + l = lstv[i]->length; + + if ( l >= minLen + && (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput + ) { + l = f - yyInput; + if (l < minLen) { + continue; + } + /* found, try to find longest value (greedy search) */ + if (l < maxLen && minLen != maxLen) { + lf = i; + minLen = l + 1; + continue; + } + /* max possible - end of search */ + *val = i; + yyInput += l; + break; + } + } + + /* if found */ + if (i < lstc) { + return TCL_OK; + } + if (lf >= 0) { + *val = lf; + yyInput += minLen - 1; + return TCL_OK; + } + return TCL_RETURN; +} +#if 0 +/* currently unused */ + +static int +LocaleListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, int mcKey, int *val, + int minLen, int maxLen) +{ + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + /* get msgcat value */ + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + return TCL_ERROR; + } + + /* is a list */ + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + } + + /* search in list */ + return ObjListSearch(opts, info, val, lstv, lstc, + minLen, maxLen); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * ClockMCGetListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * given literal index mcKey (and builds it on demand). + * + * Searches localized index in locale catalog, and if not yet exists, + * creates string indexed tree and stores it in the locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +static TclStrIdxTree * +ClockMCGetListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + valObj = ClockMCGet(opts, mcKey); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + goto done; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCGetMultiListIdxTree -- + * + * Retrieves localized string indexed tree in the locale catalog for + * multiple lists by literal indices mcKeys (and builds it on demand). + * + * Searches localized index in locale catalog for mcKey, and if not + * yet exists, creates string indexed tree and stores it in the + * locale catalog. + * + * Results: + * Localized string index tree. + * + * Side effects: + * Caches the localized string index tree inside locale catalog. + * + *---------------------------------------------------------------------- + */ + +static TclStrIdxTree * +ClockMCGetMultiListIdxTree( + ClockFmtScnCmdArgs *opts, + int mcKey, + int *mcKeys) +{ + TclStrIdxTree * idxTree; + Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey); + if ( objPtr != NULL + && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL + ) { + return idxTree; + + } else { + /* build new index */ + + Tcl_Obj **lstv; + int lstc; + Tcl_Obj *valObj; + + objPtr = TclStrIdxTreeNewObj(); + if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) { + goto done; /* unexpected, but ...*/ + } + + while (*mcKeys) { + + valObj = ClockMCGet(opts, *mcKeys); + if (valObj == NULL) { + goto done; + } + + if (TclListObjGetElements(opts->interp, valObj, + &lstc, &lstv) != TCL_OK) { + goto done; + }; + + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + goto done; + } + mcKeys++; + } + + ClockMCSetIdx(opts, mcKey, objPtr); + objPtr = NULL; + }; + +done: + if (objPtr) { + Tcl_DecrRefCount(objPtr); + idxTree = NULL; + } + + return idxTree; +} + +/* + *---------------------------------------------------------------------- + * + * ClockStrIdxTreeSearch -- + * + * Find largest part of the input string from start regarding lengths + * in the given localized string indexed tree (utf-8, case sensitive). + * + * Results: + * TCL_OK - match found and the index stored in *val, + * TCL_RETURN - not matched or ambigous, + * TCL_ERROR - in error case. + * + * Side effects: + * Input points to end of the found token in string. + * + *---------------------------------------------------------------------- + */ + +static inline int +ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, TclStrIdxTree *idxTree, int *val, + int minLen, int maxLen) +{ + const char *f; + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(NULL, &foundItem, idxTree, + yyInput, yyInput + maxLen); + + if (f <= yyInput || (f - yyInput) < minLen) { + /* not found */ + return TCL_RETURN; + } + if (foundItem->value == -1) { + /* ambigous */ + return TCL_RETURN; + } + + *val = foundItem->value; + + /* shift input pointer */ + yyInput = f; + + return TCL_OK; +} +#if 0 +/* currently unused */ + +static int +StaticListSearch(ClockFmtScnCmdArgs *opts, + DateInfo *info, const char **lst, int *val) +{ + int len; + const char **s = lst; + while (*s != NULL) { + len = strlen(*s); + if ( len <= info->dateEnd - yyInput + && strncasecmp(yyInput, *s, len) == 0 + ) { + *val = (s - lst); + yyInput += len; + break; + } + s++; + } + if (*s != NULL) { + return TCL_OK; + } + return TCL_RETURN; +} +#endif + +static inline const char * +FindWordEnd( + ClockScanToken *tok, + register const char * p, const char * end) +{ + register const char *x = tok->tokWord.start; + const char *pfnd = p; + if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */ + if (*p == *x) { + return ++p; + } + } + /* multi-char word */ + x = TclUtfFindEqualNC(x, tok->tokWord.end, p, end, &pfnd); + if (x < tok->tokWord.end) { + /* no match -> error */ + return NULL; + } + return pfnd; +} + +static int +ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ +#if 0 +/* currently unused, test purposes only */ + static const char * months[] = { + /* full */ + "January", "February", "March", + "April", "May", "June", + "July", "August", "September", + "October", "November", "December", + /* abbr */ + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + NULL + }; + int val; + if (StaticListSearch(opts, info, months, &val) != TCL_OK) { + return TCL_RETURN; + } + yyMonth = (val % 12) + 1; + return TCL_OK; +#endif + + static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; + + int ret, val; + int minLen, maxLen; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + yyMonth = val + 1; + return TCL_OK; + +} + +static int +ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0}; + + int ret, val; + int minLen, maxLen; + char curTok = *tok->tokWord.start; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* %u %w %Ou %Ow */ + if ( curTok != 'a' && curTok != 'A' + && ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data)) + ) { + + val = -1; + + if (PTR2INT(tok->map->data) == 0) { + if (*yyInput >= '0' && *yyInput <= '9') { + val = *yyInput - '0'; + } + } else { + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + } + + if (val != -1) { + if (val == 0) { + val = 7; + } + if (val > 7) { + Tcl_SetResult(opts->interp, "day of week is greater than 7", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); + return TCL_ERROR; + } + info->date.dayOfWeek = val; + yyInput++; + return TCL_OK; + } + + + return TCL_RETURN; + } + + /* %a %A */ + idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_DAYS_OF_WEEK_COMB, dowKeys); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val == 0) { + val = 7; + } + info->date.dayOfWeek = val; + return TCL_OK; + +} + +static int +ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + Tcl_Obj *amPmObj[2]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + amPmObj[0] = ClockMCGet(opts, MCLIT_AM); + amPmObj[1] = ClockMCGet(opts, MCLIT_PM); + + if (amPmObj[0] == NULL || amPmObj[1] == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, amPmObj, 2, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val == 0) { + yyMeridian = MERam; + } else { + yyMeridian = MERpm; + } + + return TCL_OK; +} + +static int +ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + ClockClientData *dataPtr = opts->clientData; + + int ret, val; + int minLen, maxLen; + Tcl_Obj *eraObj[6]; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + eraObj[0] = ClockMCGet(opts, MCLIT_BCE); + eraObj[1] = ClockMCGet(opts, MCLIT_CE); + eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2]; + eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2]; + eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3]; + eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3]; + + if (eraObj[0] == NULL || eraObj[1] == NULL) { + return TCL_ERROR; + } + + ret = ObjListSearch(opts, info, &val, eraObj, 6, + minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (val & 1) { + yydate.era = CE; + } else { + yydate.era = BCE; + } + + return TCL_OK; +} + +static int +ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int ret, val; + int minLen, maxLen; + TclStrIdxTree *idxTree; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* get or create tree in msgcat dict */ + + idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); + if (idxTree == NULL) { + return TCL_ERROR; + } + + ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + if (ret != TCL_OK) { + return ret; + } + + if (tok->map->offs > 0) { + *(int *)(((char *)info) + tok->map->offs) = val; + } + + return TCL_OK; +} + +static int +ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + int len = 0; + register const char *p = yyInput; + Tcl_Obj *tzObjStor = NULL; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + /* numeric timezone */ + if (*p == '+' || *p == '-') { + /* max chars in numeric zone = "+00:00:00" */ + #define MAX_ZONE_LEN 9 + char buf[MAX_ZONE_LEN + 1]; + char *bp = buf; + *bp++ = *p++; len++; + if (maxLen > MAX_ZONE_LEN) + maxLen = MAX_ZONE_LEN; + /* cumulate zone into buf without ':' */ + while (len + 1 < maxLen) { + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (!isdigit(UCHAR(*p))) break; + *bp++ = *p++; len++; + if (len + 2 < maxLen) { + if (*p == ':') { + p++; len++; + } + } + } + *bp = '\0'; + + if (len < minLen) { + return TCL_RETURN; + } + #undef MAX_ZONE_LEN + + /* timezone */ + tzObjStor = Tcl_NewStringObj(buf, bp-buf); + } else { + /* legacy (alnum) timezone like CEST, etc. */ + if (maxLen > 4) + maxLen = 4; + while (len < maxLen) { + if ( (*p & 0x80) + || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p))) + ) { /* INTL: ISO only. */ + break; + } + p++; len++; + } + + if (len < minLen) { + return TCL_RETURN; + } + + /* timezone */ + tzObjStor = Tcl_NewStringObj(yyInput, p-yyInput); + + /* convert using dict */ + } + + /* try to apply new time zone */ + Tcl_IncrRefCount(tzObjStor); + + opts->timezoneObj = ClockSetupTimeZone(opts->clientData, opts->interp, + tzObjStor); + + Tcl_DecrRefCount(tzObjStor); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } + + yyInput += len; + + return TCL_OK; +} + +static int +ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + register const char *p = yyInput, *end; const char *s; + int year, fractYear, fractDayDiv, fractDay; + static const char *stardatePref = "stardate "; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + end = yyInput + maxLen; + + /* stardate string */ + p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s); + if (p >= end || p - yyInput < 9) { + return TCL_RETURN; + } + /* bypass spaces */ + while (p < end && isspace(UCHAR(*p))) { + p++; + } + if (p >= end) { + return TCL_RETURN; + } + /* currently positive stardate only */ + if (*p == '+') { p++; }; + s = p; + while (p < end && isdigit(UCHAR(*p))) { + p++; + } + if (p >= end || p - s < 4) { + return TCL_RETURN; + } + if ( _str2int(&year, s, p-3, 1) != TCL_OK + || _str2int(&fractYear, p-3, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + if (*p++ != '.') { + return TCL_RETURN; + } + s = p; + fractDayDiv = 1; + while (p < end && isdigit(UCHAR(*p))) { + fractDayDiv *= 10; + p++; + } + if ( _str2int(&fractDay, s, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + yyInput = p; + + /* Build a date from year and fraction. */ + + yydate.year = year + RODDENBERRY; + yydate.era = CE; + yydate.gregorian = 1; + + if (IsGregorianLeapYear(&yydate)) { + fractYear *= 366; + } else { + fractYear *= 365; + } + yydate.dayOfYear = fractYear / 1000 + 1; + if (fractYear % 1000 >= 500) { + yydate.dayOfYear++; + } + + GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + + yydate.localSeconds = + -210866803200L + + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + + ( SECONDS_PER_DAY * fractDay / fractDayDiv ); + + return TCL_OK; +} + +static const char *ScnSTokenMapIndex = + "dmbyYHMSpJjCgGVazUsntQ"; +static ClockScanTokenMap ScnSTokenMap[] = { + /* %d %e */ + {CTOKT_DIGIT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth), + NULL}, + /* %m %N */ + {CTOKT_DIGIT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), + NULL}, + /* %b %B %h */ + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0, + ClockScnToken_Month_Proc}, + /* %y */ + {CTOKT_DIGIT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), + NULL}, + /* %Y */ + {CTOKT_DIGIT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year), + NULL}, + /* %H %k %I %l */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), + NULL}, + /* %M */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes), + NULL}, + /* %S */ + {CTOKT_DIGIT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfDay), + NULL}, + /* %p %P */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_amPmInd_Proc, NULL}, + /* %J */ + {CTOKT_DIGIT, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + NULL}, + /* %j */ + {CTOKT_DIGIT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear), + NULL}, + /* %C */ + {CTOKT_DIGIT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), + NULL}, + /* %g */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year), + NULL}, + /* %G */ + {CTOKT_DIGIT, CLF_ISO8601YEAR | CLF_ISO8601 | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year), + NULL}, + /* %V */ + {CTOKT_DIGIT, CLF_ISO8601, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), + NULL}, + /* %a %A %u %w */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_DayOfWeek_Proc, NULL}, + /* %z %Z */ + {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0xffff, 0, + ClockScnToken_TimeZone_Proc, NULL}, + /* %U %W */ + {CTOKT_DIGIT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */ + NULL}, + /* %s */ + {CTOKT_DIGIT, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), + NULL}, + /* %n */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, + /* %t */ + {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"}, + /* %Q */ + {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0, + ClockScnToken_StarDate_Proc, NULL}, +}; +static const char *ScnSTokenMapAliasIndex[2] = { + "eNBhkIlPAuwZW", + "dmbbHHHpaaazU" +}; + +static const char *ScnETokenMapIndex = + "Eys"; +static ClockScanTokenMap ScnETokenMap[] = { + /* %EE */ + {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ey */ + {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Es */ + {CTOKT_DIGIT, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), + NULL}, +}; +static const char *ScnETokenMapAliasIndex[2] = { + "", + "" +}; + +static const char *ScnOTokenMapIndex = + "dmyHMSu"; +static ClockScanTokenMap ScnOTokenMap[] = { + /* %Od %Oe */ + {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.dayOfMonth), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.month), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CTOKT_PARSER, CLF_YEAR, 0, 0, 0xffff, TclOffset(DateInfo, date.year), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok %OI %Ol */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.hour), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.minutes), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.secondOfDay), + ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou Ow */ + {CTOKT_PARSER, CLF_ISO8601, 0, 0, 0xffff, 0, + ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS}, +}; +static const char *ScnOTokenMapAliasIndex[2] = { + "ekIlw", + "dHHHu" +}; + +static const char *ScnSpecTokenMapIndex = + " "; +static ClockScanTokenMap ScnSpecTokenMap[] = { + {CTOKT_SPACE, 0, 0, 1, 1, 0, + NULL}, +}; + +static ClockScanTokenMap ScnWordTokenMap = { + CTOKT_WORD, 0, 0, 1, 1, 0, + NULL +}; + + +static inline unsigned int +EstimateTokenCount( + register const char *fmt, + register const char *end) +{ + register const char *p = fmt; + unsigned int tokcnt; + /* estimate token count by % char and format length */ + tokcnt = 0; + while (p <= end) { + if (*p++ == '%') { + tokcnt++; + p++; + } + } + p = fmt + tokcnt * 2; + if (p < end) { + if ((unsigned int)(end - p) < tokcnt) { + tokcnt += (end - p); + } else { + tokcnt += tokcnt; + } + } + return ++tokcnt; +} + +#define AllocTokenInChain(tok, chain, tokCnt) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + *((char **)&chain) = ckrealloc((char *)(chain), \ + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ + if ((chain) == NULL) { goto done; }; \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ + memset(tok, 0, sizeof(*(tok))); + +/* + *---------------------------------------------------------------------- + */ +ClockFmtScnStorage * +ClockGetOrParseScanFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockScanToken *tok; + + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); + if (fss == NULL) { + return NULL; + } + + /* if first time scanning - tokenize format */ + if (fss->scnTok == NULL) { + unsigned int tokCnt; + register const char *p, *e, *cp; + + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); + + /* estimate token count by % char and format length */ + fss->scnTokC = EstimateTokenCount(p, e); + + fss->scnSpaceCount = 0; + + Tcl_MutexLock(&ClockFmtMutex); + + fss->scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); + memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; + while (p < e) { + switch (*p) { + case '%': + if (1) { + ClockScanTokenMap * scnMap = ScnSTokenMap; + const char *mapIndex = ScnSTokenMapIndex, + **aliasIndex = ScnSTokenMapAliasIndex; + if (p+1 >= e) { + goto word_tok; + } + p++; + /* try to find modifier: */ + switch (*p) { + case '%': + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &ScnWordTokenMap; + tok->tokWord.start = p; + tok->tokWord.end = p+1; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + break; + case 'E': + scnMap = ScnETokenMap, + mapIndex = ScnETokenMapIndex, + aliasIndex = ScnETokenMapAliasIndex; + p++; + break; + case 'O': + scnMap = ScnOTokenMap, + mapIndex = ScnOTokenMapIndex, + aliasIndex = ScnOTokenMapAliasIndex; + p++; + break; + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(aliasIndex[0], *p); + if (!cp || *cp == '\0') { + p--; if (scnMap != ScnSTokenMap) p--; + goto word_tok; + } + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; if (scnMap != ScnSTokenMap) p--; + goto word_tok; + } + } + tok->map = &scnMap[cp - mapIndex]; + tok->tokWord.start = p; + + /* calculate look ahead value by standing together tokens */ + if (tok > fss->scnTok) { + ClockScanToken *prevTok = tok - 1; + + while (prevTok >= fss->scnTok) { + if (prevTok->map->type != tok->map->type) { + break; + } + prevTok->lookAhMin += tok->map->minSize; + prevTok->lookAhMax += tok->map->maxSize; + prevTok->lookAhTok++; + prevTok--; + } + } + + /* increase space count used in format */ + if ( tok->map->type == CTOKT_CHAR + && isspace(UCHAR(*((char *)tok->map->data))) + ) { + fss->scnSpaceCount++; + } + + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + } + break; + case ' ': + cp = strchr(ScnSpecTokenMapIndex, *p); + if (!cp || *cp == '\0') { + p--; + goto word_tok; + } + tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; + /* increase space count used in format */ + fss->scnSpaceCount++; + /* next token */ + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + p++; + continue; + break; + default: +word_tok: + if (1) { + ClockScanToken *wordTok = tok; + if (tok > fss->scnTok && (tok-1)->map == &ScnWordTokenMap) { + wordTok = tok-1; + } + /* new word token */ + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &ScnWordTokenMap; + AllocTokenInChain(tok, fss->scnTok, fss->scnTokC); tokCnt++; + } + if (isspace(UCHAR(*p))) { + fss->scnSpaceCount++; + } + p = TclUtfNext(p); + wordTok->tokWord.end = p; + } + break; + } + } + + /* calculate end distance value for each tokens */ + if (tok > fss->scnTok) { + unsigned int endDist = 0; + ClockScanToken *prevTok = tok-1; + + while (prevTok >= fss->scnTok) { + prevTok->endDistance = endDist; + if (prevTok->map->type != CTOKT_WORD) { + endDist += prevTok->map->minSize; + } else { + endDist += prevTok->tokWord.end - prevTok->tokWord.start; + } + prevTok--; + } + } + + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->scnTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->scnTok = tok; + } + } + fss->scnTokC = tokCnt; + +done: + Tcl_MutexUnlock(&ClockFmtMutex); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + */ +int +ClockScan( + register DateInfo *info, /* Date fields used for parsing & converting */ + Tcl_Obj *strObj, /* String containing the time to scan */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockClientData *dataPtr = opts->clientData; + ClockFmtScnStorage *fss; + ClockScanToken *tok; + ClockScanTokenMap *map; + register const char *p, *x, *end; + unsigned short int flags = 0; + int ret = TCL_ERROR; + + /* get localized format */ + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + + if ( !(fss = ClockGetOrParseScanFormat(opts->interp, opts->formatObj)) + || !(tok = fss->scnTok) + ) { + return TCL_ERROR; + } + + /* prepare parsing */ + + yyMeridian = MER24; + + p = TclGetString(strObj); + end = p + strObj->length; + /* in strict mode - bypass spaces at begin / end only (not between tokens) */ + if (opts->flags & CLF_STRICT) { + while (p < end && isspace(UCHAR(*p))) { + p++; + } + } + yyInput = p; + /* look ahead to count spaces (bypass it by count length and distances) */ + x = end; + while (p < end) { + if (isspace(UCHAR(*p))) { + x = p++; + yySpaceCount++; + continue; + } + x = end; + p++; + } + /* ignore spaces at end */ + yySpaceCount -= (end - x); + end = x; + /* ignore mandatory spaces used in format */ + yySpaceCount -= fss->scnSpaceCount; + if (yySpaceCount < 0) { + yySpaceCount = 0; + } + info->dateStart = p = yyInput; + info->dateEnd = end; + + /* parse string */ + for (; tok->map != NULL; tok++) { + map = tok->map; + /* bypass spaces at begin of input before parsing each token */ + if ( !(opts->flags & CLF_STRICT) + && ( map->type != CTOKT_SPACE + && map->type != CTOKT_WORD + && map->type != CTOKT_CHAR ) + ) { + while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; + p++; + } + } + yyInput = p; + /* end of input string */ + if (p >= end) { + break; + } + switch (map->type) + { + case CTOKT_DIGIT: + if (1) { + int minLen, size; + int sign = 1; + if (map->flags & CLF_SIGNED) { + if (*p == '+') { yyInput = ++p; } + else + if (*p == '-') { yyInput = ++p; sign = -1; }; + } + + DetermineGreedySearchLen(opts, info, tok, &minLen, &size); + + if (size < map->minSize) { + /* missing input -> error */ + if ((map->flags & CLF_OPTIONAL)) { + continue; + } + goto not_match; + } + /* string 2 number, put number into info structure by offset */ + if (map->offs) { + p = yyInput; x = p + size; + if (!(map->flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { + if (_str2int((int *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } + p = x; + } + flags = (flags & ~map->clearFlags) | map->flags; + } + } + break; + case CTOKT_PARSER: + switch (map->parser(opts, info, tok)) { + case TCL_OK: + break; + case TCL_RETURN: + if ((map->flags & CLF_OPTIONAL)) { + yyInput = p; + continue; + } + goto not_match; + break; + default: + goto done; + break; + }; + /* decrement count for possible spaces in match */ + while (p < yyInput) { + if (isspace(UCHAR(*p++))) { + yySpaceCount--; + } + } + p = yyInput; + flags = (flags & ~map->clearFlags) | map->flags; + break; + case CTOKT_SPACE: + /* at least one space */ + if (!isspace(UCHAR(*p))) { + /* unmatched -> error */ + goto not_match; + } + yySpaceCount--; + p++; + while (p < end && isspace(UCHAR(*p))) { + yySpaceCount--; + p++; + } + break; + case CTOKT_WORD: + x = FindWordEnd(tok, p, end); + if (!x) { + /* no match -> error */ + goto not_match; + } + p = x; + break; + case CTOKT_CHAR: + x = (char *)map->data; + if (*x != *p) { + /* no match -> error */ + goto not_match; + } + if (isspace(UCHAR(*x))) { + yySpaceCount--; + } + p++; + break; + } + } + /* check end was reached */ + if (p < end) { + /* something after last token - wrong format */ + goto not_match; + } + /* end of string, check only optional tokens at end, otherwise - not match */ + while (tok->map != NULL) { + if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) { + tok++; + if (tok->map == NULL) break; + } + if (!(tok->map->flags & CLF_OPTIONAL)) { + goto not_match; + } + tok++; + } + + /* + * Invalidate result + */ + + /* seconds token (%s) take precedence over all other tokens */ + if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) { + if (flags & CLF_DATE) { + + if (!(flags & CLF_JULIANDAY)) { + info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY; + + /* dd precedence below ddd */ + switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) { + case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* miss month: ddd over dd (without month) */ + flags &= ~CLF_DAYOFMONTH; + case (CLF_DAYOFYEAR): + /* ddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH): + /* both available: mmdd over ddd */ + flags &= ~CLF_DAYOFYEAR; + case (CLF_MONTH|CLF_DAYOFMONTH): + case (CLF_DAYOFMONTH): + /* mmdd / dd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + break; + } + + /* YearWeekDay below YearMonthDay */ + if ( (flags & CLF_ISO8601) + && ( (flags & (CLF_YEAR|CLF_DAYOFYEAR)) == (CLF_YEAR|CLF_DAYOFYEAR) + || (flags & (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH)) == (CLF_YEAR|CLF_DAYOFMONTH|CLF_MONTH) + ) + ) { + /* yy precedence below yyyy */ + if (!(flags & CLF_ISO8601CENTURY) && (flags & CLF_CENTURY)) { + /* normally precedence of ISO is higher, but no century - so put it down */ + flags &= ~CLF_ISO8601; + } + else + /* yymmdd or yyddd over naked weekday */ + if (!(flags & CLF_ISO8601YEAR)) { + flags &= ~CLF_ISO8601; + } + } + + if (!(flags & CLF_ISO8601)) { + if (yyYear < 100) { + if (!(flags & CLF_CENTURY)) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } else { + yyYear += info->dateCentury * 100; + } + } + } else { + if (info->date.iso8601Year < 100) { + if (!(flags & CLF_ISO8601CENTURY)) { + if (info->date.iso8601Year >= dataPtr->yearOfCenturySwitch) { + info->date.iso8601Year -= 100; + } + info->date.iso8601Year += dataPtr->currentYearCentury; + } else { + info->date.iso8601Year += info->dateCentury * 100; + } + } + } + } + } + + /* if no time - reset time */ + if (!(flags & (CLF_TIME|CLF_LOCALSEC|CLF_POSIXSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yydate.localSeconds = 0; + } + + if (flags & CLF_TIME) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + } else + if (!(flags & (CLF_LOCALSEC|CLF_POSIXSEC))) { + info->flags |= CLF_ASSEMBLE_SECONDS; + yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + } + } + + /* tell caller which flags were set */ + info->flags |= flags; + + ret = TCL_OK; + goto done; + +overflow: + + Tcl_SetResult(opts->interp, "requested date too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + goto done; + +not_match: + + Tcl_SetResult(opts->interp, "input string does not match supplied format", + TCL_STATIC); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); + +done: + + return ret; +} + +static inline int +FrmResultAllocate( + register DateFormat *dateFmt, + int len) +{ + int needed = dateFmt->output + len - dateFmt->resEnd; + if (needed >= 0) { /* >= 0 - regards NTS zero */ + int newsize = dateFmt->resEnd - dateFmt->resMem + + needed + MIN_FMT_RESULT_BLOCK_ALLOC; + char *newRes = ckrealloc(dateFmt->resMem, newsize); + if (newRes == NULL) { + return TCL_ERROR; + } + dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem); + dateFmt->resMem = newRes; + dateFmt->resEnd = newRes + newsize; + } + return TCL_OK; +} + +static int +ClockFmtToken_HourAMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + *val = ( ( ( *val % SECONDS_PER_DAY ) + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1; + return TCL_OK; +} + +static int +ClockFmtToken_AMPM_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if ((*val % SECONDS_PER_DAY) < (SECONDS_PER_DAY / 2)) { + mcObj = ClockMCGet(opts, MCLIT_AM); + } else { + mcObj = ClockMCGet(opts, MCLIT_PM); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + if (*tok->tokWord.start == 'p') { + len = Tcl_UtfToUpper(dateFmt->output); + } + dateFmt->output += len; + + return TCL_OK; +} + +static int +ClockFmtToken_StarDate_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) + { + int fractYear; + /* Get day of year, zero based */ + int doy = dateFmt->date.dayOfYear - 1; + + /* Convert day of year to a fractional year */ + if (IsGregorianLeapYear(&dateFmt->date)) { + fractYear = 1000 * doy / 366; + } else { + fractYear = 1000 * doy / 365; + } + + /* Put together the StarDate as "Stardate %02d%03d.%1d" */ + if (FrmResultAllocate(dateFmt, 30) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, "Stardate ", 9); + dateFmt->output += 9; + dateFmt->output = _itoaw(dateFmt->output, + dateFmt->date.year - RODDENBERRY, '0', 2); + dateFmt->output = _itoaw(dateFmt->output, + fractYear, '0', 3); + *dateFmt->output++ = '.'; + dateFmt->output = _itoaw(dateFmt->output, + dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); + + return TCL_OK; +} +static int +ClockFmtToken_WeekOfYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int dow = dateFmt->date.dayOfWeek; + if (*tok->tokWord.start == 'U') { + if (dow == 7) { + dow = 0; + } + dow++; + } + *val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7; + return TCL_OK; +} +static int +ClockFmtToken_TimeZone_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + if (*tok->tokWord.start == 'z') { + int z = dateFmt->date.tzOffset; + char sign = '+'; + if ( z < 0 ) { + z = -z; + sign = '-'; + } + if (FrmResultAllocate(dateFmt, 7) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = sign; + dateFmt->output = _itoaw(dateFmt->output, z / 3600, '0', 2); + z %= 3600; + dateFmt->output = _itoaw(dateFmt->output, z / 60, '0', 2); + z %= 60; + if (z != 0) { + dateFmt->output = _itoaw(dateFmt->output, z, '0', 2); + } + } else { + Tcl_Obj * objPtr; + const char *s; int len; + /* convert seconds to local seconds to obtain tzName object */ + if (ConvertUTCToLocal(opts->clientData, opts->interp, + &dateFmt->date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { + return TCL_ERROR; + }; + objPtr = dateFmt->date.tzName; + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERA_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + Tcl_Obj *mcObj; + const char *s; + int len; + + if (dateFmt->date.era == BCE) { + mcObj = ClockMCGet(opts, MCLIT_BCE); + } else { + mcObj = ClockMCGet(opts, MCLIT_CE); + } + if (mcObj == NULL) { + return TCL_ERROR; + } + s = TclGetString(mcObj); len = mcObj->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + + return TCL_OK; +} + +static int +ClockFmtToken_LocaleERAYear_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) +{ + int rowc; + Tcl_Obj **rowv; + + if (dateFmt->localeEra == NULL) { + Tcl_Obj *mcObj = ClockMCGet(opts, MCLIT_LOCALE_ERAS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { + return TCL_ERROR; + } + if (rowc != 0) { + dateFmt->localeEra = LookupLastTransition(opts->interp, + dateFmt->date.localSeconds, rowc, rowv, NULL); + } + if (dateFmt->localeEra == NULL) { + dateFmt->localeEra = (Tcl_Obj*)1; + } + } + + /* if no LOCALE_ERAS in catalog or era not found */ + if (dateFmt->localeEra == (Tcl_Obj*)1) { + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + if (*tok->tokWord.start == 'C') { /* %EC */ + *val = dateFmt->date.year / 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } else { /* %Ey */ + *val = dateFmt->date.year % 100; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + } + } else { + Tcl_Obj *objPtr; + const char *s; + int len; + if (*tok->tokWord.start == 'C') { /* %EC */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + } else { /* %Ey */ + if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 2, + &objPtr) != TCL_OK ) { + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) { + return TCL_ERROR; + } + *val = dateFmt->date.year - *val; + /* if year in locale numerals */ + if (*val >= 0 && *val < 100) { + /* year as integer */ + Tcl_Obj * mcObj = ClockMCGet(opts, MCLIT_LOCALE_NUMERALS); + if (mcObj == NULL) { + return TCL_ERROR; + } + if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + /* year as integer */ + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; }; + dateFmt->output = _itoaw(dateFmt->output, + *val, '0', 2); + return TCL_OK; + } + } + s = TclGetString(objPtr); + len = objPtr->length; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; + memcpy(dateFmt->output, s, len + 1); + dateFmt->output += len; + } + return TCL_OK; +} + + +static const char *FmtSTokenMapIndex = + "demNbByYCHMSIklpaAuwUVzgGjJsntQ"; +static ClockFormatTokenMap FmtSTokenMap[] = { + /* %d */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %e */ + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + /* %m */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %N */ + {CFMTT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + /* %b %h */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_ABBREV}, + /* %B */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_MONTHS_FULL}, + /* %y */ + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, + /* %Y */ + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, + /* %C */ + {CFMTT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, + /* %H */ + {CFMTT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %M */ + {CFMTT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %S */ + {CFMTT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %I */ + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %k */ + {CFMTT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + /* %l */ + {CFMTT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, NULL}, + /* %p %P */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_AMPM_Proc, NULL}, + /* %a */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV}, + /* %A */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL}, + /* %u */ + {CFMTT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %w */ + {CFMTT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL}, + /* %U %W */ + {CFMTT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear), + ClockFmtToken_WeekOfYear_Proc, NULL}, + /* %V */ + {CFMTT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, + /* %z %Z */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_TimeZone_Proc, NULL}, + /* %g */ + {CFMTT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %G */ + {CFMTT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, + /* %j */ + {CFMTT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, + /* %J */ + {CFMTT_INT, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + /* %s */ + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + /* %n */ + {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, + /* %t */ + {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, + /* %Q */ + {CFMTT_INT, NULL, 0, 0, 0, 0, 0, + ClockFmtToken_StarDate_Proc, NULL}, +}; +static const char *FmtSTokenMapAliasIndex[2] = { + "hPWZ", + "bpUz" +}; + +static const char *FmtETokenMapIndex = + "Eys"; +static ClockFormatTokenMap FmtETokenMap[] = { + /* %EE */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era), + ClockFmtToken_LocaleERA_Proc, NULL}, + /* %Ey %EC */ + {CFMTT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), + ClockFmtToken_LocaleERAYear_Proc, NULL}, + /* %Es */ + {CFMTT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL}, +}; +static const char *FmtETokenMapAliasIndex[2] = { + "C", + "y" +}; + +static const char *FmtOTokenMapIndex = + "dmyHIMSuw"; +static ClockFormatTokenMap FmtOTokenMap[] = { + /* %Od %Oe */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfMonth), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Om */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.month), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Oy */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.year), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OH %Ok */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 3600, 24, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OI %Ol */ + {CFMTT_INT, NULL, 0, CLFMT_CALC | CLFMT_LOCALE_INDX, 0, 0, TclOffset(DateFormat, date.secondOfDay), + ClockFmtToken_HourAMPM_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OM */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 60, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %OS */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 60, TclOffset(DateFormat, date.secondOfDay), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ou */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ow */ + {CFMTT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), + NULL, (void *)MCLIT_LOCALE_NUMERALS}, +}; +static const char *FmtOTokenMapAliasIndex[2] = { + "ekl", + "dHI" +}; + +static ClockFormatTokenMap FmtWordTokenMap = { + CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL +}; + +/* + *---------------------------------------------------------------------- + */ +ClockFmtScnStorage * +ClockGetOrParseFmtFormat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *formatObj) /* Format container */ +{ + ClockFmtScnStorage *fss; + ClockFormatToken *tok; + + fss = Tcl_GetClockFrmScnFromObj(interp, formatObj); + if (fss == NULL) { + return NULL; + } + + /* if first time scanning - tokenize format */ + if (fss->fmtTok == NULL) { + unsigned int tokCnt; + register const char *p, *e, *cp; + + e = p = HashEntry4FmtScn(fss)->key.string; + e += strlen(p); + + /* estimate token count by % char and format length */ + fss->fmtTokC = EstimateTokenCount(p, e); + + Tcl_MutexLock(&ClockFmtMutex); + + fss->fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC); + memset(tok, 0, sizeof(*(tok))); + tokCnt = 1; + while (p < e) { + switch (*p) { + case '%': + if (1) { + ClockFormatTokenMap * fmtMap = FmtSTokenMap; + const char *mapIndex = FmtSTokenMapIndex, + **aliasIndex = FmtSTokenMapAliasIndex; + if (p+1 >= e) { + goto word_tok; + } + p++; + /* try to find modifier: */ + switch (*p) { + case '%': + /* begin new word token - don't join with previous word token, + * because current mapping should be "...%%..." -> "...%..." */ + tok->map = &FmtWordTokenMap; + tok->tokWord.start = p; + tok->tokWord.end = p+1; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + p++; + continue; + break; + case 'E': + fmtMap = FmtETokenMap, + mapIndex = FmtETokenMapIndex, + aliasIndex = FmtETokenMapAliasIndex; + p++; + break; + case 'O': + fmtMap = FmtOTokenMap, + mapIndex = FmtOTokenMapIndex, + aliasIndex = FmtOTokenMapAliasIndex; + p++; + break; + } + /* search direct index */ + cp = strchr(mapIndex, *p); + if (!cp || *cp == '\0') { + /* search wrapper index (multiple chars for same token) */ + cp = strchr(aliasIndex[0], *p); + if (!cp || *cp == '\0') { + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]); + if (!cp || *cp == '\0') { /* unexpected, but ... */ + #ifdef DEBUG + Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p); + #endif + p--; if (fmtMap != FmtSTokenMap) p--; + goto word_tok; + } + } + tok->map = &fmtMap[cp - mapIndex]; + tok->tokWord.start = p; + /* next token */ + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + p++; + continue; + } + break; + default: +word_tok: + if (1) { + ClockFormatToken *wordTok = tok; + if (tok > fss->fmtTok && (tok-1)->map == &FmtWordTokenMap) { + wordTok = tok-1; + } + if (wordTok == tok) { + wordTok->tokWord.start = p; + wordTok->map = &FmtWordTokenMap; + AllocTokenInChain(tok, fss->fmtTok, fss->fmtTokC); tokCnt++; + } + p = TclUtfNext(p); + wordTok->tokWord.end = p; + } + break; + } + } + + /* correct count of real used tokens and free mem if desired + * (1 is acceptable delta to prevent memory fragmentation) */ + if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { + if ( (tok = ckrealloc(fss->fmtTok, tokCnt * sizeof(*tok))) != NULL ) { + fss->fmtTok = tok; + } + } + fss->fmtTokC = tokCnt; + +done: + Tcl_MutexUnlock(&ClockFmtMutex); + } + + return fss; +} + +/* + *---------------------------------------------------------------------- + */ +int +ClockFormat( + register DateFormat *dateFmt, /* Date fields used for parsing & converting */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + ClockFmtScnStorage *fss; + ClockFormatToken *tok; + ClockFormatTokenMap *map; + + /* get localized format */ + if (ClockLocalizeFormat(opts) == NULL) { + return TCL_ERROR; + } + + if ( !(fss = ClockGetOrParseFmtFormat(opts->interp, opts->formatObj)) + || !(tok = fss->fmtTok) + ) { + return TCL_ERROR; + } + + /* prepare formatting */ + dateFmt->date.secondOfDay = (int)(dateFmt->date.localSeconds % SECONDS_PER_DAY); + if (dateFmt->date.secondOfDay < 0) { + dateFmt->date.secondOfDay += SECONDS_PER_DAY; + } + + /* result container object */ + dateFmt->resMem = ckalloc(MIN_FMT_RESULT_BLOCK_ALLOC); + if (dateFmt->resMem == NULL) { + return TCL_ERROR; + } + dateFmt->output = dateFmt->resMem; + dateFmt->resEnd = dateFmt->resMem + MIN_FMT_RESULT_BLOCK_ALLOC; + *dateFmt->output = '\0'; + + /* do format each token */ + for (; tok->map != NULL; tok++) { + map = tok->map; + switch (map->type) + { + case CFMTT_INT: + if (1) { + int val = (int)*(int *)(((char *)dateFmt) + map->offs); + if (map->fmtproc == NULL) { + if (map->flags & CLFMT_DECR) { + val--; + } + if (map->flags & CLFMT_INCR) { + val++; + } + if (map->divider) { + val /= map->divider; + } + if (map->divmod) { + val %= map->divmod; + } + } else { + if (map->fmtproc(opts, dateFmt, tok, &val) != TCL_OK) { + goto done; + } + /* if not calculate only (output inside fmtproc) */ + if (!(map->flags & CLFMT_CALC)) { + continue; + } + } + if (!(map->flags & CLFMT_LOCALE_INDX)) { + if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { goto error; }; + if (map->width) { + dateFmt->output = _itoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } + } else { + const char *s; + Tcl_Obj * mcObj = ClockMCGet(opts, PTR2INT(map->data) /* mcKey */); + if (mcObj == NULL) { + goto error; + } + if ( Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK + || mcObj == NULL + ) { + goto error; + } + s = TclGetString(mcObj); + if (FrmResultAllocate(dateFmt, mcObj->length) != TCL_OK) { goto error; }; + memcpy(dateFmt->output, s, mcObj->length + 1); + dateFmt->output += mcObj->length; + } + } + break; + case CFMTT_WIDE: + if (1) { + Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs); + if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; }; + if (map->width) { + dateFmt->output = _witoaw(dateFmt->output, val, *map->tostr, map->width); + } else { + dateFmt->output += sprintf(dateFmt->output, map->tostr, val); + } + } + break; + case CTOKT_CHAR: + if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; }; + *dateFmt->output++ = *map->tostr; + break; + case CFMTT_PROC: + if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) { + goto error; + }; + break; + case CTOKT_WORD: + if (1) { + int len = tok->tokWord.end - tok->tokWord.start; + if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; }; + if (len == 1) { + *dateFmt->output++ = *tok->tokWord.start; + } else { + memcpy(dateFmt->output, tok->tokWord.start, len); + dateFmt->output += len; + } + } + break; + } + } + + goto done; + +error: + + ckfree(dateFmt->resMem); + dateFmt->resMem = NULL; + +done: + + if (dateFmt->resMem) { + Tcl_Obj * result = Tcl_NewObj(); + result->length = dateFmt->output - dateFmt->resMem; + result->bytes = NULL; + result->bytes = ckrealloc(dateFmt->resMem, result->length+1); + if (result->bytes == NULL) { + result->bytes = dateFmt->resMem; + } + result->bytes[result->length] = '\0'; + Tcl_SetObjResult(opts->interp, result); + return TCL_OK; + } + + return TCL_ERROR; +} + + +MODULE_SCOPE void +ClockFrmScnClearCaches(void) +{ + Tcl_MutexLock(&ClockFmtMutex); + /* clear caches ... */ + Tcl_MutexUnlock(&ClockFmtMutex); +} + +static void +ClockFrmScnFinalize( + ClientData clientData) /* Not used. */ +{ + Tcl_MutexLock(&ClockFmtMutex); +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + /* clear GC */ + ClockFmtScnStorage_GC.stackPtr = NULL; + ClockFmtScnStorage_GC.stackBound = NULL; + ClockFmtScnStorage_GC.count = 0; +#endif + if (initialized) { + Tcl_DeleteHashTable(&FmtScnHashTable); + initialized = 0; + } + Tcl_MutexUnlock(&ClockFmtMutex); + Tcl_MutexFinalize(&ClockFmtMutex); +} +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclDate.h b/generic/tclDate.h new file mode 100644 index 0000000..e614f9d --- /dev/null +++ b/generic/tclDate.h @@ -0,0 +1,512 @@ +/* + * tclDate.h -- + * + * This header file handles common usage of clock primitives + * between tclDate.c (yacc), tclClock.c and tclClockFmt.c. + * + * Copyright (c) 2014 Serg G. Brester (aka sebres) + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLCLOCK_H +#define _TCLCLOCK_H + +/* + * Constants + */ + +#define JULIAN_DAY_POSIX_EPOCH 2440588 +#define GREGORIAN_CHANGE_DATE 2361222 +#define SECONDS_PER_DAY 86400 +#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ + * SECONDS_PER_DAY) +#define FOUR_CENTURIES 146097 /* days */ +#define JDAY_1_JAN_1_CE_JULIAN 1721424 +#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 +#define ONE_CENTURY_GREGORIAN 36524 /* days */ +#define FOUR_YEARS 1461 /* days */ +#define ONE_YEAR 365 /* days */ + +#define RODDENBERRY 1946 /* Another epoch (Hi, Jeff!) */ + + +#define CLF_OPTIONAL (1 << 0) /* token is non mandatory */ +#define CLF_POSIXSEC (1 << 1) +#define CLF_LOCALSEC (1 << 2) +#define CLF_JULIANDAY (1 << 3) +#define CLF_TIME (1 << 4) +#define CLF_CENTURY (1 << 6) +#define CLF_DAYOFMONTH (1 << 7) +#define CLF_DAYOFYEAR (1 << 8) +#define CLF_MONTH (1 << 9) +#define CLF_YEAR (1 << 10) +#define CLF_ISO8601YEAR (1 << 12) +#define CLF_ISO8601 (1 << 13) +#define CLF_ISO8601CENTURY (1 << 14) +#define CLF_SIGNED (1 << 15) +/* On demand (lazy) assemble flags */ +#define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */ +#define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ +#define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ + +#define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ + CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | CLF_ISO8601) + +/* + * Enumeration of the string literals used in [clock] + */ + +typedef enum ClockLiteral { + LIT__NIL, + LIT__DEFAULT_FORMAT, + LIT_SYSTEM, LIT_CURRENT, LIT_C, + LIT_BCE, LIT_CE, + LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, + LIT_ERA, LIT_GMT, LIT_GREGORIAN, + LIT_INTEGER_VALUE_TOO_LARGE, + LIT_ISO8601WEEK, LIT_ISO8601YEAR, + LIT_JULIANDAY, LIT_LOCALSECONDS, + LIT_MONTH, + LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, + LIT_YEAR, + LIT_TZDATA, + LIT_GETSYSTEMTIMEZONE, + LIT_SETUPTIMEZONE, + LIT_MCGET, + LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE, + LIT_LOCALIZE_FORMAT, + LIT__END +} ClockLiteral; + +#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ + "", \ + "%a %b %d %H:%M:%S %Z %Y", \ + "system", "current", "C", \ + "BCE", "CE", \ + "dayOfMonth", "dayOfWeek", "dayOfYear", \ + "era", ":GMT", "gregorian", \ + "integer value too large to represent", \ + "iso8601Week", "iso8601Year", \ + "julianDay", "localSeconds", \ + "month", \ + "seconds", "tzName", "tzOffset", \ + "year", \ + "::tcl::clock::TZData", \ + "::tcl::clock::GetSystemTimeZone", \ + "::tcl::clock::SetupTimeZone", \ + "::tcl::clock::mcget", \ + "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ + "::tcl::clock::LocalizeFormat" \ +} + +/* + * Enumeration of the msgcat literals used in [clock] + */ + +typedef enum ClockMsgCtLiteral { + MCLIT__NIL, /* placeholder */ + MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB, + MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB, + MCLIT_AM, MCLIT_PM, + MCLIT_LOCALE_ERAS, + MCLIT_BCE, MCLIT_CE, + MCLIT_BCE2, MCLIT_CE2, + MCLIT_BCE3, MCLIT_CE3, + MCLIT_LOCALE_NUMERALS, + MCLIT__END +} ClockMsgCtLiteral; + +#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ + pref "", \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ + pref "AM", pref "PM", \ + pref "LOCALE_ERAS", \ + pref "BCE", pref "CE", \ + pref "b.c.e.", pref "c.e.", \ + pref "b.c.", pref "a.d.", \ + pref "LOCALE_NUMERALS", \ +} + +/* + * Structure containing the fields used in [clock format] and [clock scan] + */ + +typedef struct TclDateFields { + + /* Cacheable fields: */ + + Tcl_WideInt seconds; /* Time expressed in seconds from the Posix + * epoch */ + Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds + * from the Posix epoch */ + int tzOffset; /* Time zone offset in seconds east of + * Greenwich */ + int julianDay; /* Julian Day Number in local time zone */ + enum {BCE=1, CE=0} era; /* Era */ + int gregorian; /* Flag == 1 if the date is Gregorian */ + int year; /* Year of the era */ + int dayOfYear; /* Day of the year (1 January == 1) */ + int month; /* Month number */ + int dayOfMonth; /* Day of the month */ + int iso8601Year; /* ISO8601 week-based year */ + int iso8601Week; /* ISO8601 week number */ + int dayOfWeek; /* Day of the week */ + int hour; /* Hours of day (in-between time only calculation) */ + int minutes; /* Minutes of day (in-between time only calculation) */ + int secondOfDay; /* Seconds of day (in-between time only calculation) */ + + /* Non cacheable fields: */ + + Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the + * time zone, if set the refCount is incremented */ +} TclDateFields; + +#define ClockCacheableDateFieldsSize \ + TclOffset(TclDateFields, tzName) + +/* + * Structure contains return parsed fields. + */ + +typedef struct DateInfo { + const char *dateStart; + const char *dateInput; + const char *dateEnd; + + TclDateFields date; + + int flags; + + int dateHaveDate; + + int dateMeridian; + int dateHaveTime; + + int dateTimezone; + int dateDSTmode; + int dateHaveZone; + + int dateRelMonth; + int dateRelDay; + int dateRelSeconds; + int dateHaveRel; + + int dateMonthOrdinalIncr; + int dateMonthOrdinal; + int dateHaveOrdinalMonth; + + int dateDayOrdinal; + int dateDayNumber; + int dateHaveDay; + + int *dateRelPointer; + + int dateSpaceCount; + int dateDigitCount; + + int dateCentury; + + Tcl_Obj* messages; /* Error messages */ + const char* separatrix; /* String separating messages */ +} DateInfo; + +#define yydate (info->date) /* Date fields used for converting */ + +#define yyDay (info->date.dayOfMonth) +#define yyMonth (info->date.month) +#define yyYear (info->date.year) + +#define yyHour (info->date.hour) +#define yyMinutes (info->date.minutes) +#define yySeconds (info->date.secondOfDay) + +#define yyDSTmode (info->dateDSTmode) +#define yyDayOrdinal (info->dateDayOrdinal) +#define yyDayNumber (info->dateDayNumber) +#define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr) +#define yyMonthOrdinal (info->dateMonthOrdinal) +#define yyHaveDate (info->dateHaveDate) +#define yyHaveDay (info->dateHaveDay) +#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) +#define yyHaveRel (info->dateHaveRel) +#define yyHaveTime (info->dateHaveTime) +#define yyHaveZone (info->dateHaveZone) +#define yyTimezone (info->dateTimezone) +#define yyMeridian (info->dateMeridian) +#define yyRelMonth (info->dateRelMonth) +#define yyRelDay (info->dateRelDay) +#define yyRelSeconds (info->dateRelSeconds) +#define yyRelPointer (info->dateRelPointer) +#define yyInput (info->dateInput) +#define yyDigitCount (info->dateDigitCount) +#define yySpaceCount (info->dateSpaceCount) + +static inline void +ClockInitDateInfo(DateInfo *info) { + memset(info, 0, sizeof(DateInfo)); +} + +/* + * Structure containing the command arguments supplied to [clock format] and [clock scan] + */ + +#define CLF_EXTENDED (1 << 4) +#define CLF_STRICT (1 << 8) +#define CLF_LOCALE_USED (1 << 15) + +typedef struct ClockFmtScnCmdArgs { + ClientData clientData; /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp; /* Tcl interpreter */ + + Tcl_Obj *formatObj; /* Format */ + Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */ + Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */ + Tcl_Obj *baseObj; /* Base (scan and add) or clockValue (format) */ + int flags; /* Flags control scanning */ + + Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/ +} ClockFmtScnCmdArgs; + +/* + * Structure containing the client data for [clock] + */ + +typedef struct ClockClientData { + size_t refCount; /* Number of live references. */ + Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */ + Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */ + Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_, + * used for quick dictionary search */ + + /* Cache for current clock parameters, imparted via "configure" */ + unsigned long LastTZEpoch; + int currentYearCentury; + int yearOfCenturySwitch; + Tcl_Obj *SystemTimeZone; + Tcl_Obj *SystemSetupTZData; + Tcl_Obj *GMTSetupTimeZone; + Tcl_Obj *GMTSetupTZData; + Tcl_Obj *AnySetupTimeZone; + Tcl_Obj *AnySetupTZData; + Tcl_Obj *LastUnnormSetupTimeZone; + Tcl_Obj *LastSetupTimeZone; + Tcl_Obj *LastSetupTZData; + + Tcl_Obj *CurrentLocale; + Tcl_Obj *CurrentLocaleDict; + Tcl_Obj *LastUnnormUsedLocale; + Tcl_Obj *LastUsedLocale; + Tcl_Obj *LastUsedLocaleDict; + + /* Cache for last base (last-second fast convert if base/tz not changed) */ + struct { + Tcl_Obj *timezoneObj; + TclDateFields Date; + } lastBase; + /* Las-period cache for fast UTC2Local conversion */ + struct { + /* keys */ + Tcl_Obj *timezoneObj; + int changeover; + Tcl_WideInt seconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ + /* values */ + int tzOffset; + Tcl_Obj *tzName; + } UTC2Local; + /* Las-period cache for fast Local2UTC conversion */ + struct { + /* keys */ + Tcl_Obj *timezoneObj; + int changeover; + Tcl_WideInt localSeconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ + /* values */ + int tzOffset; + } Local2UTC; +} ClockClientData; + +#define ClockDefaultYearCentury 2000 +#define ClockDefaultCenturySwitch 38 + +/* + * Meridian: am, pm, or 24-hour style. + */ + +typedef enum _MERIDIAN { + MERam, MERpm, MER24 +} MERIDIAN; + +/* + * Clock scan and format facilities. + */ + +#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 + +#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2 + +typedef struct ClockScanToken ClockScanToken; + + +typedef int ClockScanTokenProc( + ClockFmtScnCmdArgs *opts, + DateInfo *info, + ClockScanToken *tok); + + +typedef enum _CLCKTOK_TYPE { + CTOKT_DIGIT = 1, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR, + CFMTT_INT, CFMTT_WIDE, CFMTT_PROC +} CLCKTOK_TYPE; + +typedef struct ClockScanTokenMap { + unsigned short int type; + unsigned short int flags; + unsigned short int clearFlags; + unsigned short int minSize; + unsigned short int maxSize; + unsigned short int offs; + ClockScanTokenProc *parser; + void *data; +} ClockScanTokenMap; + +typedef struct ClockScanToken { + ClockScanTokenMap *map; + struct { + const char *start; + const char *end; + } tokWord; + unsigned short int endDistance; + unsigned short int lookAhMin; + unsigned short int lookAhMax; + unsigned short int lookAhTok; +} ClockScanToken; + + +#define MIN_FMT_RESULT_BLOCK_ALLOC 200 + +typedef struct DateFormat { + char *resMem; + char *resEnd; + char *output; + + TclDateFields date; + + Tcl_Obj *localeEra; +} DateFormat; + +#define CLFMT_INCR (1 << 3) +#define CLFMT_DECR (1 << 4) +#define CLFMT_CALC (1 << 5) +#define CLFMT_LOCALE_INDX (1 << 8) + +typedef struct ClockFormatToken ClockFormatToken; + +typedef int ClockFormatTokenProc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val); + +typedef struct ClockFormatTokenMap { + unsigned short int type; + const char *tostr; + unsigned short int width; + unsigned short int flags; + unsigned short int divider; + unsigned short int divmod; + unsigned short int offs; + ClockFormatTokenProc *fmtproc; + void *data; +} ClockFormatTokenMap; +typedef struct ClockFormatToken { + ClockFormatTokenMap *map; + struct { + const char *start; + const char *end; + } tokWord; +} ClockFormatToken; + + +typedef struct ClockFmtScnStorage ClockFmtScnStorage; + +typedef struct ClockFmtScnStorage { + int objRefCount; /* Reference count shared across threads */ + ClockScanToken *scnTok; + unsigned int scnTokC; + unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */ + ClockFormatToken *fmtTok; + unsigned int fmtTokC; +#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 + ClockFmtScnStorage *nextPtr; + ClockFmtScnStorage *prevPtr; +#endif +#if 0 + +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, + * stored by offset +sizeof(self) */ +#endif +} ClockFmtScnStorage; + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE int ToSeconds(int Hours, int Minutes, + int Seconds, MERIDIAN Meridian); +MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *); +MODULE_SCOPE void + GetJulianDayFromEraYearWeekDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearMonthDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE void + GetJulianDayFromEraYearDay( + TclDateFields *fields, int changeover); +MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, + TclDateFields *, Tcl_Obj *timezoneObj, int); +MODULE_SCOPE Tcl_Obj * + LookupLastTransition(Tcl_Interp *, Tcl_WideInt, + int, Tcl_Obj *const *, Tcl_WideInt rangesVal[2]); + +MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); + +/* tclClock.c module declarations */ + +MODULE_SCOPE Tcl_Obj * + ClockSetupTimeZone(ClientData clientData, + Tcl_Interp *interp, Tcl_Obj *timezoneObj); + +MODULE_SCOPE Tcl_Obj * + ClockMCDict(ClockFmtScnCmdArgs *opts); +MODULE_SCOPE Tcl_Obj * + ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE Tcl_Obj * + ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey); +MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey, + Tcl_Obj *valObj); + +/* tclClockFmt.c module declarations */ + +MODULE_SCOPE Tcl_Obj* + ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, + Tcl_Obj *objPtr); + +MODULE_SCOPE ClockFmtScnStorage * + Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr); +MODULE_SCOPE Tcl_Obj * + ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE int ClockScan(register DateInfo *info, + Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt, + ClockFmtScnCmdArgs *opts); + +MODULE_SCOPE void ClockFrmScnClearCaches(void); + +#endif /* _TCLCLOCK_H */ diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c new file mode 100644 index 0000000..d9b5da0 --- /dev/null +++ b/generic/tclStrIdxTree.c @@ -0,0 +1,520 @@ +/* + * tclStrIdxTree.c -- + * + * Contains the routines for managing string index tries in Tcl. + * + * This code is back-ported from the tclSE engine, by Serg G. Brester. + * + * Copyright (c) 2016 by Sergey G. Brester aka sebres. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * ----------------------------------------------------------------------- + * + * String index tries are prepaired structures used for fast greedy search of the string + * (index) by unique string prefix as key. + * + * Index tree build for two lists together can be explained in the following datagram + * + * Lists: + * + * {Januar Februar Maerz April Mai Juni Juli August September Oktober November Dezember} + * {Jnr Fbr Mrz Apr Mai Jni Jli Agt Spt Okt Nvb Dzb} + * + * Index-Tree: + * + * j -1 * ... + * anuar 0 * + * u -1 * a -1 + * ni 5 * pril 3 + * li 6 * ugust 7 + * n -1 * gt 7 + * r 0 * s 8 + * i 5 * eptember 8 + * li 6 * pt 8 + * f 1 * oktober 9 + * ebruar 1 * n 10 + * br 1 * ovember 10 + * m -1 * vb 10 + * a -1 * d 11 + * erz 2 * ezember 11 + * i 4 * zb 11 + * rz 2 * + * ... + * + * Thereby value -1 shows pure group items (corresponding ambigous matches). + * + * StrIdxTree's are very fast, so: + * build of above-mentioned tree takes about 10 microseconds. + * search of string index in this tree takes fewer as 0.1 microseconds. + * + */ + +#include "tclInt.h" +#include "tclStrIdxTree.h" + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeSearch -- + * + * Find largest part of string "start" in indexed tree (case sensitive). + * + * Also used for building of string index tree. + * + * Results: + * Return position of UTF character in start after last equal character + * and found item (with parent). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE const char* +TclStrIdxTreeSearch( + TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */ + TclStrIdx **foundItem, /* Return value of found item */ + TclStrIdxTree *tree, /* Index tree will be browsed */ + const char *start, /* UTF string to find in tree */ + const char *end) /* End of string */ +{ + TclStrIdxTree *parent = tree, *prevParent = tree; + TclStrIdx *item = tree->firstPtr, *prevItem = NULL; + const char *s = start, *f, *cin, *cinf, *prevf; + int offs = 0; + + if (item == NULL) { + goto done; + } + + /* search in tree */ + do { + cinf = cin = TclGetString(item->key) + offs; + f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf); + /* if something was found */ + if (f > s) { + /* if whole string was found */ + if (f >= end) { + start = f; + goto done; + }; + /* set new offset and shift start string */ + offs += cinf - cin; + s = f; + /* if match item, go deeper as long as possible */ + if (offs >= item->length && item->childTree.firstPtr) { + /* save previuosly found item (if not ambigous) for + * possible fallback (few greedy match) */ + if (item->value != -1) { + prevf = f; + prevItem = item; + prevParent = parent; + } + parent = &item->childTree; + item = item->childTree.firstPtr; + continue; + } + /* no children - return this item and current chars found */ + start = f; + goto done; + } + + item = item->nextPtr; + + } while (item != NULL); + + /* fallback (few greedy match) not ambigous (has a value) */ + if (prevItem != NULL) { + item = prevItem; + parent = prevParent; + start = prevf; + } + +done: + + if (foundParent) + *foundParent = parent; + if (foundItem) + *foundItem = item; + return start; +} + +MODULE_SCOPE void +TclStrIdxTreeFree( + TclStrIdx *tree) +{ + while (tree != NULL) { + TclStrIdx *t; + Tcl_DecrRefCount(tree->key); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreeFree(tree->childTree.firstPtr); + } + t = tree, tree = tree->nextPtr; + ckfree(t); + } +} + +/* + * Several bidirectional list primitives + */ +inline void +TclStrIdxTreeInsertBranch( + TclStrIdxTree *parent, + register TclStrIdx *item, + register TclStrIdx *child) +{ + if (parent->firstPtr == child) + parent->firstPtr = item; + if (parent->lastPtr == child) + parent->lastPtr = item; + if ( (item->nextPtr = child->nextPtr) ) { + item->nextPtr->prevPtr = item; + child->nextPtr = NULL; + } + if ( (item->prevPtr = child->prevPtr) ) { + item->prevPtr->nextPtr = item; + child->prevPtr = NULL; + } + item->childTree.firstPtr = child; + item->childTree.lastPtr = child; +} + +inline void +TclStrIdxTreeAppend( + register TclStrIdxTree *parent, + register TclStrIdx *item) +{ + if (parent->lastPtr != NULL) { + parent->lastPtr->nextPtr = item; + } + item->prevPtr = parent->lastPtr; + item->nextPtr = NULL; + parent->lastPtr = item; + if (parent->firstPtr == NULL) { + parent->firstPtr = item; + } +} + + +/* + *---------------------------------------------------------------------- + * + * TclStrIdxTreeBuildFromList -- + * + * Build or extend string indexed tree from tcl list. + * + * Important: by multiple lists, optimal tree can be created only if list with + * larger strings used firstly. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TclStrIdxTreeBuildFromList( + TclStrIdxTree *idxTree, + int lstc, + Tcl_Obj **lstv) +{ + Tcl_Obj **lwrv; + int i, ret = TCL_ERROR; + const char *s, *e, *f; + TclStrIdx *item; + + /* create lowercase reflection of the list keys */ + + lwrv = ckalloc(sizeof(Tcl_Obj*) * lstc); + if (lwrv == NULL) { + return TCL_ERROR; + } + for (i = 0; i < lstc; i++) { + lwrv[i] = Tcl_DuplicateObj(lstv[i]); + if (lwrv[i] == NULL) { + return TCL_ERROR; + } + Tcl_IncrRefCount(lwrv[i]); + lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i])); + } + + /* build index tree of the list keys */ + for (i = 0; i < lstc; i++) { + TclStrIdxTree *foundParent = idxTree; + e = s = TclGetString(lwrv[i]); + e += lwrv[i]->length; + + /* ignore empty values (impossible to index it) */ + if (lwrv[i]->length == 0) continue; + + item = NULL; + if (idxTree->firstPtr != NULL) { + TclStrIdx *foundItem; + f = TclStrIdxTreeSearch(&foundParent, &foundItem, + idxTree, s, e); + /* if common prefix was found */ + if (f > s) { + /* ignore element if fulfilled or ambigous */ + if (f == e) { + continue; + } + /* if shortest key was found with the same value, + * just replace its current key with longest key */ + if ( foundItem->value == i + && foundItem->length < lwrv[i]->length + && foundItem->childTree.firstPtr == NULL + ) { + Tcl_SetObjRef(foundItem->key, lwrv[i]); + foundItem->length = lwrv[i]->length; + continue; + } + /* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) ) + * but don't split by fulfilled child of found item ( ii->iii->iiii ) */ + if (foundItem->length != (f - s)) { + /* first split found item (insert one between parent and found + new one) */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + Tcl_InitObjRef(item->key, foundItem->key); + item->length = f - s; + /* set value or mark as ambigous if not the same value of both */ + item->value = (foundItem->value == i) ? i : -1; + /* insert group item between foundParent and foundItem */ + TclStrIdxTreeInsertBranch(foundParent, item, foundItem); + foundParent = &item->childTree; + } else { + /* the new item should be added as child of found item */ + foundParent = &foundItem->childTree; + } + } + } + /* append item at end of found parent */ + item = ckalloc(sizeof(*item)); + if (item == NULL) { + goto done; + } + item->childTree.lastPtr = item->childTree.firstPtr = NULL; + Tcl_InitObjRef(item->key, lwrv[i]); + item->length = lwrv[i]->length; + item->value = i; + TclStrIdxTreeAppend(foundParent, item); + }; + + ret = TCL_OK; + +done: + + if (lwrv != NULL) { + for (i = 0; i < lstc; i++) { + Tcl_DecrRefCount(lwrv[i]); + } + ckfree(lwrv); + } + + if (ret != TCL_OK) { + if (idxTree->firstPtr != NULL) { + TclStrIdxTreeFree(idxTree->firstPtr); + } + } + + return ret; +} + + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr); +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr); + +Tcl_ObjType StrIdxTreeObjType = { + "str-idx-tree", /* name */ + StrIdxTreeObj_FreeIntRepProc, /* freeIntRepProc */ + StrIdxTreeObj_DupIntRepProc, /* dupIntRepProc */ + StrIdxTreeObj_UpdateStringProc, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + +MODULE_SCOPE Tcl_Obj* +TclStrIdxTreeNewObj() +{ + Tcl_Obj *objPtr = Tcl_NewObj(); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &StrIdxTreeObjType; + /* return tree root in internal representation */ + return objPtr; +} + +static void +StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) +{ + /* follow links (smart pointers) */ + if ( srcPtr->internalRep.twoPtrValue.ptr1 != NULL + && srcPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1; + } + /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ + Tcl_InitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1), + srcPtr); + copyPtr->internalRep.twoPtrValue.ptr2 = NULL; + copyPtr->typePtr = &StrIdxTreeObjType; +} + +static void +StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr) +{ + /* follow links (smart pointers) */ + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + /* is a link */ + Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1)); + } else { + /* is a tree */ + TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; + if (tree->firstPtr != NULL) { + TclStrIdxTreeFree(tree->firstPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + } + objPtr->typePtr = NULL; +}; + +static void +StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr) +{ + /* currently only dummy empty string possible */ + objPtr->length = 0; + objPtr->bytes = &tclEmptyString; +}; + +MODULE_SCOPE TclStrIdxTree * +TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) { + /* follow links (smart pointers) */ + if (objPtr->typePtr != &StrIdxTreeObjType) { + return NULL; + } + if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL + && objPtr->internalRep.twoPtrValue.ptr2 == NULL + ) { + objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1; + } + /* return tree root in internal representation */ + return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; +} + +/* + * Several debug primitives + */ +#if 0 +/* currently unused, debug resp. test purposes only */ + +void +TclStrIdxTreePrint( + Tcl_Interp *interp, + TclStrIdx *tree, + int offs) +{ + Tcl_Obj *obj[2]; + const char *s; + Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1)); + while (tree != NULL) { + s = TclGetString(tree->key) + offs; + Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d", + offs, "", tree->length - offs, s, tree->value)); + Tcl_PutsObjCmd(NULL, interp, 2, obj); + Tcl_UnsetObjRef(obj[1]); + if (tree->childTree.firstPtr != NULL) { + TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length); + } + tree = tree->nextPtr; + } + Tcl_UnsetObjRef(obj[0]); +} + + +MODULE_SCOPE int +TclStrIdxTreeTestObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + const char *cs, *cin, *ret; + + static const char *const options[] = { + "index", "puts-index", "findequal", + NULL + }; + enum optionInd { + O_INDEX, O_PUTS_INDEX, O_FINDEQUAL + }; + int optionIndex; + + if (objc < 2) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], options, + "option", 0, &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[1]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case O_FINDEQUAL: + if (objc < 4) { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } + cs = TclGetString(objv[2]); + cin = TclGetString(objv[3]); + ret = TclUtfFindEqual( + cs, cs + objv[1]->length, cin, cin + objv[2]->length); + Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); + break; + case O_INDEX: + case O_PUTS_INDEX: + + if (1) { + Tcl_Obj **lstv; + int i, lstc; + TclStrIdxTree idxTree = {NULL, NULL}; + i = 1; + while (++i < objc) { + if (TclListObjGetElements(interp, objv[i], + &lstc, &lstv) != TCL_OK) { + return TCL_ERROR; + }; + TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv); + } + if (optionIndex == O_PUTS_INDEX) { + TclStrIdxTreePrint(interp, idxTree.firstPtr, 0); + } + TclStrIdxTreeFree(idxTree.firstPtr); + } + break; + } + + return TCL_OK; +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h new file mode 100644 index 0000000..305053c --- /dev/null +++ b/generic/tclStrIdxTree.h @@ -0,0 +1,169 @@ +/* + * tclStrIdxTree.h -- + * + * Declarations of string index tries and other primitives currently + * back-ported from tclSE. + * + * Copyright (c) 2016 Serg G. Brester (aka sebres) + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLSTRIDXTREE_H +#define _TCLSTRIDXTREE_H + + +/* + * Main structures declarations of index tree and entry + */ + +typedef struct TclStrIdxTree { + struct TclStrIdx *firstPtr; + struct TclStrIdx *lastPtr; +} TclStrIdxTree; + +typedef struct TclStrIdx { + struct TclStrIdxTree childTree; + struct TclStrIdx *nextPtr; + struct TclStrIdx *prevPtr; + Tcl_Obj *key; + int length; + int value; +} TclStrIdx; + + +/* + *---------------------------------------------------------------------- + * + * TclUtfFindEqual, TclUtfFindEqualNC -- + * + * Find largest part of string cs in string cin (case sensitive and not). + * + * Results: + * Return position of UTF character in cs after last equal character. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline const char * +TclUtfFindEqual( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine) /* End of cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) break; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfFindEqualNC( + register const char *cs, /* UTF string to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfFindEqualNCInLwr( + register const char *cs, /* UTF string (in anycase) to find in cin. */ + register const char *cse, /* End of cs */ + register const char *cin, /* UTF string (in lowercase) will be browsed. */ + register const char *cine, /* End of cin */ + const char **cinfnd) /* Return position in cin */ +{ + register const char *ret = cs; + Tcl_UniChar ch1, ch2; + do { + cs += TclUtfToUniChar(cs, &ch1); + cin += TclUtfToUniChar(cin, &ch2); + if (ch1 != ch2) { + ch1 = Tcl_UniCharToLower(ch1); + if (ch1 != ch2) break; + } + *cinfnd = cin; + } while ((ret = cs) < cse && cin < cine); + return ret; +} + +static inline const char * +TclUtfNext( + register const char *src) /* The current location in the string. */ +{ + if (((unsigned char) *(src)) < 0xC0) { + return ++src; + } else { + Tcl_UniChar ch; + return src + TclUtfToUniChar(src, &ch); + } +} + + +/* + * Primitives to safe set, reset and free references. + */ + +#define Tcl_UnsetObjRef(obj) \ + if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } +#define Tcl_InitObjRef(obj, val) \ + obj = val; if (obj) { Tcl_IncrRefCount(obj); } +#define Tcl_SetObjRef(obj, val) \ +if (1) { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + Tcl_InitObjRef(obj, nval); \ + if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ + } \ +} + +/* + * Prototypes of module functions. + */ + +MODULE_SCOPE const char* + TclStrIdxTreeSearch(TclStrIdxTree **foundParent, + TclStrIdx **foundItem, TclStrIdxTree *tree, + const char *start, const char *end); + +MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, + int lstc, Tcl_Obj **lstv); + +MODULE_SCOPE Tcl_Obj* + TclStrIdxTreeNewObj(); + +MODULE_SCOPE TclStrIdxTree* + TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); + +#if 1 + +MODULE_SCOPE int TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *, + int, Tcl_Obj *const objv[]); +#endif + +#endif /* _TCLSTRIDXTREE_H */ diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl new file mode 100644 index 0000000..733db1a --- /dev/null +++ b/tests-perf/clock.perf.tcl @@ -0,0 +1,385 @@ +#!/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. +# + + +## set testing defaults: +set ::env(TCL_TZ) :CET + +# warm-up interpeter compiler env, clock platform-related features, +# calibrate timerate measurement functionality: +puts -nonewline "Calibration ... "; flush stdout +puts "done: [lrange \ + [timerate -calibrate {}] \ +0 1]" + +## warm-up test-related features (load clock.tcl, system zones, locales, etc.): +clock scan "" -gmt 1 +clock scan "" +clock scan "" -timezone :CET +clock scan "" -format "" -locale en +clock scan "" -format "" -locale de + +## ------------------------------------------ + +proc {**STOP**} {args} { + return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]" +} + +proc _test_get_commands {lst} { + regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup))} $lst "\n{\\1}" +} + +proc _test_out_total {} { + upvar _ _ + + set tcnt [llength $_(itm)] + if {!$tcnt} { + puts "" + return + } + + set mintm 0x7fffffff + set maxtm 0 + set nett 0 + set wtm 0 + set wcnt 0 + set i 0 + foreach tm $_(itm) { + if {[llength $tm] > 6} { + set nett [expr {$nett + [lindex $tm 6]}] + } + set wtm [expr {$wtm + [lindex $tm 0]}] + set wcnt [expr {$wcnt + [lindex $tm 2]}] + set tm [lindex $tm 0] + if {$tm > $maxtm} {set maxtm $tm; set maxi $i} + if {$tm < $mintm} {set mintm $tm; set mini $i} + incr i + } + + puts [string repeat ** 40] + set s [format "%d cases in %.2f sec." $tcnt [expr {$tcnt * $_(reptime) / 1000.0}]] + if {$nett > 0} { + append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]] + } + puts "Total $s:" + lset _(m) 0 [format %.6f $wtm] + lset _(m) 2 $wcnt + lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f $nett] + } + puts $_(m) + puts "Average:" + lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]] + lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}] + if {[llength $_(m)] > 6} { + lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]] + lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]] + } + puts $_(m) + puts "Min:" + puts [lindex $_(itm) $mini] + puts "Max:" + puts [lindex $_(itm) $maxi] + puts [string repeat ** 40] + puts "" +} + +proc _test_run {reptime lst {outcmd {puts $_(r)}}} { + upvar _ _ + array set _ [list itm {} reptime $reptime] + + foreach _(c) [_test_get_commands $lst] { + puts "% [regsub -all {\n[ \t]*} $_(c) {; }]" + if {[regexp {^\s*\#} $_(c)]} continue + if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} { + puts [if 1 [lindex $_(c) 1]] + continue + } + set _(r) [if 1 $_(c)] + if {$outcmd ne {}} $outcmd + puts [set _(m) [timerate $_(c) $reptime]] + lappend _(itm) $_(m) + puts "" + } + _test_out_total +} + +proc test-format {{reptime 1000}} { + _test_run $reptime { + # Format : short, week only (in gmt) + {clock format 1482525936 -format "%u" -gmt 1} + # Format : short, week only (system zone) + {clock format 1482525936 -format "%u"} + # Format : short, week only (CEST) + {clock format 1482525936 -format "%u" -timezone :CET} + # Format : date only (in gmt) + {clock format 1482525936 -format "%Y-%m-%d" -gmt 1} + # Format : date only (system zone) + {clock format 1482525936 -format "%Y-%m-%d"} + # Format : date only (CEST) + {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M" -timezone :CET} + # Format : time only (in gmt) + {clock format 1482525936 -format "%H:%M:%S" -gmt 1} + # Format : time only (system zone) + {clock format 1482525936 -format "%H:%M:%S"} + # Format : time only (CEST) + {clock format 1482525936 -format "%H:%M:%S" -timezone :CET} + # Format : default (in gmt) + {clock format 1482525936 -gmt 1 -locale en} + # Format : default (system zone) + {clock format 1482525936 -locale en} + # Format : default (CEST) + {clock format 1482525936 -timezone :CET -locale en} + # Format : ISO date-time (in gmt, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1} + # Format : ISO date-time (system zone, CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"} + # Format : ISO date-time (CEST, numeric zone) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET} + # Format : ISO date-time (system zone, CEST) + {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"} + # Format : julian day with time (in gmt): + {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1} + # Format : julian day with time (system zone): + {clock format 1246379415 -format "%J %H:%M:%S"} + + # Format : locale date-time (en): + {clock format 1246379415 -format "%x %X" -locale en} + # Format : locale date-time (de): + {clock format 1246379415 -format "%x %X" -locale de} + + # Format : locale lookup table month: + {clock format 1246379400 -format "%b" -locale en -gmt 1} + # Format : locale lookup 2 tables - month and day: + {clock format 1246379400 -format "%b %Od" -locale en -gmt 1} + # Format : locale lookup 3 tables - week, month and day: + {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1} + # Format : locale lookup 4 tables - week, month, day and year: + {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1} + + # Format : dynamic clock value (without converter caches): + setup {set i 0} + {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} + # Format : dynamic clock value (without any converter caches, zone range overflow): + setup {set i 0} + {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET} + cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]} + + # Format : dynamic format (cacheable) + {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1} + + # Format : all (in gmt, locale en) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en} + # Format : all (in CET, locale de) + {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de} + } +} + +proc test-scan {{reptime 1000}} { + _test_run $reptime { + # Scan : date (in gmt) + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1} + # Scan : date (system time zone, with base) + {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0} + # Scan : date (system time zone, without base) + {clock scan "25.11.2015" -format "%d.%m.%Y"} + # Scan : greedy match + {clock scan "111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1} + # Scan : greedy match (space separated) + {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1} + {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1} + + # Scan : time (in gmt) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1} + # Scan : time (system time zone, with base) + {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000} + # Scan : time (gmt, without base) + {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1} + # Scan : time (system time zone, without base) + {clock scan "10:35:55" -format "%H:%M:%S"} + + # Scan : date-time (in gmt) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1} + # Scan : date-time (system time zone with base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0} + # Scan : date-time (system time zone without base) + {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"} + + # Scan : julian day in gmt + {clock scan 2451545 -format %J -gmt 1} + # Scan : julian day in system TZ + {clock scan 2451545 -format %J} + # Scan : julian day in other TZ + {clock scan 2451545 -format %J -timezone +0200} + # Scan : julian day with time: + {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"} + # Scan : julian day with time (greedy match): + {clock scan "2451545 102030" -format "%J%H%M%S"} + + # Scan : century, lookup table month + {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1} + # Scan : century, lookup table month and day (both entries are first) + {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1} + # Scan : century, lookup table month and day (list scan: entries with position 12 / 31) + {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1} + + # Scan : ISO date-time (CEST) + {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} + # Scan : ISO date-time (UTC) + {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"} + {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"} + + # Scan : locale date-time (en): + {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en} + # Scan : locale date-time (de): + {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de} + + # Scan : dynamic format (cacheable) + {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1} + + break + # # Scan : long format test (allock chain) + # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1} + # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc): + # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + # # Scan : again: + # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1} + } {puts [clock format $_(r) -locale en]} +} + +proc test-freescan {{reptime 1000}} { + _test_run $reptime { + # FreeScan : relative date + {clock scan "5 years 18 months 385 days" -base 0 -gmt 1} + # FreeScan : relative date with relative weekday + {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1} + # FreeScan : relative date with ordinal month + {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1} + # FreeScan : relative date with ordinal month and relative weekday + {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1} + # FreeScan : ordinal month + {clock scan "next January" -base 0 -gmt 1} + # FreeScan : relative week + {clock scan "next Fri" -base 0 -gmt 1} + # FreeScan : relative weekday and week offset + {clock scan "next January + 2 week" -base 0 -gmt 1} + # FreeScan : time only with base + {clock scan "19:18:30" -base 148863600 -gmt 1} + # FreeScan : time only without base, gmt + {clock scan "19:18:30" -gmt 1} + # FreeScan : time only without base, system + {clock scan "19:18:30"} + # 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 : date, supplied time zone gmt + {clock scan "05/08/2016 20:18:30" -timezone :GMT} + # 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} + # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST + {clock scan "19:18:30 MST" -base 148863600 -gmt 1 + clock scan "19:18:30 EST" -base 148863600 + } + } {puts [clock format $_(r) -locale en]} +} + +proc test-add {{reptime 1000}} { + _test_run $reptime { + # Add : years + {clock add 1246379415 5 years -gmt 1} + # Add : months + {clock add 1246379415 18 months -gmt 1} + # Add : weeks + {clock add 1246379415 20 weeks -gmt 1} + # Add : days + {clock add 1246379415 385 days -gmt 1} + # Add : weekdays + {clock add 1246379415 3 weekdays -gmt 1} + + # Add : hours + {clock add 1246379415 5 hours -gmt 1} + # Add : minutes + {clock add 1246379415 55 minutes -gmt 1} + # Add : seconds + {clock add 1246379415 100 seconds -gmt 1} + + # Add : +/- in gmt + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -gmt 1} + # Add : +/- in system timezone + {clock add 1246379415 -5 years +21 months -20 weeks +386 days -19 hours +30 minutes -10 seconds -timezone :CET} + + # Add : gmt + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -gmt 1} + # Add : system timezone + {clock add 1246379415 -5 years 18 months 366 days 5 hours 30 minutes 10 seconds -timezone :CET} + + # Add : all in gmt + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -gmt 1} + # Add : all in system timezone + {clock add 1246379415 4 years 18 months 50 weeks 378 days 3 weekdays 5 hours 30 minutes 10 seconds -timezone :CET} + + } {puts [clock format $_(r) -locale en]} +} + +proc test-other {{reptime 1000}} { + _test_run $reptime { + # Bad zone + {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}} + + # Scan : julian day (overflow) + {catch {clock scan 5373485 -format %J}} + + # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) + {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + } +} + +proc test {{reptime 1000}} { + puts "" + test-format $reptime + test-scan $reptime + test-freescan $reptime + test-add $reptime + test-other $reptime + + puts \n**OK** +} + +test 500; # ms -- cgit v0.12 From 4a5d28ee4e72a4e58dc65546f814c1cd71f3accc Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 09:46:43 +0000 Subject: man for timerate (doc/timerate.n) --- doc/timerate.n | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 doc/timerate.n diff --git a/doc/timerate.n b/doc/timerate.n new file mode 100644 index 0000000..df9a8f7 --- /dev/null +++ b/doc/timerate.n @@ -0,0 +1,114 @@ +'\" +'\" Copyright (c) 2005 Sergey Brester aka sebres. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH timerate n "" Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +timerate \- Time-related execution resp. performance measurement of a script +.SH SYNOPSIS +\fBtimerate \fIscript\fR \fI?time?\fR +.sp +\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR +.sp +\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR +.BE +.SH DESCRIPTION +.PP +The first and second form will evaluate \fIscript\fR until the interval +\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second) +if \fItime\fR is not specified. +.sp +It will then return a canonical tcl-list of the form +.PP +.CS +\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR +.CE +.PP +which indicates: +.IP \(bu +the average amount of time required per iteration, in microseconds (lindex $result 0) +.IP \(bu +the count how many times it was executed (lindex $result 2) +.IP \(bu +the estimated rate per second (lindex $result 4) +.IP \(bu +the estimated real execution time without measurement overhead (lindex $result 6) +.PP +Time is measured in elapsed time using heighest timer resolution as possible, not CPU time. +This command may be used to provide information as to how well the script or a tcl-command +is performing and can help determine bottlenecks and fine-tune application performance. +.PP +\fI-calibrate\fR +. +To measure very fast scripts as exact as posible the calibration process +may be required. + +This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead +of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR. +It can take up to 10 seconds if parameter \fItime\fR is not specified. +.PP +\fI-overhead double\fR +. +This parameter used to supply the measurement overhead of single iteration +(in microseconds) that should be ignored during whole evaluation process. +.PP +\fI-direct\fR +. +Causes direct execution per iteration (not compiled variant of evaluation used). +.PP +In opposition to \fBtime\fR the execution limited here by fixed time instead of +repetition count. +Additionally the compiled variant of the script will be used during whole evaluation +(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified. +Therefore it provides more precise results and prevents very long execution time +by slow scripts resp. scripts with unknown speed. + +.SH EXAMPLE +Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including +operations on variable \fIi\fR) to count to a ten: +.PP +.CS +# calibrate: +timerate -calibrate {} +# measure: +timerate { for {set i 0} {$i<10} {incr i} {} } 5000 +.CE +.PP +Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the +overhead for operations on variable \fIi\fR) to count to a ten: +.PP +.CS +# calibrate for overhead of variable operations: +set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000 +# measure: +timerate { for {set i 0} {$i<10} {incr i} {} } 5000 +.CE +.PP +Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring +overhead of the rest, without measurement how fast it takes for a whole script: +.PP +.CS +# calibrate: +timerate -calibrate {} +# estimate overhead: +set tm 0 +set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0] +# measure using esimated overhead: +set tm 0 +timerate -overhead $ovh { + clock format $tm -format %H + incr tm [expr {24*60*60}]; # overhead for this is ignored +} 5000 +.CE +.SH "SEE ALSO" +time(n) +.SH KEYWORDS +script, timerate, time +.\" Local Variables: +.\" mode: nroff +.\" End: -- cgit v0.12 From c8cfbe73a6df84730116e0513bbb3796f38ac89d Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 12:25:59 +0000 Subject: performance test cases extended: several cases to cover absence of the ensemble overhead --- tests-perf/clock.perf.tcl | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 733db1a..238e536 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -371,8 +371,34 @@ proc test-other {{reptime 1000}} { } } +proc test-ensemble-perf {{reptime 1000}} { + _test_run $reptime { + # Clock clicks (ensemble) + {clock clicks} + # Clock clicks (direct) + {::tcl::clock::clicks} + # Clock seconds (ensemble) + {clock seconds} + # Clock seconds (direct) + {::tcl::clock::seconds} + # Clock microseconds (ensemble) + {clock microseconds} + # Clock microseconds (direct) + {::tcl::clock::microseconds} + # Clock scan (ensemble) + {clock scan ""} + # Clock scan (direct) + {::tcl::clock::scan ""} + # Clock format (ensemble) + {clock format 0 -f %s} + # Clock format (direct) + {::tcl::clock::format 0 -f %s} + } +} + proc test {{reptime 1000}} { puts "" + test-ensemble-perf [expr {$reptime / 2}]; #fast enough test-format $reptime test-scan $reptime test-freescan $reptime -- cgit v0.12 From dceaea0327abc9d0e7620a7b2a4af177e9c8d569 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 12:32:47 +0000 Subject: auto-loading of ensemble and stubs on demand only (+ test covered now, see clock-0.1); introduces new possibility to implement namespace-based auto-loading, e. g.: set ::auto_index_ns(::some::namespace) [list ::source [::file join $dir some namespace.tcl]]] loading of clock-stubs (clock.tcl) implemented via handler "auto_index_ns" now. --- library/init.tcl | 73 ++++++++++++++++++++++++++++++++++---------------------- tests/clock.test | 21 ++++++++++++++++ 2 files changed, 65 insertions(+), 29 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 824f66f..d2c3b6e 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -156,6 +156,17 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { if {[interp issafe]} { package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} } else { + # Default known auto_index (avoid loading auto index implicit after interp create): + + array set ::auto_index { + ::tcl::tm::UnknownHandler {source [info library]/tm.tcl} + ::tclPkgUnknown {source [info library]/package.tcl} + ::history {source [info library]/history.tcl} + } + + # The newest possibility to load whole namespace: + array set ::auto_index_ns {} + # Set up search for Tcl Modules (TIP #189). # and setup platform specific unknown package handlers if {$tcl_platform(os) eq "Darwin" @@ -168,28 +179,19 @@ if {[interp issafe]} { # Set up the 'clock' ensemble - namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] - proc clock args { set cmdmap [dict create] foreach cmd {add clicks format microseconds milliseconds scan seconds configure} { dict set cmdmap $cmd ::tcl::clock::$cmd } - namespace eval ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ + namespace inscope ::tcl::clock [list namespace ensemble create -command \ + [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ -map $cmdmap -compile 1] - # Auto-loading stubs for 'clock.tcl' - foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} { - proc ::tcl::clock::$cmd args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - } - - return [uplevel 1 [info level 0]] + uplevel 1 [info level 0] } + # Auto-loading stubs for 'clock.tcl' + set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock {::source [::file join [info library] clock.tcl]}} } # Conditionalize for presence of exec. @@ -417,18 +419,22 @@ proc unknown args { # for instance. If not given, namespace current is used. proc auto_load {cmd {namespace {}}} { - global auto_index auto_path + global auto_index auto_index_ns auto_path + # qualify names: if {$namespace eq ""} { set namespace [uplevel 1 [list ::namespace current]] } set nameList [auto_qualify $cmd $namespace] # workaround non canonical auto_index entries that might be around # from older auto_mkindex versions - lappend nameList $cmd - foreach name $nameList { + if {$cmd ni $nameList} {lappend nameList $cmd} + + # try to load (and create sub-cmd handler "_sub_load_cmd" for further usage): + foreach name $nameList [set _sub_load_cmd { + # via auto_index: if {[info exists auto_index($name)]} { - namespace eval :: $auto_index($name) + namespace inscope :: $auto_index($name) # There's a couple of ways to look for a command of a given # name. One is to use # info commands $name @@ -440,22 +446,31 @@ proc auto_load {cmd {namespace {}}} { return 1 } } - } + # via auto_index_ns - resolver for the whole namespace loaders + if {[set ns [::namespace qualifiers $name]] ni {"" "::"} && + [info exists auto_index_ns($ns)] + } { + # remove handler before loading (prevents several self-recursion cases): + set ldr $auto_index_ns($ns); unset auto_index_ns($ns) + namespace inscope :: $ldr + # if got it: + if {[namespace which -command $name] ne ""} { + return 1 + } + } + }] + + # load auto_index if possible: if {![info exists auto_path]} { return 0 } - if {![auto_load_index]} { return 0 } - foreach name $nameList { - if {[info exists auto_index($name)]} { - namespace eval :: $auto_index($name) - if {[namespace which -command $name] ne ""} { - return 1 - } - } - } + + # try again (something new could be loaded): + foreach name $nameList $_sub_load_cmd + return 0 } @@ -605,7 +620,7 @@ proc auto_import {pattern} { foreach name [array names auto_index $pattern] { if {([namespace which -command $name] eq "") && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} { - namespace eval :: $auto_index($name) + namespace inscope :: $auto_index($name) } } } diff --git a/tests/clock.test b/tests/clock.test index 0737558..af517c8 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35,6 +35,9 @@ testConstraint y2038 \ # TEST PLAN +# clock-0: +# several base test-cases +# # clock-1: # [clock format] - tests of bad and empty arguments # @@ -251,6 +254,24 @@ proc ::testClock::registry { cmd path key } { return [dict get $reg $path $key] } +# Base test cases: + +test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" { + set i [interp create]; # because clock can be used somewhere, test it in new interp: + + set ret [$i eval { + + lappend ret ens:[namespace ensemble exists ::clock] + clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded) + lappend ret ens:[namespace ensemble exists ::clock] + lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] + clock format -now; # clock.tcl stubs expected + lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] + }] + interp delete $i + set ret +} {ens:0 ens:1 stubs:0 stubs:1} + # Test some of the basics of [clock format] test clock-1.0 "clock format - wrong # args" { -- cgit v0.12 From 95b07543288c057479a4d167887b372c00707dc0 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 15:07:32 +0000 Subject: prevents loss of key object if the format object (where key stored) becomes changed (loses its internal representation during evals); should avoid possible theoretical segfault there. --- generic/tclClockFmt.c | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d875bd4..18b82fa 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -634,7 +634,7 @@ ClockFmtObj_UpdateString(objPtr) * * This is normally stored in second pointer of internal representation. * If format object is not localizable, it is equal the given format - * pointer and the first pointer of internal representation may be NULL. + * pointer (special case to fast fallback by not-localizable formats). * * Results: * Returns tcl object with key or format object if not localizable. @@ -825,16 +825,20 @@ ClockLocalizeFormat( return opts->formatObj; } + /* prevents loss of key object if the format object (where key stored) + * becomes changed (loses its internal representation during evals) */ + Tcl_IncrRefCount(keyObj); + if (opts->mcDictObj == NULL) { ClockMCDict(opts); if (opts->mcDictObj == NULL) - return NULL; + goto done; } /* try to find in cache within locale mc-catalog */ if (Tcl_DictObjGet(NULL, opts->mcDictObj, keyObj, &valObj) != TCL_OK) { - return NULL; + goto done; } /* call LocalizeFormat locale format fmtkey */ @@ -844,10 +848,9 @@ ClockLocalizeFormat( callargs[1] = opts->localeObj; callargs[2] = opts->formatObj; callargs[3] = keyObj; - Tcl_IncrRefCount(keyObj); if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK ) { - goto clean; + goto done; } valObj = Tcl_GetObjResult(opts->interp); @@ -857,9 +860,11 @@ ClockLocalizeFormat( keyObj, valObj) != TCL_OK ) { valObj = NULL; - goto clean; + goto done; } + Tcl_ResetResult(opts->interp); + /* check special case - format object is not localizable */ if (valObj == opts->formatObj) { /* mark it as unlocalizable, by setting self as key (without refcount incr) */ @@ -868,14 +873,11 @@ ClockLocalizeFormat( ObjLocFmtKey(opts->formatObj) = opts->formatObj; } } -clean: - - Tcl_UnsetObjRef(keyObj); - if (valObj) { - Tcl_ResetResult(opts->interp); - } } +done: + + Tcl_UnsetObjRef(keyObj); return (opts->formatObj = valObj); } -- cgit v0.12 From 1431cc558785ae702e11c2aba5a9212dd79d4d3c Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 15:07:41 +0000 Subject: [clock] tclStrIdxTree extended with possibility to hold client data; also changed in clock - indices starts with 1 instead of 0, and 0(NULL) instead of -1 used as sign of ambiguous keys. --- generic/tclClockFmt.c | 14 +++++++----- generic/tclStrIdxTree.c | 59 +++++++++++++++++++++++++++---------------------- generic/tclStrIdxTree.h | 8 +++---- 3 files changed, 45 insertions(+), 36 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 18b82fa..70b3ad7 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1174,7 +1174,7 @@ ClockMCGetListIdxTree( goto done; }; - if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) { goto done; } @@ -1249,7 +1249,7 @@ ClockMCGetMultiListIdxTree( goto done; }; - if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv) != TCL_OK) { + if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) { goto done; } mcKeys++; @@ -1301,12 +1301,12 @@ ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, /* not found */ return TCL_RETURN; } - if (foundItem->value == -1) { + if (!foundItem->value) { /* ambigous */ return TCL_RETURN; } - *val = foundItem->value; + *val = PTR2INT(foundItem->value); /* shift input pointer */ yyInput = f; @@ -1406,7 +1406,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, return ret; } - yyMonth = val + 1; + yyMonth = val; return TCL_OK; } @@ -1445,6 +1445,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, if (ret != TCL_OK) { return ret; } + --val; } if (val != -1) { @@ -1476,6 +1477,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, if (ret != TCL_OK) { return ret; } + --val; if (val == 0) { val = 7; @@ -1578,7 +1580,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, } if (tok->map->offs > 0) { - *(int *)(((char *)info) + tok->map->offs) = val; + *(int *)(((char *)info) + tok->map->offs) = --val; } return TCL_OK; diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index d9b5da0..291e481 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -24,26 +24,28 @@ * * Index-Tree: * - * j -1 * ... - * anuar 0 * - * u -1 * a -1 - * ni 5 * pril 3 - * li 6 * ugust 7 - * n -1 * gt 7 - * r 0 * s 8 - * i 5 * eptember 8 - * li 6 * pt 8 - * f 1 * oktober 9 - * ebruar 1 * n 10 - * br 1 * ovember 10 - * m -1 * vb 10 - * a -1 * d 11 - * erz 2 * ezember 11 - * i 4 * zb 11 - * rz 2 * + * j 0 * ... + * anuar 1 * + * u 0 * a 0 + * ni 6 * pril 4 + * li 7 * ugust 8 + * n 0 * gt 8 + * r 1 * s 9 + * i 6 * eptember 9 + * li 7 * pt 9 + * f 2 * oktober 10 + * ebruar 2 * n 11 + * br 2 * ovember 11 + * m 0 * vb 11 + * a 0 * d 12 + * erz 3 * ezember 12 + * i 5 * zb 12 + * rz 3 * * ... * - * Thereby value -1 shows pure group items (corresponding ambigous matches). + * Thereby value 0 shows pure group items (corresponding ambigous matches). + * But the group may have a value if it contains only same values + * (see for example group "f" above). * * StrIdxTree's are very fast, so: * build of above-mentioned tree takes about 10 microseconds. @@ -109,7 +111,7 @@ TclStrIdxTreeSearch( if (offs >= item->length && item->childTree.firstPtr) { /* save previuosly found item (if not ambigous) for * possible fallback (few greedy match) */ - if (item->value != -1) { + if (item->value != NULL) { prevf = f; prevItem = item; prevParent = parent; @@ -206,7 +208,9 @@ TclStrIdxTreeAppend( * TclStrIdxTreeBuildFromList -- * * Build or extend string indexed tree from tcl list. - * + * If the values not given the values of built list are indices starts with 1. + * Value of 0 is thereby reserved to the ambigous values. + * * Important: by multiple lists, optimal tree can be created only if list with * larger strings used firstly. * @@ -223,10 +227,12 @@ MODULE_SCOPE int TclStrIdxTreeBuildFromList( TclStrIdxTree *idxTree, int lstc, - Tcl_Obj **lstv) + Tcl_Obj **lstv, + ClientData *values) { Tcl_Obj **lwrv; int i, ret = TCL_ERROR; + ClientData val; const char *s, *e, *f; TclStrIdx *item; @@ -250,8 +256,9 @@ TclStrIdxTreeBuildFromList( TclStrIdxTree *foundParent = idxTree; e = s = TclGetString(lwrv[i]); e += lwrv[i]->length; + val = values ? values[i] : INT2PTR(i+1); - /* ignore empty values (impossible to index it) */ + /* ignore empty keys (impossible to index it) */ if (lwrv[i]->length == 0) continue; item = NULL; @@ -267,7 +274,7 @@ TclStrIdxTreeBuildFromList( } /* if shortest key was found with the same value, * just replace its current key with longest key */ - if ( foundItem->value == i + if ( foundItem->value == val && foundItem->length < lwrv[i]->length && foundItem->childTree.firstPtr == NULL ) { @@ -286,7 +293,7 @@ TclStrIdxTreeBuildFromList( Tcl_InitObjRef(item->key, foundItem->key); item->length = f - s; /* set value or mark as ambigous if not the same value of both */ - item->value = (foundItem->value == i) ? i : -1; + item->value = (foundItem->value == val) ? val : NULL; /* insert group item between foundParent and foundItem */ TclStrIdxTreeInsertBranch(foundParent, item, foundItem); foundParent = &item->childTree; @@ -304,7 +311,7 @@ TclStrIdxTreeBuildFromList( item->childTree.lastPtr = item->childTree.firstPtr = NULL; Tcl_InitObjRef(item->key, lwrv[i]); item->length = lwrv[i]->length; - item->value = i; + item->value = val; TclStrIdxTreeAppend(foundParent, item); }; @@ -496,7 +503,7 @@ TclStrIdxTreeTestObjCmd( &lstc, &lstv) != TCL_OK) { return TCL_ERROR; }; - TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv); + TclStrIdxTreeBuildFromList(&idxTree, lstc, lstv, NULL); } if (optionIndex == O_PUTS_INDEX) { TclStrIdxTreePrint(interp, idxTree.firstPtr, 0); diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index 305053c..9f26907 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -27,9 +27,9 @@ typedef struct TclStrIdx { struct TclStrIdxTree childTree; struct TclStrIdx *nextPtr; struct TclStrIdx *prevPtr; - Tcl_Obj *key; - int length; - int value; + Tcl_Obj *key; + int length; + ClientData value; } TclStrIdx; @@ -152,7 +152,7 @@ MODULE_SCOPE const char* const char *start, const char *end); MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, - int lstc, Tcl_Obj **lstv); + int lstc, Tcl_Obj **lstv, ClientData *values); MODULE_SCOPE Tcl_Obj* TclStrIdxTreeNewObj(); -- cgit v0.12 From 95da95e0d96aea188e0ee0f146dc5030a4a91c3e Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 16:56:56 +0000 Subject: update documentation doc/clock.n: small enhancements and relevant changes of new engine. --- doc/clock.n | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 889a5da..38b408d 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -87,6 +87,15 @@ slowing its clock by a tiny fraction for some minutes until it is back in sync with UTC; its data model does not represent minutes that have 59 or 61 seconds. .TP +\fI\-now\fR +Instead of \fItimeVal\fR a non-integer option \fI\-now\fR can be used as +replacement for today, which is simply interpolated to the runt-time as value +of \fBclock seconds\fR. For example: +.sp +\fBclock format -now -f %a; # current day of the week\fR +.sp +\fBclock add -now 1 month; # next month\fR +.TP \fIunit\fR One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR, \fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or @@ -528,6 +537,12 @@ abbreviation appropriate to the current locale, and uses it to fix whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. .TP +\fB%Es\fR +This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses +or formats local seconds (not the posix seconds). +Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines +a point in time), it overrides all other input formats. +.TP \fB%Ex\fR On output, produces a locale-dependent representation of the date in the locale's alternative calendar. On input, matches @@ -722,13 +737,15 @@ week number \fB%V\fR; programs should use \fB%G\fR for that purpose. On output, produces the current time zone, expressed in hours and minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to -determine the time zone. +determine the time zone (this token is optionally applicable on input, +so the value is not mandatory and can be missing in input). .TP \fB%Z\fR On output, produces the current time zone's name, possibly translated to the given locale. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to determine the -time zone. This option should, in general, be used on input only when +time zone (token is also like \fB%z\fR optionally applicable on input). +This option should, in general, be used on input only when parsing RFC822 dates. Other uses are fraught with ambiguity; for instance, the string \fBBST\fR may represent British Summer Time or Brazilian Standard Time. It is recommended that date/time strings for @@ -927,6 +944,24 @@ used. Finally, a correction is applied so that the correct hour of the day is produced after allowing for daylight savings time differences and the correct date is given when going from the end of a long month to a short month. +.PP +The precedence of the applying of single tokens resp. which sequence will be +used by calculating of the time is complex, e. g. heavily dependent on the +precision of type of the token. +.sp +In example below the second date-string contains "next January", therefore +it results in next year but in January. And third date-string besides "January" +contains also additionally "Fri", so it results in the nearest Friday. +Thus both win before "385 days" resp. make it more precise, because of higher +precision of this token types. +.CS +% clock format [clock scan "5 years 18 months 385 days" -base 0 -gmt 1] -gmt 1 +Thu Jul 21 00:00:00 GMT 1977 +% clock format [clock scan "5 years 18 months 385 days next January" -base 0 -gmt 1] -gmt 1 +Sat Jan 21 00:00:00 GMT 1978 +% clock format [clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1] -gmt 1 +Fri Jan 27 00:00:00 GMT 1978 +.CE .SH "SEE ALSO" msgcat(n) .SH KEYWORDS -- cgit v0.12 From 9c678f82564dc26c67a0c6428f2349ce34b62f3d Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 11 May 2017 21:53:38 +0000 Subject: fixes lost indentation during back-porting --- generic/tclClock.c | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a066f73..17c19c3 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -150,7 +150,7 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ CompileProc *compileProc; /* The compiler for the command. */ @@ -2004,7 +2004,7 @@ ConvertUTCToLocal( if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, dataPtr->UTC2Local.rangesVal) != TCL_OK) { return TCL_ERROR; - } + } } /* Cache the last conversion */ @@ -2576,9 +2576,9 @@ GetJulianDayFromEraYearMonthDay( * See above bug for details. The casts are necessary. */ if (ym1 >= 0) - ym1o4 = ym1 / 4; + ym1o4 = ym1 / 4; else { - ym1o4 = - (int) (((unsigned int) -ym1) / 4); + ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif if (ym1 % 4 < 0) { @@ -2992,12 +2992,12 @@ ClockInitFmtScnArgs( static int ClockParseFmtScnArgs( register - ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ - TclDateFields *date, /* Extracted date-time corresponding base - * (by scan or add) resp. clockval (by format) */ + ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ + TclDateFields *date, /* Extracted date-time corresponding base + * (by scan or add) resp. clockval (by format) */ int objc, /* Parameter count */ - Tcl_Obj *const objv[], /* Parameter vector */ - int flags /* Flags, differentiates between format, scan, add */ + Tcl_Obj *const objv[], /* Parameter vector */ + int flags /* Flags, differentiates between format, scan, add */ ) { Tcl_Interp *interp = opts->interp; ClockClientData *dataPtr = opts->clientData; @@ -3031,7 +3031,7 @@ ClockParseFmtScnArgs( Tcl_WideInt num; if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) { continue; - } + } } /* get option */ if (Tcl_GetIndexFromObj(interp, objv[i], options, @@ -3067,10 +3067,10 @@ ClockParseFmtScnArgs( case CLC_ARGS_BASE: if ( !(flags & (CLC_SCN_ARGS)) ) { goto badOptionMsg; - } + } opts->baseObj = objv[i+1]; break; - } + } saw |= (1 << optionIndex); } @@ -3130,10 +3130,10 @@ ClockParseFmtScnArgs( i = 1; goto badOption; } - /* + /* * seconds could be an unsigned number that overflowed. Make sure * that it isn't. - */ + */ if (opts->baseObj->typePtr == &tclBignumType) { Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); @@ -4042,14 +4042,14 @@ ClockSecondsObjCmd( static unsigned long TzsetGetEpoch(void) { - static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by - * clockMutex. */ + static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by + * clockMutex. */ static long tzLastRefresh = 0; /* Used for latency before next refresh */ static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */ static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ - const char *tzIsNow; /* Current value of TZ */ + const char *tzIsNow; /* Current value of TZ */ /* * Prevent performance regression on some platforms by resolving of system time zone: @@ -4068,7 +4068,7 @@ TzsetGetEpoch(void) Tcl_MutexLock(&clockMutex); tzIsNow = getenv("TCL_TZ"); if (tzIsNow == NULL) { - tzIsNow = getenv("TZ"); + tzIsNow = getenv("TZ"); } if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { -- cgit v0.12 From 4213f85e6c843588364c0e410e57e31c6d3ce9d1 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 12 May 2017 07:45:15 +0000 Subject: restored "-encoding utf-8" by source clock.tcl (lost by merging) --- library/init.tcl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/library/init.tcl b/library/init.tcl index d2c3b6e..de69730 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -191,7 +191,9 @@ if {[interp issafe]} { uplevel 1 [info level 0] } # Auto-loading stubs for 'clock.tcl' - set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock {::source [::file join [info library] clock.tcl]}} + set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock { + ::source -encoding utf-8 [::file join [info library] clock.tcl] + }} } # Conditionalize for presence of exec. -- cgit v0.12 From 9f5e6e9b5ff1c04538705d20e601b16c4df821e5 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 12 May 2017 19:58:01 +0000 Subject: Fixed stardate format: be sure positive after decimal point (note: clock-value can be negative - modulo operation in C has the same sign as dividend) --- generic/tclClockFmt.c | 12 +++++++----- tests/clock.test | 51 ++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 43 insertions(+), 20 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 70b3ad7..d3cb339 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2489,13 +2489,13 @@ ClockFmtToken_StarDate_Proc( { int fractYear; /* Get day of year, zero based */ - int doy = dateFmt->date.dayOfYear - 1; + int v = dateFmt->date.dayOfYear - 1; /* Convert day of year to a fractional year */ if (IsGregorianLeapYear(&dateFmt->date)) { - fractYear = 1000 * doy / 366; + fractYear = 1000 * v / 366; } else { - fractYear = 1000 * doy / 365; + fractYear = 1000 * v / 365; } /* Put together the StarDate as "Stardate %02d%03d.%1d" */ @@ -2507,8 +2507,10 @@ ClockFmtToken_StarDate_Proc( dateFmt->output = _itoaw(dateFmt->output, fractYear, '0', 3); *dateFmt->output++ = '.'; - dateFmt->output = _itoaw(dateFmt->output, - dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ), '0', 1); + /* be sure positive after decimal point (note: clock-value can be negative) */ + v = dateFmt->date.localSeconds % SECONDS_PER_DAY / ( SECONDS_PER_DAY / 10 ); + if (v < 0) v = 10 + v; + dateFmt->output = _itoaw(dateFmt->output, v, '0', 1); return TCL_OK; } diff --git a/tests/clock.test b/tests/clock.test index af517c8..5f9a3ec 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18647,10 +18647,42 @@ test clock-6.20 {special char tokens %n, %t} { } 1246386600 # Hi, Jeff! +proc _testStarDates {s {days {366*2}} {step {86400}}} { + set step [expr {int($step * 86400)}] + # reconvert - arrange in order of stardate: + set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]] + # test: + set wrong {} + while {$i < $s + $days*86400} { + set d [clock format $i -f "%Q" -g 1] + if {![regexp {^Stardate \d+\.\d$} $d]} { + lappend wrong "wrong: $d -- ($i) -- [clock format $i -g 1]" + } + if {[catch { + set i2 [clock scan $d -f "%Q" -g 1] + } msg]} { + lappend wrong "$d -- ($i) -- [clock format $i -g 1]: $msg" + } + if {$i != $i2} { + lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]" + } + incr i $step + } + join $wrong \n +} test clock-6.21.0 {Stardate 0 day} { list [set d [clock format -757382400 -format "%Q" -gmt 1]] \ [clock scan $d -format "%Q" -gmt 1] } [list "Stardate 00000.0" -757382400] +test clock-6.21.0.1 {Stardate 0.1 - 1.9 (test negative clock value -> positive Stardate)} { + _testStarDates -757382400 2 0.1 +} {} +test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)} { + _testStarDates [clock scan "Stardate 10000.1" -f %Q -g 1] 3 0.1 +} {} +test clock-6.21.0.2 {Stardate 80000.1 - 80002.9 (test positive clock value)} { + _testStarDates [clock scan "Stardate 80001.1" -f %Q -g 1] 3 0.1 +} {} test clock-6.21.1 {Stardate} { list [set d [clock format 1482857280 -format "%Q" -gmt 1]] \ [clock scan $d -format "%Q" -gmt 1] @@ -18659,21 +18691,10 @@ test clock-6.21.2 {Stardate next time} { list [set d [clock format 1482865920 -format "%Q" -gmt 1]] \ [clock scan $d -format "%Q" -gmt 1] } [list "Stardate 70986.8" 1482865920] -test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)} -body { - set s [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1] - set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]] - set wrong {} - while {[incr i 86400] < $s + 86400*366*2} { - set d [clock format $i -f "%Q" -g 1] - set i2 [clock scan $d -f "%Q" -g 1] - if {$i != $i2} { - lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]" - } - } - join $wrong \n -} -result {} -cleanup { - unset -nocomplain wrong i i2 s d -} +test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)} { + _testStarDates [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1] [expr {366*2}] 1 +} {} +rename _testStarDates {} test clock-6.22.1 {Greedy match} { clock format [clock scan "111" -format "%d%m%y" -gmt 1] -locale en -gmt 1 -- cgit v0.12 From 6c6c26cc2c64879e95a6909e50120af806292a81 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 16 May 2017 08:51:51 +0000 Subject: resolved warnings compiled with gcc, removed unused "MsgCtLitIdxs" (was moved to tclClock.c) --- generic/tclClockFmt.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d3cb339..d923ede 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -34,9 +34,6 @@ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); static void ClockFrmScnFinalize(ClientData clientData); -/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ -CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); - /* * Clock scan and format facilities. */ @@ -1906,7 +1903,7 @@ EstimateTokenCount( #define AllocTokenInChain(tok, chain, tokCnt) \ if (++(tok) >= (chain) + (tokCnt)) { \ - *((char **)&chain) = ckrealloc((char *)(chain), \ + chain = ckrealloc((char *)(chain), \ (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ if ((chain) == NULL) { goto done; }; \ (tok) = (chain) + (tokCnt); \ -- cgit v0.12 From 3880f148a1f58dbcc23a04aa669f2e02426db96d Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 16 May 2017 09:16:43 +0000 Subject: optimized special case "-now" of base (by scan or add) or clock value (by format): bypass integer recognition if it looks like option "-now" --- generic/tclClock.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 17c19c3..80740c8 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3110,14 +3110,19 @@ ClockParseFmtScnArgs( /* Base (by scan or add) or clock value (by format) */ if (opts->baseObj != NULL) { - if (TclGetWideIntFromObj(NULL, opts->baseObj, &baseVal) != TCL_OK) { + register Tcl_Obj *baseObj = opts->baseObj; + /* bypass integer recognition if looks like option "-now" */ + if ( + (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') || + TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK + ) { /* we accept "-now" as current date-time */ const char *const nowOpts[] = { "-now", NULL }; int idx; - if (Tcl_GetIndexFromObj(NULL, opts->baseObj, nowOpts, "seconds or -now", + if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now", TCL_EXACT, &idx) == TCL_OK ) { goto baseNow; @@ -3125,7 +3130,7 @@ ClockParseFmtScnArgs( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", - Tcl_GetString(opts->baseObj))); + Tcl_GetString(baseObj))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); i = 1; goto badOption; @@ -3135,7 +3140,7 @@ ClockParseFmtScnArgs( * that it isn't. */ - if (opts->baseObj->typePtr == &tclBignumType) { + if (baseObj->typePtr == &tclBignumType) { Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; } -- cgit v0.12 From 887b450f7e64e2426a51e06246cb9295b126932c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 16 May 2017 09:22:17 +0000 Subject: small amend with forgetten static keyword by option --- generic/tclClock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 80740c8..c980a27 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3118,7 +3118,7 @@ ClockParseFmtScnArgs( ) { /* we accept "-now" as current date-time */ - const char *const nowOpts[] = { + static const char *const nowOpts[] = { "-now", NULL }; int idx; -- cgit v0.12