-- 
cgit v0.12

From 4cc1178952c2e7eef686282007f5046adceb1ec1 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
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::<name>". 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 <sebres@users.sourceforge.net>
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 <http://www.gnu.org/licenses/>.  */
 
 /* 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 <stddef.h> /* 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 <libintl.h> /* 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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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<objc ; i++) {
+	    Tcl_AppendObjToObj(valuePtr, objv[i]);
 	}
 
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1b37d84..a569788 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2905,6 +2905,7 @@ MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, int dictLength,
 			    const char **elementPtr, const char **nextPtr,
 			    int *sizePtr, int *literalPtr);
+MODULE_SCOPE Tcl_Obj *	Tcl_DictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *);
 /* TIP #280 - Modified token based evulation, with line information. */
 MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
 			    int numBytes, int flags, int line,
diff --git a/library/clock.tcl b/library/clock.tcl
index b4632b1..4173174 100755
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -629,6 +629,8 @@ proc ::tcl::clock::Initialize {} {
 
     # Caches
 
+    variable LocaleFormats      {};	# Dictionary with localized formats
+
     variable LocaleNumeralCache {};	# Dictionary whose keys are locale
 					# names and whose values are pairs
 					# comprising regexes matching numerals
@@ -2323,38 +2325,59 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
 #
 #----------------------------------------------------------------------
 
-proc ::tcl::clock::LocalizeFormat { locale format } {
+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]
+    }] } {
 
-    # message catalog key to cache this format
-    set key FORMAT_$format
+    	# get map list cached or build it:
+	if { [catch {
+	    set mlst [dict get $LocaleFormats $locale MLST]
+	}] } {
+	
+	    # message catalog dictionary:
+	    set mcd [::msgcat::mcget ::tcl::clock $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
+	}
 
-    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
-	return [mc $key]
-    }
-    # 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 list {
-	%% %%
-	%D %m/%d/%Y
-	%+ {%a %b %e %H:%M:%S %Z %Y}
+	# 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
+	}
+
+	# cache it:
+	dict set LocaleFormats $locale $fmtkey $locfmt
     }
-    lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]]
-    lappend list %T  [string map $list [mc TIME_FORMAT_24_SECS]]
-    lappend list %R  [string map $list [mc TIME_FORMAT_24]]
-    lappend list %r  [string map $list [mc TIME_FORMAT_12]]
-    lappend list %X  [string map $list [mc TIME_FORMAT]]
-    lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
-    lappend list %x  [string map $list [mc DATE_FORMAT]]
-    lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
-    lappend list %c  [string map $list [mc DATE_TIME_FORMAT]]
-    lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
-    set format [string map $list $format]
-
-    ::msgcat::mcset $locale $key $format
-    return $format
+
+    return $locfmt
 }
 
 #----------------------------------------------------------------------
@@ -4437,6 +4460,7 @@ proc ::tcl::clock::ChangeCurrentLocale {args} {
 
 proc ::tcl::clock::ClearCaches {} {
     variable FormatProc
+    variable LocaleFormats
     variable LocaleNumeralCache
     variable TimeZoneBad
 
@@ -4451,6 +4475,7 @@ proc ::tcl::clock::ClearCaches {} {
     }
 
     unset -nocomplain FormatProc
+    set LocaleFormats {}
     set LocaleNumeralCache {}
     set TimeZoneBad {}
     InitTZData
diff --git a/library/init.tcl b/library/init.tcl
index 06a9459..ef0a84a 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 GetSystemTimeZone __org_scan} {
+	foreach cmd {add format LocalizeFormat SetupTimeZone GetSystemTimeZone __org_scan} {
 	    proc ::tcl::clock::$cmd args {
 		variable TclLibDir
 		source -encoding utf-8 [file join $TclLibDir clock.tcl]
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 3fd2cdb..a25f6c8 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -947,7 +947,8 @@ proc msgcat::Merge {ns locales} {
 	}
     }
     dict set Merged $ns $loc $mrgcat
-    return $mrgcat
+    # return smart reference (shared dict as object with exact one ref-counter)
+    return [dict smartref $mrgcat]
 }
 
 # msgcat::Invoke --
-- 
cgit v0.12


From 40520b8606111adeab272cb9d2fa4c7acca3e406 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 **)&copyPtr->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 <sebres@users.sourceforge.net>
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<objc ; i++) {
-	    Tcl_AppendObjToObj(valuePtr, objv[i]);
+	if (appendObjPtr) {
+	    if (Tcl_IsShared(valuePtr)) {
+		valuePtr = Tcl_DuplicateObj(valuePtr);
+	    }
+
+	    Tcl_AppendObjToObj(valuePtr, appendObjPtr);
 	}
 
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index e6452d2..1260139 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
diff --git a/win/makefile.vc b/win/makefile.vc
index 48bacbc..aeb6c5a 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -484,9 +484,7 @@ cdebug	= $(cdebug) -Zi
 ### Warnings are too many, can't support warnings into errors.
 cdebug	= -Zi -Od $(DEBUGFLAGS)
 !else
-# no -WX option here (error C2220: warning treated as error):
-#cdebug	= -Zi -WX $(DEBUGFLAGS)
-cdebug	= -Zi $(DEBUGFLAGS)
+cdebug	= -Zi -WX $(DEBUGFLAGS)
 !endif
 
 ### Declarations common to all compiler options
-- 
cgit v0.12


From ba4330456f8bb2e2c45c3dfd27f9e7ce1cdaeb52 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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 4f047ce7e36ab348d5c3d492e85eda950903e070 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
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 <sebres@users.sourceforge.net>
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