repaired system/current locale caching (also for legacy clock format) and legacy timezone cached as last

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"