optimizes locale cache: locale is case-sensitive key; simplifying format localization routine (cached within locale mc-catalog in C);

clock::mcget - be sure we don't overwrite catalog of (common) locale {} (as it's a base of other catalogs loaded later).

3 files changed, 72 insertions, 67 deletions

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 9f6a959..d0e5214 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -642,7 +642,7 @@ NormLocaleObj(
     if ( dataPtr->currentLocale != NULL
       && ( localeObj == dataPtr->currentLocale
        || (localeObj->length == dataPtr->currentLocale->length
-	  && strcmp(loc, TclGetString(dataPtr->currentLocale)) == 0
+	  && strcasecmp(loc, TclGetString(dataPtr->currentLocale)) == 0
 	)
       )
     ) {
@@ -652,7 +652,7 @@ NormLocaleObj(
     if ( dataPtr->lastUsedLocale != NULL
       && ( localeObj == dataPtr->lastUsedLocale
        || (localeObj->length == dataPtr->lastUsedLocale->length
-	  && strcmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0
+	  && strcasecmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0
 	)
       )
     ) {
@@ -663,7 +663,7 @@ NormLocaleObj(
     if ( dataPtr->prevUsedLocale != NULL
       && ( localeObj == dataPtr->prevUsedLocale
        || (localeObj->length == dataPtr->prevUsedLocale->length
-	  && strcmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0
+	  && strcasecmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0
 	)
       )
     ) {
@@ -756,18 +756,21 @@ ClockMCDict(ClockFmtScnCmdArgs *opts)
 	    }
 	}
 
+	/* check or obtain mcDictObj (be sure it's modifiable) */
 	if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) {
-	    Tcl_Obj *callargs[2];
+	    int ref = 1;
 
-	    /* first try to find it own catalog dict */
+	    /* first try to find locale catalog dict */
 	    if (dataPtr->mcDicts == NULL) {
 		Tcl_SetObjRef(dataPtr->mcDicts, Tcl_NewDictObj());
 	    }
 	    Tcl_DictObjGet(NULL, dataPtr->mcDicts,
 		opts->localeObj, &opts->mcDictObj);
 
-	    if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) {
+	    if (opts->mcDictObj == NULL) {
 		/* get msgcat dictionary - ::tcl::clock::mcget locale */
+		Tcl_Obj *callargs[2];
+
 		callargs[0] = dataPtr->literals[LIT_MCGET];
 		callargs[1] = opts->localeObj;
 
@@ -777,19 +780,20 @@ ClockMCDict(ClockFmtScnCmdArgs *opts)
 
 		opts->mcDictObj = Tcl_GetObjResult(opts->interp);
 		Tcl_ResetResult(opts->interp);
+		ref = 0; /* new object is not yet referenced */
+	    }
 
-		/* 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);
-	        }
-
-		/* create exactly one reference to catalog / make it searchable for future */
-		Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj,
+	    /* be sure that object reference doesn't increase (dict changeable) */
+	    if (opts->mcDictObj->refCount > ref) {
+		/* smart reference (shared dict as object with no ref-counter) */
+		opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp,
 		    opts->mcDictObj);
 	    }
 
+	    /* create exactly one reference to catalog / make it searchable for future */
+	    Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj,
+		opts->mcDictObj);
+
 	    if ( opts->localeObj == dataPtr->literals[LIT_C]
 	      || opts->localeObj == dataPtr->defaultLocale
 	    ) {
diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c
index 2e63008..faf091e 100644
--- a/generic/tclClockFmt.c
+++ b/generic/tclClockFmt.c
@@ -844,14 +844,21 @@ ClockLocalizeFormat(
 	callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT];
 	callargs[1] = opts->localeObj;
 	callargs[2] = opts->formatObj;
-	callargs[3] = keyObj;
-	if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK
+	callargs[3] = opts->mcDictObj;
+	if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) == TCL_OK
 	) {
-	    goto done;
+	    valObj = Tcl_GetObjResult(opts->interp);
 	}
 
-	valObj = Tcl_GetObjResult(opts->interp);
-
+	/* ensure mcDictObj remains unshared */
+	if (opts->mcDictObj->refCount > 1) {
+	    /* smart reference (shared dict as object with no ref-counter) */
+	    opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp,
+		opts->mcDictObj);
+	}
+	if (!valObj) {
+	    goto done;
+	}
 	/* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */
 	if (Tcl_DictObjPut(opts->interp, opts->mcDictObj,
 		keyObj, valObj) != TCL_OK
diff --git a/library/clock.tcl b/library/clock.tcl
index 6638496..04d4777 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -477,8 +477,7 @@ proc ::tcl::clock::Initialize {} {
 
     # Caches
 
-    variable LocaleFormats \
-			[dict create];	# Dictionary with localized formats
+    variable LocFmtMap [dict create];	# Dictionary with localized format maps
 
     variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone
     					# names and whose values are 1 if
@@ -570,12 +569,18 @@ proc ::tcl::clock::mcMerge {locales} {
 	set mrgcat [mcMerge [lrange $locales 1 end]]
 	if {[dict exists $Msgs $ns $loc]} {
 	    set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
+	    dict set mrgcat L $loc
+	} else {
+	    # be sure a duplicate is created, don't overwrite {} (common) locale:
+	    set mrgcat [dict merge $mrgcat [dict create L $loc]]
 	}
     } else {
 	if {[dict exists $Msgs $ns $loc]} {
 	    set mrgcat [dict get $Msgs $ns $loc]
+	    dict set mrgcat L $loc
 	} else {
-	    set mrgcat [dict create]
+	    # be sure a duplicate is created, don't overwrite {} (common) locale:
+	    set mrgcat [dict create L $loc]
 	}
     }
     dict set mcMergedCat $loc $mrgcat
@@ -819,6 +824,8 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
 #	locale -- Current [mclocale] locale, supplied to avoid
 #		  an extra call
 #	format -- Format supplied to [clock scan] or [clock format]
+#	mcd    -- Message catalog dictionary for current locale (read-only,
+#		  don't store it to avoid shared references).
 #
 # Results:
 #	Returns the string with locale-dependent composite format groups
@@ -829,54 +836,41 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
 #
 #----------------------------------------------------------------------
 
-proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
-    variable LocaleFormats
+proc ::tcl::clock::LocalizeFormat { locale format mcd } {
+    variable LocFmtMap
 
-    if { $fmtkey eq {} } { set fmtkey FMT_$format }
-    if {[dict exists $LocaleFormats $locale $fmtkey]} {
-	set locfmt [dict get $LocaleFormats $locale $fmtkey]
+    # get map list cached or build it:
+    if {[dict exists $LocFmtMap $locale]} {
+	set mlst [dict get $LocFmtMap $locale]
     } else {
-
-	# get map list cached or build it:
-	if {[dict exists $LocaleFormats $locale MLST]} {
-	    set mlst [dict get $LocaleFormats $locale MLST]
-	} else {
-
-	    # 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
+	# 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]]
 
-	# 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
+	dict set LocFmtMap $locale $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]]
+
     # Save original format as long as possible, because of internal
     # representation (performance).
     # Note that in this case such format will be never localized (also
@@ -2077,7 +2071,7 @@ proc ::tcl::clock::ChangeCurrentLocale {args} {
 #----------------------------------------------------------------------
 
 proc ::tcl::clock::ClearCaches {} {
-    variable LocaleFormats
+    variable LocFmtMap
     variable mcMergedCat
     variable TimeZoneBad
 
@@ -2087,7 +2081,7 @@ proc ::tcl::clock::ClearCaches {} {
     # clear msgcat cache:
     set mcMergedCat [dict create]
 
-    set LocaleFormats {}
+    set LocFmtMap {}
     set TimeZoneBad {}
     InitTZData
 }