summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclClock.c140
-rw-r--r--library/clock.tcl162
-rw-r--r--tests/clock.test10
4 files changed, 204 insertions, 119 deletions
diff --git a/ChangeLog b/ChangeLog
index 98cb68e..cf46635 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2008-02-06 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclClock.c (ClockParseformatargsObjCmd):
+ * library/clock.tcl (::tcl::clock::format):
+ * tests/clock.test (clock-1.0, clock-1.4):
+ Performance enhancements in [clock format] (moving
+ the analysis of $args into C code, holding on to
+ Tcl_Objs with resolved command names, [lassign]
+ in place of [foreach], avoiding [namespace which]
+ for command resolution).
+
2008-02-04 Don Porter <dgp@users.sourceforge.net>
*** 8.5.1 TAGGED FOR RELEASE ***
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 26a8662..dd006b4 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclClock.c,v 1.63 2007/12/13 15:23:15 dgp Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.64 2008/02/06 01:13:07 kennykb Exp $
*/
#include "tclInt.h"
@@ -58,9 +58,13 @@ static const int daysInPriorMonths[2][13] = {
*/
typedef enum ClockLiteral {
- LIT_BCE, LIT_CE,
+ 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_GREGORIAN,
+ LIT_ERA, LIT_GMT, LIT_GREGORIAN,
LIT_ISO8601WEEK, LIT_ISO8601YEAR,
LIT_JULIANDAY, LIT_LOCALSECONDS,
LIT_MONTH,
@@ -69,9 +73,13 @@ typedef enum ClockLiteral {
LIT__END
} ClockLiteral;
static const char *const literals[] = {
- "BCE", "CE",
+ "",
+ "%a %b %d %H:%M:%S %Z %Y",
+ "BCE", "C",
+ "cannot use -gmt and -timezone in same call",
+ "CE",
"dayOfMonth", "dayOfWeek", "dayOfYear",
- "era", "gregorian",
+ "era", ":GMT", "gregorian",
"iso8601Week", "iso8601Year",
"julianDay", "localSeconds",
"month",
@@ -176,6 +184,9 @@ 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[]);
@@ -209,6 +220,7 @@ static const struct ClockCommand clockCommands[] = {
ClockGetjuliandayfromerayearmonthdayObjCmd },
{ "GetJulianDayFromEraYearWeekDay",
ClockGetjuliandayfromerayearweekdayObjCmd },
+ { "ParseFormatArgs", ClockParseformatargsObjCmd },
{ NULL, NULL }
};
@@ -1779,6 +1791,124 @@ ClockMicrosecondsObjCmd(
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 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.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+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 = (ClockClientData*) clientData;
+ Tcl_Obj** litPtr = dataPtr->literals;
+
+ /* Format, locale and timezone */
+
+ Tcl_Obj* results[3];
+#define formatObj results[0]
+#define localeObj results[1]
+#define timezoneObj results[2]
+ int gmtFlag = 0;
+
+ /* Command line options expected */
+
+ const static char* options[] = {
+ "-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 */
+ Tcl_WideInt clockVal; /* Clock value - just used to parse */
+ int i;
+
+ /* Args consist of a time followed by keyword-value pairs */
+
+ 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;
+ }
+
+ /* 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, "switch", 0,
+ &optionIndex) != TCL_OK) {
+ Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+ 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);
+ }
+
+ /* Check options */
+
+ 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];
+ }
+
+ /* Return options as a list */
+
+ Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
+ return TCL_OK;
+
+#undef timezoneObj
+#undef localeObj
+#undef formatObj
+
+}
+
/*----------------------------------------------------------------------
*
* ClockSecondsObjCmd -
diff --git a/library/clock.tcl b/library/clock.tcl
index e5c831b..79ffc3e 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: clock.tcl,v 1.45 2007/12/13 15:26:03 dgp Exp $
+# RCS: @(#) $Id: clock.tcl,v 1.46 2008/02/06 01:13:07 kennykb Exp $
#
#----------------------------------------------------------------------
@@ -644,6 +644,9 @@ proc ::tcl::clock::Initialize {} {
# comprising start time, UTC offset,
# Daylight Saving Time indicator, and
# time zone abbreviation.
+ variable FormatProc; # Array mapping format group
+ # and locale to the name of a procedure
+ # that renders the given format
}
::tcl::clock::Initialize
@@ -661,74 +664,11 @@ proc ::tcl::clock::Initialize {} {
proc ::tcl::clock::format { args } {
+ variable FormatProc
variable TZData
- set format {}
-
- # Check the count of args
-
- if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
- set cmdName "clock format"
- return -code error \
- -errorcode [list CLOCK wrongNumArgs] \
- "wrong \# args: should be\
- \"$cmdName clockval\
- ?-format string? ?-gmt boolean?\
- ?-locale LOCALE? ?-timezone ZONE?\""
- }
-
- # Set defaults
+ lassign [ParseFormatArgs {*}$args] format locale timezone
set clockval [lindex $args 0]
- set format {%a %b %d %H:%M:%S %Z %Y}
- set gmt 0
- set locale C
- set timezone {}
-
- # Pick up command line options.
-
- foreach { flag value } [lreplace $args 0 0] {
- set saw($flag) {}
- switch -exact -- $flag {
- -f - -fo - -for - -form - -forma - -format {
- set format $value
- }
- -g - -gm - -gmt {
- set gmt $value
- }
- -l - -lo - -loc - -loca - -local - -locale {
- set locale $value
- }
- -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
- set timezone $value
- }
- default {
- return -code error \
- -errorcode [list CLOCK badSwitch $flag] \
- "bad switch \"$flag\",\
- must be -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 { ![string is wide -strict $clockval] } {
- return -code error \
- "expected integer but got \"$clockval\""
- }
- if { ![string is boolean -strict $gmt] } {
- return -code error \
- "expected boolean value but got \"$gmt\""
- } else {
- if { $gmt } {
- set timezone :GMT
- }
- }
# Get the data for time changes in the given zone
@@ -742,10 +682,19 @@ proc ::tcl::clock::format { args } {
}
}
- # Format the result
+ # 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 ::tcl::clock::formatproc'$format'$locale
+ if {[info exists FormatProc($procName)]} {
+ set procName $FormatProc($procName)
+ } else {
+ set FormatProc($procName) \
+ [ParseClockFormatFormat $procName $format $locale]
+ }
- set formatter [ParseClockFormatFormat $format $locale]
- return [$formatter $clockval $timezone]
+ return [$procName $clockval $timezone]
}
@@ -764,10 +713,9 @@ proc ::tcl::clock::format { args } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::ParseClockFormatFormat {format locale} {
+proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
- set procName [namespace current]::formatproc'$format'$locale
- if {[namespace which $procName] != {}} {
+ if {[namespace which $procName] ne {}} {
return $procName
}
@@ -1422,15 +1370,15 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
return -code error "unable to convert date-time string \"$string\""
}
- foreach { parseDate parseTime parseZone parseRel
- parseWeekday parseOrdinalMonth } $result break
+ lassign $result parseDate parseTime parseZone parseRel \
+ parseWeekday parseOrdinalMonth
# 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 } {
- foreach { y m d } $parseDate break
+ lassign $parseDate y m d
if { $y < 100 } {
if { $y >= 39 } {
incr y 1900
@@ -1454,7 +1402,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# a time zone indicator of +-hhmm.
if { [llength $parseZone] > 0 } {
- foreach { minEast dstFlag } $parseZone break
+ lassign $parseZone minEast dstFlag
set timezone [FormatNumericTimeZone \
[expr { 60 * $minEast + 3600 * $dstFlag }]]
SetupTimeZone $timezone
@@ -1485,7 +1433,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
# Do relative times
if { [llength $parseRel] > 0 } {
- foreach { relMonth relDay relSecond } $parseRel break
+ lassign $parseRel relMonth relDay relSecond
set seconds [add $seconds \
$relMonth months $relDay days $relSecond seconds \
-timezone $timezone -locale $locale]
@@ -1495,7 +1443,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
if { [llength $parseWeekday] > 0 } {
- foreach {dayOrdinal dayOfWeek} $parseWeekday break
+ lassign $parseWeekday dayOrdinal dayOfWeek
set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
dict set date2 era CE
set jdwkday [WeekdayOnOrBefore $dayOfWeek \
@@ -1523,7 +1471,7 @@ proc ::tcl::clock::FreeScan { string base timezone locale } {
if { [llength $parseOrdinalMonth] > 0 } {
- foreach {monthOrdinal monthNumber} $parseOrdinalMonth break
+ lassign $parseOrdinalMonth monthOrdinal monthNumber
if { $monthOrdinal > 0 } {
set monthDiff [expr { $monthNumber - [dict get $date month] }]
if { $monthDiff <= 0 } {
@@ -1647,7 +1595,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
dict set l [string tolower $full] $i
incr i
}
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet dayOfWeek [incr fieldCount]
append postcode "dict set date dayOfWeek \[" \
@@ -1665,7 +1613,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
dict set l [string tolower $abr] $i
dict set l [string tolower $full] $i
}
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
@@ -1764,7 +1712,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
p - P { # AM/PM indicator
set l [list [string tolower [mc AM]] 0 \
[string tolower [mc PM]] 1]
- foreach { regex lookup } [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet amPmIndicator [incr fieldCount]
append postcode "dict set date amPmIndicator \[" \
@@ -1890,10 +1838,10 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
C { # Locale-dependent era
set d {}
foreach triple [mc LOCALE_ERAS] {
- foreach {t symbol year} $triple break
+ lassign $triple t symbol year
dict set d [string tolower $symbol] $year
}
- foreach { regex lookup } [UniquePrefixRegexp $d] break
+ lassign [UniquePrefixRegexp $d] regex lookup
append re (?: $regex )
}
E {
@@ -1904,7 +1852,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
dict set l c.e. CE
dict set l b.c. BCE
dict set l a.d. CE
- foreach {regex lookup} [UniquePrefixRegexp $l] break
+ lassign [UniquePrefixRegexp $l] regex lookup
append re ( $regex )
dict set fieldSet era [incr fieldCount]
append postcode "dict set date era \["\
@@ -1914,8 +1862,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
y { # Locale-dependent year of the era
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
incr captureCount
}
@@ -1932,8 +1879,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
%O {
switch -exact -- $c {
d - e {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet dayOfMonth [incr fieldCount]
append postcode "dict set date dayOfMonth \[" \
@@ -1942,8 +1888,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
H - k {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet hour [incr fieldCount]
append postcode "dict set date hour \[" \
@@ -1952,8 +1897,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
I - l {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet hourAMPM [incr fieldCount]
append postcode "dict set date hourAMPM \[" \
@@ -1962,8 +1906,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
m {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet month [incr fieldCount]
append postcode "dict set date month \[" \
@@ -1972,8 +1915,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
M {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet minute [incr fieldCount]
append postcode "dict set date minute \[" \
@@ -1982,8 +1924,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
S {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet second [incr fieldCount]
append postcode "dict set date second \[" \
@@ -1992,8 +1933,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
"\]\n"
}
u - w {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet dayOfWeek [incr fieldCount]
append postcode "set dow \[dict get " [list $lookup] \
@@ -2010,8 +1950,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
}
}
y {
- foreach {regex lookup} \
- [LocaleNumeralMatcher $locale] break
+ lassign [LocaleNumeralMatcher $locale] regex lookup
append re $regex
dict set fieldSet yearOfCentury [incr fieldCount]
append postcode {dict set date yearOfCentury } \[ \
@@ -3364,13 +3303,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
set tzname {}
}
if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
- foreach {
- bias stdBias dstBias
- stdYear stdMonth stdDayOfWeek stdDayOfMonth
- stdHour stdMinute stdSecond stdMillisec
- dstYear dstMonth dstDayOfWeek dstDayOfMonth
+ lassign $data \
+ bias stdBias dstBias \
+ stdYear stdMonth stdDayOfWeek stdDayOfMonth \
+ stdHour stdMinute stdSecond stdMillisec \
+ dstYear dstMonth dstDayOfWeek dstDayOfMonth \
dstHour dstMinute dstSecond dstMillisec
- } $data break
set stdDelta [expr { $bias + $stdBias }]
set dstDelta [expr { $bias + $dstBias }]
if { $stdDelta <= 0 } {
@@ -3647,7 +3585,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
return -code error "$fileName has times out of order"
}
set lastTime $t
- foreach { gmtoff isDst abbrInd } [lindex $types $c] break
+ lassign [lindex $types $c] gmtoff isDst abbrInd
set abbrev [dict get $abbrevs $abbrInd]
lappend r [list $t $gmtoff $isDst $abbrev]
}
@@ -3664,7 +3602,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
if {[llength $posix] > 0} {
set posixFields [ParsePosixTimeZone $posix]
foreach tuple [ProcessPosixTimeZone $posixFields] {
- foreach {t gmtoff isDst abbrev} $tuple break
+ lassign $tuple t gmtoff isDst abbrev
if {$t > $lastTime} {
lappend r $tuple
}
@@ -4692,6 +4630,7 @@ proc ::tcl::clock::mc { name } {
proc ::tcl::clock::ClearCaches {} {
+ variable FormatProc
variable LocaleNumeralCache
variable McLoaded
variable CachedSystemTimeZone
@@ -4704,6 +4643,7 @@ proc ::tcl::clock::ClearCaches {} {
rename $p {}
}
+ catch {unset FormatProc}
set LocaleNumeralCache {}
set McLoaded {}
catch {unset CachedSystemTimeZone}
diff --git a/tests/clock.test b/tests/clock.test
index b736cac..257b5bd 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -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.
#
-# RCS: @(#) $Id: clock.test,v 1.81 2007/12/13 15:26:04 dgp Exp $
+# RCS: @(#) $Id: clock.test,v 1.82 2008/02/06 01:13:07 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -272,9 +272,13 @@ test clock-1.3 "clock format - empty val" {
clock format 0 -gmt 1 -format ""
} {}
-test clock-1.4 "clock format - bad flag" {
+test clock-1.4 "clock format - bad flag" {*}{
+ -body {
list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
-} {1 {bad switch "-oops", must be -format, -gmt, -locale or -timezone} {CLOCK badSwitch -oops}}
+ }
+ -match glob
+ -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}}
+}
test clock-1.5 "clock format - bad timezone" {
list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
generated by cgit v0.12 at 2024-11-05 12:15:03 (GMT)