summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/clock.n39
-rw-r--r--doc/timerate.n114
-rw-r--r--generic/tclBasic.c7
-rw-r--r--generic/tclClock.c3143
-rw-r--r--generic/tclClockFmt.c3226
-rw-r--r--generic/tclCmdMZ.c346
-rw-r--r--generic/tclDate.c2476
-rw-r--r--generic/tclDate.h537
-rw-r--r--generic/tclDictObj.c54
-rw-r--r--generic/tclEnsemble.c8
-rw-r--r--generic/tclEnv.c9
-rw-r--r--generic/tclGetDate.y418
-rw-r--r--generic/tclInt.h23
-rw-r--r--generic/tclStrIdxTree.c528
-rw-r--r--generic/tclStrIdxTree.h169
-rw-r--r--library/clock.tcl2914
-rw-r--r--library/init.tcl96
-rw-r--r--library/tcltest/tcltest.tcl15
-rw-r--r--tests-perf/clock.perf.tcl411
-rw-r--r--tests-perf/test-performance.tcl121
-rw-r--r--tests/clock-ivm.test8
-rw-r--r--tests/clock.test1016
-rw-r--r--unix/Makefile.in17
-rwxr-xr-xunix/config.status.lineno920
-rw-r--r--unix/tclUnixTime.c71
-rw-r--r--win/Makefile.in2
-rw-r--r--win/makefile.vc2
-rw-r--r--win/tclWinTime.c271
28 files changed, 11366 insertions, 5595 deletions
diff --git a/doc/clock.n b/doc/clock.n
index 6efa722..0dae993 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -87,6 +87,15 @@ slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
+\fI\-now\fR
+Instead of \fItimeVal\fR a non-integer option \fI\-now\fR can be used as
+replacement for today, which is simply interpolated to the runt-time as value
+of \fBclock seconds\fR. For example:
+.sp
+\fBclock format -now -f %a; # current day of the week\fR
+.sp
+\fBclock add -now 1 month; # next month\fR
+.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
@@ -541,6 +550,12 @@ abbreviation appropriate to the current locale, and uses it to fix
whether \fB%Y\fR refers to years before or after Year 1 of the
Common Era.
.TP
+\fB%Es\fR
+This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses
+or formats local seconds (not the posix seconds).
+Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines
+a point in time), it overrides all other input formats.
+.TP
\fB%Ex\fR
On output, produces a locale-dependent representation of the date
in the locale's alternative calendar. On input, matches
@@ -735,13 +750,15 @@ week number \fB%V\fR; programs should use \fB%G\fR for that purpose.
On output, produces the current time zone, expressed in hours and
minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a
time zone specifier (see \fBTIME ZONES\fR below) that will be used to
-determine the time zone.
+determine the time zone (this token is optionally applicable on input,
+so the value is not mandatory and can be missing in input).
.TP
\fB%Z\fR
On output, produces the current time zone's name, possibly
translated to the given locale. On input, accepts a time zone
specifier (see \fBTIME ZONES\fR below) that will be used to determine the
-time zone. This option should, in general, be used on input only when
+time zone (token is also like \fB%z\fR optionally applicable on input).
+This option should, in general, be used on input only when
parsing RFC822 dates. Other uses are fraught with ambiguity; for
instance, the string \fBBST\fR may represent British Summer Time or
Brazilian Standard Time. It is recommended that date/time strings for
@@ -940,6 +957,24 @@ used. Finally, a correction is applied so that the correct hour of
the day is produced after allowing for daylight savings time
differences and the correct date is given when going from the end
of a long month to a short month.
+.PP
+The precedence of the applying of single tokens resp. which sequence will be
+used by calculating of the time is complex, e. g. heavily dependent on the
+precision of type of the token.
+.sp
+In example below the second date-string contains "next January", therefore
+it results in next year but in January. And third date-string besides "January"
+contains also additionally "Fri", so it results in the nearest Friday.
+Thus both win before "385 days" resp. make it more precise, because of higher
+precision of this token types.
+.CS
+% clock format [clock scan "5 years 18 months 385 days" -base 0 -gmt 1] -gmt 1
+Thu Jul 21 00:00:00 GMT 1977
+% clock format [clock scan "5 years 18 months 385 days next January" -base 0 -gmt 1] -gmt 1
+Sat Jan 21 00:00:00 GMT 1978
+% clock format [clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1] -gmt 1
+Fri Jan 27 00:00:00 GMT 1978
+.CE
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
diff --git a/doc/timerate.n b/doc/timerate.n
new file mode 100644
index 0000000..df9a8f7
--- /dev/null
+++ b/doc/timerate.n
@@ -0,0 +1,114 @@
+'\"
+'\" Copyright (c) 2005 Sergey Brester aka sebres.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH timerate n "" Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+timerate \- Time-related execution resp. performance measurement of a script
+.SH SYNOPSIS
+\fBtimerate \fIscript\fR \fI?time?\fR
+.sp
+\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR
+.sp
+\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR
+.BE
+.SH DESCRIPTION
+.PP
+The first and second form will evaluate \fIscript\fR until the interval
+\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
+if \fItime\fR is not specified.
+.sp
+It will then return a canonical tcl-list of the form
+.PP
+.CS
+\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
+.CE
+.PP
+which indicates:
+.IP \(bu
+the average amount of time required per iteration, in microseconds (lindex $result 0)
+.IP \(bu
+the count how many times it was executed (lindex $result 2)
+.IP \(bu
+the estimated rate per second (lindex $result 4)
+.IP \(bu
+the estimated real execution time without measurement overhead (lindex $result 6)
+.PP
+Time is measured in elapsed time using heighest timer resolution as possible, not CPU time.
+This command may be used to provide information as to how well the script or a tcl-command
+is performing and can help determine bottlenecks and fine-tune application performance.
+.PP
+\fI-calibrate\fR
+.
+To measure very fast scripts as exact as posible the calibration process
+may be required.
+
+This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead
+of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR.
+It can take up to 10 seconds if parameter \fItime\fR is not specified.
+.PP
+\fI-overhead double\fR
+.
+This parameter used to supply the measurement overhead of single iteration
+(in microseconds) that should be ignored during whole evaluation process.
+.PP
+\fI-direct\fR
+.
+Causes direct execution per iteration (not compiled variant of evaluation used).
+.PP
+In opposition to \fBtime\fR the execution limited here by fixed time instead of
+repetition count.
+Additionally the compiled variant of the script will be used during whole evaluation
+(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified.
+Therefore it provides more precise results and prevents very long execution time
+by slow scripts resp. scripts with unknown speed.
+
+.SH EXAMPLE
+Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
+operations on variable \fIi\fR) to count to a ten:
+.PP
+.CS
+# calibrate:
+timerate -calibrate {}
+# measure:
+timerate { for {set i 0} {$i<10} {incr i} {} } 5000
+.CE
+.PP
+Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the
+overhead for operations on variable \fIi\fR) to count to a ten:
+.PP
+.CS
+# calibrate for overhead of variable operations:
+set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000
+# measure:
+timerate { for {set i 0} {$i<10} {incr i} {} } 5000
+.CE
+.PP
+Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring
+overhead of the rest, without measurement how fast it takes for a whole script:
+.PP
+.CS
+# calibrate:
+timerate -calibrate {}
+# estimate overhead:
+set tm 0
+set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
+# measure using esimated overhead:
+set tm 0
+timerate -overhead $ovh {
+ clock format $tm -format %H
+ incr tm [expr {24*60*60}]; # overhead for this is ignored
+} 5000
+.CE
+.SH "SEE ALSO"
+time(n)
+.SH KEYWORDS
+script, timerate, time
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e014b06..0226752 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -285,6 +285,9 @@ static const CmdInfo builtInCmds[] = {
{"source", Tcl_SourceObjCmd, NULL, TclNRSourceObjCmd, 0},
{"tell", Tcl_TellObjCmd, NULL, NULL, CMD_IS_SAFE},
{"time", Tcl_TimeObjCmd, NULL, NULL, CMD_IS_SAFE},
+#ifdef TCL_TIMERATE
+ {"timerate", Tcl_TimeRateObjCmd, NULL, NULL, CMD_IS_SAFE},
+#endif
{"unload", Tcl_UnloadObjCmd, NULL, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, NULL, CMD_IS_SAFE},
{"vwait", Tcl_VwaitObjCmd, NULL, NULL, CMD_IS_SAFE},
@@ -845,6 +848,10 @@ Tcl_CreateInterp(void)
Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
NRCoroInjectObjCmd, NULL, NULL);
+ /* Adding the timerate (unsupported) command */
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate",
+ Tcl_TimeRateObjCmd, NULL, NULL);
+
#ifdef USE_DTRACE
/*
* Register the tcl::dtrace command.
diff --git a/generic/tclClock.c b/generic/tclClock.c
index bbfc83b..4389e16 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -8,12 +8,15 @@
* 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.
*/
#include "tclInt.h"
+#include "tclStrIdxTree.h"
+#include "tclDate.h"
/*
* Windows has mktime. The configurators do not check.
@@ -24,21 +27,6 @@
#endif
/*
- * Constants
- */
-
-#define JULIAN_DAY_POSIX_EPOCH 2440588
-#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
*/
@@ -55,70 +43,13 @@ 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__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"
-};
-
-/*
- * Structure containing the client data for [clock]
- */
+CLOCK_LITERAL_ARRAY(Literals);
-typedef struct {
- size_t refCount; /* Number of live references. */
- Tcl_Obj **literals; /* Pool of object literals. */
-} ClockClientData;
+/* 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_");
-/*
- * 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 };
/*
@@ -139,33 +70,34 @@ TCL_DECLARE_MUTEX(clockMutex)
* Function prototypes for local procedures in this file:
*/
-static int ConvertUTCToLocal(Tcl_Interp *,
- TclDateFields *, Tcl_Obj *, int);
static int ConvertUTCToLocalUsingTable(Tcl_Interp *,
- TclDateFields *, int, Tcl_Obj *const[]);
+ TclDateFields *, int, Tcl_Obj *const[],
+ Tcl_WideInt *rangesVal);
static int ConvertUTCToLocalUsingC(Tcl_Interp *,
TclDateFields *, int);
-static int ConvertLocalToUTC(Tcl_Interp *,
- TclDateFields *, Tcl_Obj *, 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);
static int ConvertLocalToUTCUsingC(Tcl_Interp *,
TclDateFields *, int);
-static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
- int, Tcl_Obj *const *);
+static int ClockConfigureObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
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 IsGregorianLeapYear(TclDateFields *);
-static int WeekdayOnOrBefore(int, int);
+static Tcl_WideInt WeekdayOnOrBefore(int, Tcl_WideInt);
static int ClockClicksObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int ClockConvertlocaltoutcObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+
+static int ClockGetDateFields(ClientData clientData,
+ Tcl_Interp *interp, TclDateFields *fields,
+ Tcl_Obj *timezoneObj, int changeover);
static int ClockGetdatefieldsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
@@ -184,14 +116,31 @@ static int ClockMicrosecondsObjCmd(
static int ClockMillisecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int ClockParseformatargsObjCmd(
+static int ClockSecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int ClockSecondsObjCmd(
+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[]);
+static int ClockScanCommit(
+ register DateInfo *info,
+ register ClockFmtScnCmdArgs *opts);
+static int ClockFreeScan(
+ 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 int ClockValidDate(
+ register DateInfo *,
+ register ClockFmtScnCmdArgs *, int stage);
static struct tm * ThreadSafeLocalTime(const time_t *);
-static void TzsetIfNecessary(void);
+static size_t TzsetIfNecessary(void);
static void ClockDeleteCmdProc(ClientData);
/*
@@ -202,22 +151,31 @@ 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. */
+ CompileProc *compileProc; /* The compiler for the command. */
+ ClientData clientData; /* Any clientData to give the command (if NULL
+ * a reference to ClockClientData will be sent) */
};
static const struct ClockCommand clockCommands[] = {
- { "getenv", ClockGetenvObjCmd },
- { "Oldscan", TclClockOldscanObjCmd },
- { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
- { "GetDateFields", ClockGetdatefieldsObjCmd },
- { "GetJulianDayFromEraYearMonthDay",
- ClockGetjuliandayfromerayearmonthdayObjCmd },
- { "GetJulianDayFromEraYearWeekDay",
- ClockGetjuliandayfromerayearweekdayObjCmd },
- { "ParseFormatArgs", ClockParseformatargsObjCmd },
- { NULL, NULL }
+ {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL},
+ {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)},
+ {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)},
+ {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)},
+ {"configure", ClockConfigureObjCmd, NULL, NULL},
+ {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL},
+ {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL},
+ {"GetJulianDayFromEraYearMonthDay",
+ ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL},
+ {"GetJulianDayFromEraYearWeekDay",
+ ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL},
+ {NULL, NULL, NULL, NULL}
};
/*
@@ -246,22 +204,10 @@ TclClockInit(
char cmdName[50]; /* Buffer large enough to hold the string
*::tcl::clock::GetJulianDayFromEraYearMonthDay
* plus a terminating NUL. */
+ Command *cmdPtr;
ClockClientData *data;
int i;
- /* Structure of the 'clock' ensemble */
-
- static const EnsembleImplMap clockImplMap[] = {
- {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
- {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0},
- {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
- {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
- {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
- {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0},
- {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
- {NULL, NULL, NULL, NULL, NULL, 0}
- };
-
/*
* Safe interps get [::clock] as alias to a master, so do not need their
* own copies of the support routines.
@@ -279,27 +225,1145 @@ 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->mcDicts = NULL;
+ data->lastTZEpoch = 0;
+ data->currentYearCentury = ClockDefaultYearCentury;
+ data->yearOfCenturySwitch = ClockDefaultCenturySwitch;
+ data->validMinYear = INT_MIN;
+ data->validMaxYear = INT_MAX;
+
+ data->systemTimeZone = NULL;
+ data->systemSetupTZData = NULL;
+ data->gmtSetupTimeZoneUnnorm = NULL;
+ data->gmtSetupTimeZone = NULL;
+ data->gmtSetupTZData = NULL;
+ data->gmtTZName = NULL;
+ data->lastSetupTimeZoneUnnorm = NULL;
+ data->lastSetupTimeZone = NULL;
+ data->lastSetupTZData = NULL;
+ data->prevSetupTimeZoneUnnorm = NULL;
+ data->prevSetupTimeZone = NULL;
+ data->prevSetupTZData = NULL;
+
+ data->defaultLocale = NULL;
+ data->defaultLocaleDict = NULL;
+ data->currentLocale = NULL;
+ data->currentLocaleDict = NULL;
+ data->lastUsedLocaleUnnorm = NULL;
+ data->lastUsedLocale = NULL;
+ data->lastUsedLocaleDict = NULL;
+ data->prevUsedLocaleUnnorm = NULL;
+ data->prevUsedLocale = NULL;
+ data->prevUsedLocaleDict = NULL;
+
+ data->lastBase.timezoneObj = NULL;
+
+ memset(&data->lastTZOffsCache, 0, sizeof(data->lastTZOffsCache));
+
+ data->defFlags = 0;
/*
* Install the commands.
- * TODO - Let Tcl_MakeEnsemble do this?
*/
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
+ ClientData clientData;
+
strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
- data->refCount++;
- Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
- ClockDeleteCmdProc);
+ if (!(clientData = clockCmdPtr->clientData)) {
+ clientData = data;
+ data->refCount++;
+ }
+ cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName,
+ clockCmdPtr->objCmdProc, clientData,
+ clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc);
+ cmdPtr->compileProc = clockCmdPtr->compileProc ?
+ clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockConfigureClear --
+ *
+ * Clean up cached resp. run-time storages used in clock commands.
+ *
+ * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear".
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockConfigureClear(
+ ClockClientData *data)
+{
+ ClockFrmScnClearCaches();
+
+ data->lastTZEpoch = 0;
+ Tcl_UnsetObjRef(data->systemTimeZone);
+ Tcl_UnsetObjRef(data->systemSetupTZData);
+ Tcl_UnsetObjRef(data->gmtSetupTimeZoneUnnorm);
+ Tcl_UnsetObjRef(data->gmtSetupTimeZone);
+ Tcl_UnsetObjRef(data->gmtSetupTZData);
+ Tcl_UnsetObjRef(data->gmtTZName);
+ Tcl_UnsetObjRef(data->lastSetupTimeZoneUnnorm);
+ Tcl_UnsetObjRef(data->lastSetupTimeZone);
+ Tcl_UnsetObjRef(data->lastSetupTZData);
+ Tcl_UnsetObjRef(data->prevSetupTimeZoneUnnorm);
+ Tcl_UnsetObjRef(data->prevSetupTimeZone);
+ Tcl_UnsetObjRef(data->prevSetupTZData);
+
+ Tcl_UnsetObjRef(data->defaultLocale);
+ data->defaultLocaleDict = NULL;
+ Tcl_UnsetObjRef(data->currentLocale);
+ data->currentLocaleDict = NULL;
+ Tcl_UnsetObjRef(data->lastUsedLocaleUnnorm);
+ Tcl_UnsetObjRef(data->lastUsedLocale);
+ data->lastUsedLocaleDict = NULL;
+ Tcl_UnsetObjRef(data->prevUsedLocaleUnnorm);
+ Tcl_UnsetObjRef(data->prevUsedLocale);
+ data->prevUsedLocaleDict = NULL;
+
+ Tcl_UnsetObjRef(data->lastBase.timezoneObj);
+
+ Tcl_UnsetObjRef(data->lastTZOffsCache[0].timezoneObj);
+ Tcl_UnsetObjRef(data->lastTZOffsCache[0].tzName);
+ Tcl_UnsetObjRef(data->lastTZOffsCache[1].timezoneObj);
+ Tcl_UnsetObjRef(data->lastTZOffsCache[1].tzName);
+
+ Tcl_UnsetObjRef(data->mcDicts);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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->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);
+
+ ckfree(data->literals);
+ ckfree(data);
}
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SavePrevTimezoneObj --
+ *
+ * Used to store previously used/cached time zone (makes it reusable).
+ *
+ * This enables faster switch between time zones (e. g. to convert from one to another).
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- /* Make the clock ensemble */
+static inline void
+SavePrevTimezoneObj(
+ ClockClientData *dataPtr) /* Client data containing literal pool */
+{
+ Tcl_Obj *timezoneObj = dataPtr->lastSetupTimeZone;
+ if (timezoneObj && timezoneObj != dataPtr->prevSetupTimeZone) {
+ Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, dataPtr->lastSetupTimeZoneUnnorm);
+ Tcl_SetObjRef(dataPtr->prevSetupTimeZone, timezoneObj);
+ Tcl_SetObjRef(dataPtr->prevSetupTZData, dataPtr->lastSetupTZData);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 Tcl_Obj *
+NormTimezoneObj(
+ ClockClientData *dataPtr, /* Client data containing literal pool */
+ Tcl_Obj *timezoneObj, /* Name of zone to find */
+ int *loaded) /* Used to recognized TZ was loaded */
+{
+ const char *tz;
- TclMakeEnsemble(interp, "clock", clockImplMap);
+ *loaded = 1;
+ if ( timezoneObj == dataPtr->lastSetupTimeZoneUnnorm
+ && dataPtr->lastSetupTimeZone != NULL
+ ) {
+ return dataPtr->lastSetupTimeZone;
+ }
+ if ( timezoneObj == dataPtr->prevSetupTimeZoneUnnorm
+ && dataPtr->prevSetupTimeZone != NULL
+ ) {
+ return dataPtr->prevSetupTimeZone;
+ }
+ if (timezoneObj == dataPtr->gmtSetupTimeZoneUnnorm
+ && dataPtr->gmtSetupTimeZone != NULL
+ ) {
+ return dataPtr->literals[LIT_GMT];
+ }
+ if ( timezoneObj == dataPtr->lastSetupTimeZone
+ || timezoneObj == dataPtr->prevSetupTimeZone
+ || timezoneObj == dataPtr->gmtSetupTimeZone
+ || timezoneObj == dataPtr->systemTimeZone
+ ) {
+ return timezoneObj;
+ }
+
+ tz = TclGetString(timezoneObj);
+ if (dataPtr->lastSetupTimeZone != NULL &&
+ strcmp(tz, TclGetString(dataPtr->lastSetupTimeZone)) == 0
+ ) {
+ Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj);
+ return dataPtr->lastSetupTimeZone;
+ }
+ if (dataPtr->prevSetupTimeZone != NULL &&
+ strcmp(tz, TclGetString(dataPtr->prevSetupTimeZone)) == 0
+ ) {
+ Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, timezoneObj);
+ return dataPtr->prevSetupTimeZone;
+ }
+ if (dataPtr->systemTimeZone != NULL &&
+ strcmp(tz, TclGetString(dataPtr->systemTimeZone)) == 0
+ ) {
+ return dataPtr->systemTimeZone;
+ }
+ if (strcmp(tz, Literals[LIT_GMT]) == 0) {
+ Tcl_SetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, timezoneObj);
+ if (dataPtr->gmtSetupTimeZone == NULL) {
+ *loaded = 0;
+ }
+ return dataPtr->literals[LIT_GMT];
+ }
+ /* unknown/unloaded tz - recache/revalidate later as last-setup if needed */
+ *loaded = 0;
+ return timezoneObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) {
+ return NULL;
+ }
+
+ return Tcl_GetObjResult(interp);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+ 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));
+ dataPtr->currentLocaleDict = NULL;
+ Tcl_ResetResult(interp);
+
+ return dataPtr->currentLocale;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SavePrevLocaleObj --
+ *
+ * Used to store previously used/cached locale (makes it reusable).
+ *
+ * This enables faster switch between locales (e. g. to convert from one to another).
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+SavePrevLocaleObj(
+ ClockClientData *dataPtr) /* Client data containing literal pool */
+{
+ Tcl_Obj *localeObj = dataPtr->lastUsedLocale;
+ if (localeObj && localeObj != dataPtr->prevUsedLocale) {
+ Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, dataPtr->lastUsedLocaleUnnorm);
+ Tcl_SetObjRef(dataPtr->prevUsedLocale, localeObj);
+ /* mcDicts owns reference to dict */
+ dataPtr->prevUsedLocaleDict = dataPtr->lastUsedLocaleDict;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *localeObj,
+ Tcl_Obj **mcDictObj)
+{
+ const char *loc, *loc2;
+ if ( localeObj == NULL
+ || localeObj == dataPtr->literals[LIT_C]
+ || localeObj == dataPtr->defaultLocale
+ ) {
+ *mcDictObj = dataPtr->defaultLocaleDict;
+ return dataPtr->defaultLocale ?
+ dataPtr->defaultLocale : dataPtr->literals[LIT_C];
+ }
+ if ( localeObj == dataPtr->currentLocale
+ || localeObj == dataPtr->literals[LIT_CURRENT]
+ ) {
+ if (dataPtr->currentLocale == NULL) {
+ ClockGetCurrentLocale(dataPtr, interp);
+ }
+ *mcDictObj = dataPtr->currentLocaleDict;
+ return dataPtr->currentLocale;
+ }
+ if ( localeObj == dataPtr->lastUsedLocale
+ || localeObj == dataPtr->lastUsedLocaleUnnorm
+ ) {
+ *mcDictObj = dataPtr->lastUsedLocaleDict;
+ return dataPtr->lastUsedLocale;
+ }
+ if ( localeObj == dataPtr->prevUsedLocale
+ || localeObj == dataPtr->prevUsedLocaleUnnorm
+ ) {
+ *mcDictObj = dataPtr->prevUsedLocaleDict;
+ return dataPtr->prevUsedLocale;
+ }
+
+ loc = TclGetString(localeObj);
+ if ( dataPtr->currentLocale != NULL
+ && ( localeObj == dataPtr->currentLocale
+ || (localeObj->length == dataPtr->currentLocale->length
+ && strcmp(loc, TclGetString(dataPtr->currentLocale)) == 0
+ )
+ )
+ ) {
+ *mcDictObj = dataPtr->currentLocaleDict;
+ return dataPtr->currentLocale;
+ }
+ if ( dataPtr->lastUsedLocale != NULL
+ && ( localeObj == dataPtr->lastUsedLocale
+ || (localeObj->length == dataPtr->lastUsedLocale->length
+ && strcmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0
+ )
+ )
+ ) {
+ *mcDictObj = dataPtr->lastUsedLocaleDict;
+ Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj);
+ return dataPtr->lastUsedLocale;
+ }
+ if ( dataPtr->prevUsedLocale != NULL
+ && ( localeObj == dataPtr->prevUsedLocale
+ || (localeObj->length == dataPtr->prevUsedLocale->length
+ && strcmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0
+ )
+ )
+ ) {
+ *mcDictObj = dataPtr->prevUsedLocaleDict;
+ Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, localeObj);
+ return dataPtr->prevUsedLocale;
+ }
+ if (
+ (localeObj->length == 1 /* C */
+ && strcasecmp(loc, Literals[LIT_C]) == 0)
+ || (dataPtr->defaultLocale && (loc2 = TclGetString(dataPtr->defaultLocale))
+ && localeObj->length == dataPtr->defaultLocale->length
+ && strcasecmp(loc, loc2) == 0)
+ ) {
+ *mcDictObj = dataPtr->defaultLocaleDict;
+ return dataPtr->defaultLocale ?
+ dataPtr->defaultLocale : dataPtr->literals[LIT_C];
+ }
+ if ( localeObj->length == 7 /* current */
+ && strcasecmp(loc, Literals[LIT_CURRENT]) == 0
+ ) {
+ if (dataPtr->currentLocale == NULL) {
+ ClockGetCurrentLocale(dataPtr, interp);
+ }
+ *mcDictObj = dataPtr->currentLocaleDict;
+ return dataPtr->currentLocale;
+ }
+ if (
+ (localeObj->length == 6 /* system */
+ && strcasecmp(loc, Literals[LIT_SYSTEM]) == 0)
+ ) {
+ SavePrevLocaleObj(dataPtr);
+ Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj);
+ localeObj = ClockGetSystemLocale(dataPtr, interp);
+ Tcl_SetObjRef(dataPtr->lastUsedLocale, localeObj);
+ *mcDictObj = NULL;
+ return localeObj;
+ }
+ *mcDictObj = NULL;
+ return localeObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+ClockMCDict(ClockFmtScnCmdArgs *opts)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ /* 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->interp,
+ opts->localeObj, &opts->mcDictObj);
+
+ if (opts->localeObj == NULL) {
+ Tcl_SetObjResult(opts->interp,
+ Tcl_NewStringObj("locale not specified and no default locale set", -1));
+ 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 || opts->mcDictObj->refCount > 1) {
+ Tcl_Obj *callargs[2];
+
+ /* first try to find it own 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) {
+ /* get msgcat dictionary - ::tcl::clock::mcget locale */
+ callargs[0] = dataPtr->literals[LIT_MCGET];
+ callargs[1] = opts->localeObj;
+
+ if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) {
+ return NULL;
+ }
+
+ opts->mcDictObj = Tcl_GetObjResult(opts->interp);
+ Tcl_ResetResult(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);
+ }
+
+ /* 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
+ ) {
+ dataPtr->defaultLocaleDict = opts->mcDictObj;
+ }
+ if ( opts->localeObj == dataPtr->currentLocale ) {
+ dataPtr->currentLocaleDict = opts->mcDictObj;
+ } else if ( opts->localeObj == dataPtr->lastUsedLocale ) {
+ dataPtr->lastUsedLocaleDict = opts->mcDictObj;
+ } else {
+ SavePrevLocaleObj(dataPtr);
+ Tcl_SetObjRef(dataPtr->lastUsedLocale, opts->localeObj);
+ Tcl_UnsetObjRef(dataPtr->lastUsedLocaleUnnorm);
+ dataPtr->lastUsedLocaleDict = opts->mcDictObj;
+ }
+ }
+ }
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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,
+ 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 object */
+ if (dataPtr->mcLitIdxs == NULL) {
+ return NULL;
+ }
+
+ if (Tcl_DictObjGet(NULL, opts->mcDictObj,
+ dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK
+ ) {
+ return NULL;
+ }
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockMCSetIdx(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey, Tcl_Obj *valObj)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ if (opts->mcDictObj == NULL) {
+ ClockMCDict(opts);
+ if (opts->mcDictObj == NULL)
+ return TCL_ERROR;
+ }
+
+ /* 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 Tcl_DictObjPut(opts->interp, opts->mcDictObj,
+ dataPtr->mcLitIdxs[mcKey], valObj);
+}
+
+static void
+TimezoneLoaded(
+ ClockClientData *dataPtr,
+ Tcl_Obj *timezoneObj, /* Name of zone was loaded */
+ Tcl_Obj *tzUnnormObj) /* Name of zone was loaded */
+{
+ /* last setup zone loaded */
+ if (dataPtr->lastSetupTimeZone != timezoneObj) {
+ SavePrevTimezoneObj(dataPtr);
+ Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->lastSetupTZData);
+ }
+ Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, tzUnnormObj);
+
+ /* mark GMT zone loaded */
+ if ( dataPtr->gmtSetupTimeZone == NULL
+ && timezoneObj == dataPtr->literals[LIT_GMT]
+ ) {
+ Tcl_SetObjRef(dataPtr->gmtSetupTimeZone,
+ dataPtr->literals[LIT_GMT]);
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter vector */
+{
+ ClockClientData *dataPtr = clientData;
+
+ static const char *const options[] = {
+ "-system-tz", "-setup-tz", "-default-locale", "-current-locale",
+ "-clear",
+ "-year-century", "-century-switch",
+ "-min-year", "-max-year", "-validate",
+ NULL
+ };
+ enum optionInd {
+ CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE,
+ CLOCK_CLEAR_CACHE,
+ CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
+ CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_VALIDATE
+ };
+ int optionIndex; /* Index of an option. */
+ int i;
+
+ 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-1]), NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case CLOCK_SYSTEM_TZ:
+ if (1) {
+ /* validate current tz-epoch */
+ size_t lastTZEpoch = TzsetIfNecessary();
+ if (i < objc) {
+ if (dataPtr->systemTimeZone != objv[i]) {
+ Tcl_SetObjRef(dataPtr->systemTimeZone, objv[i]);
+ Tcl_UnsetObjRef(dataPtr->systemSetupTZData);
+ }
+ dataPtr->lastTZEpoch = lastTZEpoch;
+ }
+ if (i+1 >= objc && dataPtr->systemTimeZone != NULL
+ && dataPtr->lastTZEpoch == lastTZEpoch) {
+ Tcl_SetObjResult(interp, dataPtr->systemTimeZone);
+ }
+ }
+ break;
+ case CLOCK_SETUP_TZ:
+ if (i < objc) {
+ int loaded;
+ Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i], &loaded);
+ if (!loaded) {
+ TimezoneLoaded(dataPtr, timezoneObj, objv[i]);
+ }
+ Tcl_SetObjResult(interp, timezoneObj);
+ }
+ else
+ if (i+1 >= objc && dataPtr->lastSetupTimeZone != NULL) {
+ Tcl_SetObjResult(interp, dataPtr->lastSetupTimeZone);
+ }
+ break;
+ case CLOCK_DEFAULT_LOCALE:
+ if (i < objc) {
+ if (dataPtr->defaultLocale != objv[i]) {
+ Tcl_SetObjRef(dataPtr->defaultLocale, objv[i]);
+ dataPtr->defaultLocaleDict = NULL;
+ }
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp, dataPtr->defaultLocale ?
+ dataPtr->defaultLocale : dataPtr->literals[LIT_C]);
+ }
+ break;
+ case CLOCK_CURRENT_LOCALE:
+ if (i < objc) {
+ if (dataPtr->currentLocale != objv[i]) {
+ Tcl_SetObjRef(dataPtr->currentLocale, objv[i]);
+ dataPtr->currentLocaleDict = NULL;
+ }
+ }
+ if (i+1 >= objc && dataPtr->currentLocale != NULL) {
+ Tcl_SetObjResult(interp, dataPtr->currentLocale);
+ }
+ break;
+ case CLOCK_YEAR_CENTURY:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->currentYearCentury = year;
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp, objv[i]);
+ }
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->currentYearCentury));
+ }
+ break;
+ case CLOCK_CENTURY_SWITCH:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->yearOfCenturySwitch = year;
+ Tcl_SetObjResult(interp, objv[i]);
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->yearOfCenturySwitch));
+ }
+ break;
+ case CLOCK_MIN_YEAR:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->validMinYear = year;
+ Tcl_SetObjResult(interp, objv[i]);
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->validMinYear));
+ }
+ break;
+ case CLOCK_MAX_YEAR:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->validMaxYear = year;
+ Tcl_SetObjResult(interp, objv[i]);
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->validMaxYear));
+ }
+ break;
+ case CLOCK_VALIDATE:
+ if (i < objc) {
+ int val;
+ if (Tcl_GetBooleanFromObj(interp, objv[i], &val) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (val) {
+ dataPtr->defFlags |= CLF_VALIDATE;
+ } else {
+ dataPtr->defFlags &= ~CLF_VALIDATE;
+ }
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->defFlags & CLF_VALIDATE ? 1 : 0));
+ }
+ break;
+ case CLOCK_CLEAR_CACHE:
+ ClockConfigureClear(dataPtr);
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *timezoneObj) /* Name of the timezone */
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj *ret, **out = NULL;
+
+ /* if cached (if already setup this one) */
+ if ( timezoneObj == dataPtr->lastSetupTimeZone
+ || timezoneObj == dataPtr->lastSetupTimeZoneUnnorm
+ ) {
+ if (dataPtr->lastSetupTZData != NULL) {
+ return dataPtr->lastSetupTZData;
+ }
+ out = &dataPtr->lastSetupTZData;
+ }
+ /* differentiate GMT and system zones, because used often */
+ /* simple caching, because almost used the tz-data of last timezone
+ */
+ if (timezoneObj == dataPtr->systemTimeZone) {
+ if (dataPtr->systemSetupTZData != NULL) {
+ return dataPtr->systemSetupTZData;
+ }
+ out = &dataPtr->systemSetupTZData;
+ }
+ else
+ if ( timezoneObj == dataPtr->literals[LIT_GMT]
+ || timezoneObj == dataPtr->gmtSetupTimeZoneUnnorm
+ ) {
+ if (dataPtr->gmtSetupTZData != NULL) {
+ return dataPtr->gmtSetupTZData;
+ }
+ out = &dataPtr->gmtSetupTZData;
+ }
+ else
+ if ( timezoneObj == dataPtr->prevSetupTimeZone
+ || timezoneObj == dataPtr->prevSetupTimeZoneUnnorm
+ ) {
+ if (dataPtr->prevSetupTZData != NULL) {
+ return dataPtr->prevSetupTZData;
+ }
+ out = &dataPtr->prevSetupTZData;
+ }
+
+ ret = Tcl_ObjGetVar2(interp, dataPtr->literals[LIT_TZDATA],
+ timezoneObj, TCL_LEAVE_ERR_MSG);
+
+ /* cache using corresponding slot and as last used */
+ if (out != NULL) {
+ Tcl_SetObjRef(*out, ret);
+ }
+ else
+ if (dataPtr->lastSetupTimeZone != timezoneObj) {
+ SavePrevTimezoneObj(dataPtr);
+ Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->lastSetupTimeZoneUnnorm);
+ Tcl_SetObjRef(dataPtr->lastSetupTZData, ret);
+ }
+ return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetSystemTimeZone --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ClockGetSystemTimeZone(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ ClockClientData *dataPtr = clientData;
+
+ /* if known (cached and same epoch) - return now */
+ if (dataPtr->systemTimeZone != NULL
+ && dataPtr->lastTZEpoch == TzsetIfNecessary()) {
+ return dataPtr->systemTimeZone;
+ }
+
+ Tcl_UnsetObjRef(dataPtr->systemTimeZone);
+ Tcl_UnsetObjRef(dataPtr->systemSetupTZData);
+
+ if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
+ return NULL;
+ }
+ if (dataPtr->systemTimeZone == NULL) {
+ Tcl_SetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp));
+ }
+ Tcl_ResetResult(interp);
+ return dataPtr->systemTimeZone;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockSetupTimeZone --
+ *
+ * Sets up the timezone. Loads tzdata, etc.
+ *
+ * Results:
+ * Returns normalized timezone object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+ClockSetupTimeZone(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *timezoneObj)
+{
+ ClockClientData *dataPtr = clientData;
+ int loaded;
+ Tcl_Obj *callargs[2];
+
+ /* if cached (if already setup this one) */
+ if ( timezoneObj == dataPtr->literals[LIT_GMT]
+ && dataPtr->gmtSetupTZData != NULL
+ ) {
+ return timezoneObj;
+ }
+ if ( ( timezoneObj == dataPtr->lastSetupTimeZone
+ || timezoneObj == dataPtr->lastSetupTimeZoneUnnorm
+ ) && dataPtr->lastSetupTimeZone != NULL
+ ) {
+ return dataPtr->lastSetupTimeZone;
+ }
+ if ( ( timezoneObj == dataPtr->prevSetupTimeZone
+ || timezoneObj == dataPtr->prevSetupTimeZoneUnnorm
+ ) && dataPtr->prevSetupTimeZone != NULL
+ ) {
+ return dataPtr->prevSetupTimeZone;
+ }
+
+ /* differentiate normalized (last, GMT and system) zones, because used often and already set */
+ callargs[1] = NormTimezoneObj(dataPtr, timezoneObj, &loaded);
+ /* if loaded (setup already called for this TZ) */
+ if (loaded) {
+ return callargs[1];
+ }
+
+ /* before setup just take a look in TZData variable */
+ if (Tcl_ObjGetVar2(interp, dataPtr->literals[LIT_TZDATA], timezoneObj, 0)) {
+ /* put it to last slot and return normalized */
+ TimezoneLoaded(dataPtr, callargs[1], timezoneObj);
+ return callargs[1];
+ }
+ /* setup now */
+ callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE];
+ if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
+ /* save unnormalized last used */
+ Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj);
+ return callargs[1];
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
}
/*
@@ -311,11 +1375,11 @@ TclClockInit(
* 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:
@@ -337,7 +1401,6 @@ ClockConvertlocaltoutcObjCmd(
Tcl_Obj *const *objv) /* Parameter vector */
{
ClockClientData *data = clientData;
- Tcl_Obj *const *literals = data->literals;
Tcl_Obj *secondsObj;
Tcl_Obj *dict;
int changeover;
@@ -345,16 +1408,17 @@ ClockConvertlocaltoutcObjCmd(
int created = 0;
int status;
+ fields.tzName = NULL;
/*
* Check params and convert time.
*/
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];
- if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
+ if (Tcl_DictObjGet(interp, dict, data->literals[LIT_LOCALSECONDS],
&secondsObj)!= TCL_OK) {
return TCL_ERROR;
}
@@ -366,7 +1430,7 @@ ClockConvertlocaltoutcObjCmd(
if ((TclGetWideIntFromObj(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;
}
@@ -380,7 +1444,7 @@ ClockConvertlocaltoutcObjCmd(
created = 1;
Tcl_IncrRefCount(dict);
}
- status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS],
+ status = Tcl_DictObjPut(interp, dict, data->literals[LIT_SECONDS],
Tcl_NewWideIntObj(fields.seconds));
if (status == TCL_OK) {
Tcl_SetObjResult(interp, dict);
@@ -400,12 +1464,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
*
@@ -434,12 +1497,14 @@ ClockGetdatefieldsObjCmd(
Tcl_Obj *const *literals = data->literals;
int changeover;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
+ Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover");
return TCL_ERROR;
}
if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
@@ -457,28 +1522,14 @@ ClockGetdatefieldsObjCmd(
return TCL_ERROR;
}
- /*
- * Convert UTC time to local.
- */
+ /* Extract fields */
- if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
+ if (ClockGetDateFields(clientData, 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);
+ /* Make dict of fields */
dict = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
@@ -517,6 +1568,67 @@ 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 */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Pointer to result fields, where
+ * fields->seconds contains date to extract */
+ 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, timezoneObj,
+ changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract Julian day.
+ */
+
+ fields->julianDay = (fields->localSeconds + JULIAN_SEC_POSIX_EPOCH)
+ / SECONDS_PER_DAY;
+
+ /*
+ * Convert to Julian or Gregorian calendar.
+ */
+
+ GetGregorianEraYearDay(fields, changeover);
+ GetMonthDay(fields);
+ GetYearWeekDay(fields, changeover);
+
+
+ /*
+ * Seconds of the day.
+ */
+ fields->secondOfDay = (int)(fields->localSeconds % SECONDS_PER_DAY);
+ if (fields->secondOfDay < 0) {
+ fields->secondOfDay += SECONDS_PER_DAY;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ClockGetjuliandayfromerayearmonthdayObjCmd --
*
* Tcl command that converts a time from era-year-month-day to a Julian
@@ -591,6 +1703,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
int status;
int era = 0;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
@@ -675,6 +1789,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
int status;
int era = 0;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
@@ -742,18 +1858,63 @@ 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 */
+ 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 */
+ Tcl_WideInt seconds;
+ ClockLastTZOffs * ltzoc = NULL;
+
+ /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
+ if (timezoneObj == dataPtr->literals[LIT_GMT]) {
+ fields->seconds = fields->localSeconds;
+ fields->tzOffset = 0;
+ return TCL_OK;
+ }
+
+ /*
+ * Check cacheable conversion could be used
+ * (last-period UTC2Local cache within the same TZ and seconds)
+ */
+ for (rowc = 0; rowc < 2; rowc++) {
+ ltzoc = &dataPtr->lastTZOffsCache[rowc];
+ if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) {
+ ltzoc = NULL;
+ continue;
+ }
+ seconds = fields->localSeconds - ltzoc->tzOffset;
+ if ( seconds >= ltzoc->rangesVal[0]
+ && seconds < ltzoc->rangesVal[1]
+ ) {
+ /* the same time zone and offset (UTC time inside the last minute) */
+ fields->tzOffset = ltzoc->tzOffset;
+ fields->seconds = seconds;
+ return TCL_OK;
+ }
+ /* in the DST-hole (because of the check above) - correct localSeconds */
+ if (fields->localSeconds == ltzoc->localSeconds) {
+ /* the same time zone and offset (but we'll shift local-time) */
+ fields->tzOffset = ltzoc->tzOffset;
+ fields->seconds = seconds;
+ goto dstHole;
+ }
+ }
/*
* 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;
}
@@ -764,10 +1925,59 @@ ConvertLocalToUTC(
*/
if (rowc == 0) {
- return ConvertLocalToUTCUsingC(interp, fields, changeover);
+
+ if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) {
+ return TCL_ERROR;
+ };
+
+ /* we cannot cache (ranges unknown yet) - todo: check later the DST-hole here */
+ return TCL_OK;
+
} else {
- return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv);
+ Tcl_WideInt rangesVal[2];
+
+ if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv,
+ rangesVal) != TCL_OK) {
+ return TCL_ERROR;
+ };
+
+ seconds = fields->seconds;
+
+ /* Cache the last conversion */
+ if (ltzoc != NULL) { /* slot was found above */
+ /* timezoneObj and changeover are the same */
+ Tcl_SetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */
+ } else {
+ /* no TZ in cache - just move second slot down and use the first one */
+ ltzoc = &dataPtr->lastTZOffsCache[0];
+ Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName);
+ memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc));
+ Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj);
+ ltzoc->changeover = changeover;
+ Tcl_InitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */
+ }
+ ltzoc->localSeconds = fields->localSeconds;
+ ltzoc->rangesVal[0] = rangesVal[0];
+ ltzoc->rangesVal[1] = rangesVal[1];
+ ltzoc->tzOffset = fields->tzOffset;
}
+
+
+ /* check DST-hole: if retrieved seconds is out of range */
+ if ( ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1] ) {
+ dstHole:
+ #if 0
+ printf("given local-time is outside the time-zone (in DST-hole): "
+ "%d - offs %d => %d <= %d < %d\n",
+ (int)fields->localSeconds, fields->tzOffset,
+ (int)ltzoc->rangesVal[0], (int)seconds, (int)ltzoc->rangesVal[1]);
+ #endif
+ /* because we don't know real TZ (we're outsize), just invalidate local
+ * time (which could be verified in ClockValidDate later) */
+ fields->localSeconds = TCL_INV_SECONDS; /* not valid seconds */
+ }
+ return TCL_OK;
}
/*
@@ -793,15 +2003,18 @@ 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) /* Return bounds for time period */
{
Tcl_Obj *row;
int cellc;
Tcl_Obj **cellv;
- int have[8];
+ struct {
+ Tcl_Obj *tzName;
+ int tzOffset;
+ } have[8];
int nHave = 0;
int i;
- int found;
/*
* Perform an initial lookup assuming that local == UTC, and locate the
@@ -813,11 +2026,11 @@ ConvertLocalToUTCUsingTable(
* Saving Time transition.
*/
- found = 0;
fields->tzOffset = 0;
fields->seconds = fields->localSeconds;
- while (!found) {
- row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ while (1) {
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv,
+ rangesVal);
if ((row == NULL)
|| TclListObjGetElements(interp, row, &cellc,
&cellv) != TCL_OK
@@ -825,23 +2038,24 @@ ConvertLocalToUTCUsingTable(
&fields->tzOffset) != TCL_OK) {
return TCL_ERROR;
}
- found = 0;
- for (i = 0; !found && i < nHave; ++i) {
- if (have[i] == fields->tzOffset) {
- found = 1;
- break;
+ for (i = 0; i < nHave; ++i) {
+ if (have[i].tzOffset == fields->tzOffset) {
+ goto found;
}
}
- if (!found) {
- if (nHave == 8) {
- Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
- }
- have[nHave++] = fields->tzOffset;
+ if (nHave == 8) {
+ Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
}
+ have[nHave].tzName = cellv[3];
+ have[nHave++].tzOffset = fields->tzOffset;
fields->seconds = fields->localSeconds - fields->tzOffset;
}
- fields->tzOffset = have[i];
+
+ found:
+ fields->tzOffset = have[i].tzOffset;
fields->seconds = fields->localSeconds - fields->tzOffset;
+ Tcl_SetObjRef(fields->tzName, have[i].tzName);
+
return TCL_OK;
}
@@ -879,7 +2093,7 @@ ConvertLocalToUTCUsingC(
*/
jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH;
- fields->julianDay = (int) (jsec / SECONDS_PER_DAY);
+ fields->julianDay = (jsec / SECONDS_PER_DAY);
secondOfDay = (int)(jsec % SECONDS_PER_DAY);
if (secondOfDay < 0) {
secondOfDay += SECONDS_PER_DAY;
@@ -943,20 +2157,67 @@ ConvertLocalToUTCUsingC(
*----------------------------------------------------------------------
*/
-static int
+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 */
+ 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 */
+ ClockLastTZOffs * ltzoc = NULL;
+
+ /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
+ if (timezoneObj == dataPtr->literals[LIT_GMT]) {
+ fields->localSeconds = fields->seconds;
+ fields->tzOffset = 0;
+ if (dataPtr->gmtTZName == NULL) {
+ Tcl_Obj *tzName;
+ tzdata = ClockGetTZData(clientData, interp, timezoneObj);
+ if ( TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK
+ || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjRef(dataPtr->gmtTZName, tzName);
+ }
+ Tcl_SetObjRef(fields->tzName, dataPtr->gmtTZName);
+ return TCL_OK;
+ }
+
+ /*
+ * Check cacheable conversion could be used
+ * (last-period UTC2Local cache within the same TZ and seconds)
+ */
+ for (rowc = 0; rowc < 2; rowc++) {
+ ltzoc = &dataPtr->lastTZOffsCache[rowc];
+ if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) {
+ ltzoc = NULL;
+ continue;
+ }
+ if ( fields->seconds >= ltzoc->rangesVal[0]
+ && fields->seconds < ltzoc->rangesVal[1]
+ ) {
+ /* the same time zone and offset (UTC time inside the last minute) */
+ fields->tzOffset = ltzoc->tzOffset;
+ fields->localSeconds = fields->seconds + fields->tzOffset;
+ Tcl_SetObjRef(fields->tzName, ltzoc->tzName);
+ return TCL_OK;
+ }
+ }
/*
* 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;
}
@@ -967,10 +2228,41 @@ ConvertUTCToLocal(
*/
if (rowc == 0) {
- return ConvertUTCToLocalUsingC(interp, fields, changeover);
+
+ if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* we cannot cache (ranges unknown yet) */
} else {
- return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv);
+ Tcl_WideInt rangesVal[2];
+
+ if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv,
+ rangesVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Cache the last conversion */
+ if (ltzoc != NULL) { /* slot was found above */
+ /* timezoneObj and changeover are the same */
+ Tcl_SetObjRef(ltzoc->tzName, fields->tzName);
+ } else {
+ /* no TZ in cache - just move second slot down and use the first one */
+ ltzoc = &dataPtr->lastTZOffsCache[0];
+ Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName);
+ memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc));
+ Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj);
+ ltzoc->changeover = changeover;
+ Tcl_InitObjRef(ltzoc->tzName, fields->tzName);
+ }
+ ltzoc->localSeconds = fields->localSeconds;
+ ltzoc->rangesVal[0] = rangesVal[0];
+ ltzoc->rangesVal[1] = rangesVal[1];
+ ltzoc->tzOffset = fields->tzOffset;
}
+
+ return TCL_OK;
}
/*
@@ -997,7 +2289,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) /* Return bounds for time period */
{
Tcl_Obj *row; /* Row containing the current information */
int cellc; /* Count of cells in the row (must be 4) */
@@ -1007,7 +2300,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) {
@@ -1018,8 +2311,7 @@ ConvertUTCToLocalUsingTable(
* Convert the time.
*/
- fields->tzName = cellv[3];
- Tcl_IncrRefCount(fields->tzName);
+ Tcl_SetObjRef(fields->tzName, cellv[3]);
fields->localSeconds = fields->seconds + fields->tzOffset;
return TCL_OK;
}
@@ -1112,8 +2404,7 @@ ConvertUTCToLocalUsingC(
if (diff > 0) {
sprintf(buffer+5, "%02d", diff);
}
- fields->tzName = Tcl_NewStringObj(buffer, -1);
- Tcl_IncrRefCount(fields->tzName);
+ Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1));
return TCL_OK;
}
@@ -1131,17 +2422,18 @@ ConvertUTCToLocalUsingC(
*----------------------------------------------------------------------
*/
-static Tcl_Obj *
+Tcl_Obj *
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) /* Return bounds for time period */
{
- int l;
+ int l = 0;
int u;
Tcl_Obj *compObj;
- Tcl_WideInt compVal;
+ Tcl_WideInt compVal, fromVal = LLONG_MIN, toVal = LLONG_MAX;
/*
* Examine the first row to make sure we're in bounds.
@@ -1157,7 +2449,11 @@ LookupLastTransition(
* anyway.
*/
- if (tick < compVal) {
+ if (tick < (fromVal = compVal)) {
+ if (rangesVal) {
+ rangesVal[0] = fromVal;
+ rangesVal[1] = toVal;
+ }
return rowv[0];
}
@@ -1165,7 +2461,6 @@ LookupLastTransition(
* Binary-search to find the transition.
*/
- l = 0;
u = rowc-1;
while (l < u) {
int m = (l + u + 1) / 2;
@@ -1176,10 +2471,17 @@ LookupLastTransition(
}
if (tick >= compVal) {
l = m;
+ fromVal = compVal;
} else {
u = m-1;
+ toVal = compVal;
}
}
+
+ if (rangesVal) {
+ rangesVal[0] = fromVal;
+ rangesVal[1] = toVal;
+ }
return rowv[l];
}
@@ -1210,6 +2512,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.
@@ -1273,10 +2577,10 @@ GetGregorianEraYearDay(
TclDateFields *fields, /* Date fields containing 'julianDay' */
int changeover) /* Gregorian transition date */
{
- int jday = fields->julianDay;
- int day;
- int year;
- int n;
+ Tcl_WideInt jday = fields->julianDay;
+ Tcl_WideInt year;
+ Tcl_WideInt day;
+ Tcl_WideInt n;
if (jday >= changeover) {
/*
@@ -1360,12 +2664,12 @@ GetGregorianEraYearDay(
if (year <= 0) {
fields->era = BCE;
- fields->year = 1 - year;
+ fields->year = 1 - (int)year;
} else {
fields->era = CE;
- fields->year = year;
+ fields->year = (int)year;
}
- fields->dayOfYear = day + 1;
+ fields->dayOfYear = (int)(day + 1);
}
/*
@@ -1390,11 +2694,27 @@ GetMonthDay(
{
int day = fields->dayOfYear;
int month;
- const int *h = hath[IsGregorianLeapYear(fields)];
+ const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)];
- for (month = 0; month < 12 && day > h[month]; ++month) {
- day -= h[month];
+ /*
+ * Estimate month by calculating `dayOfYear / (365/12)`
+ */
+ month = (day*12) / dipm[12];
+ /* then do forwards backwards correction */
+ while (1) {
+ if (day > dipm[month]) {
+ if (month >= 11 || day <= dipm[month+1]) {
+ break;
+ }
+ month++;
+ } else {
+ if (month == 0) {
+ break;
+ }
+ month--;
+ }
}
+ day -= dipm[month];
fields->month = month+1;
fields->dayOfMonth = day;
}
@@ -1416,16 +2736,18 @@ GetMonthDay(
*----------------------------------------------------------------------
*/
-static void
+void
GetJulianDayFromEraYearWeekDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Julian Day Number of the Gregorian
* transition */
{
- int firstMonday; /* Julian day number of week 1, day 1 in the
+ Tcl_WideInt firstMonday; /* Julian day number of week 1, day 1 in the
* given year */
TclDateFields firstWeek;
+ firstWeek.tzName = NULL;
+
/*
* Find January 4 in the ISO8601 year, which will always be in week 1.
*/
@@ -1467,12 +2789,13 @@ GetJulianDayFromEraYearWeekDay(
*----------------------------------------------------------------------
*/
-static void
+void
GetJulianDayFromEraYearMonthDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Gregorian transition date as a Julian Day */
{
- int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;
+ Tcl_WideInt year, ym1, ym1o4, ym1o100, ym1o400;
+ int month, mm1, q, r;
if (fields->era == BCE) {
year = 1 - fields->year;
@@ -1563,6 +2886,61 @@ GetJulianDayFromEraYearMonthDay(
/*
*----------------------------------------------------------------------
*
+ * 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'
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+void
+GetJulianDayFromEraYearDay(
+ TclDateFields *fields, /* Date to convert */
+ int changeover) /* Gregorian transition date as a Julian Day */
+{
+ Tcl_WideInt 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 );
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
* IsGregorianLeapYear --
*
* Tests whether a given year is a leap year, in either Julian or
@@ -1574,11 +2952,11 @@ GetJulianDayFromEraYearMonthDay(
*----------------------------------------------------------------------
*/
-static int
+int
IsGregorianLeapYear(
TclDateFields *fields) /* Date to test */
{
- int year = fields->year;
+ Tcl_WideInt year = fields->year;
if (fields->era == BCE) {
year = 1 - year;
@@ -1610,10 +2988,10 @@ IsGregorianLeapYear(
*----------------------------------------------------------------------
*/
-static int
+static Tcl_WideInt
WeekdayOnOrBefore(
int dayOfWeek, /* Day of week; Sunday == 0 or 7 */
- int julianDay) /* Reference date */
+ Tcl_WideInt julianDay) /* Reference date */
{
int k = (dayOfWeek + 6) % 7;
if (k < 0) {
@@ -1755,7 +3133,7 @@ ClockClicksObjCmd(
}
break;
default:
- Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
+ Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?");
return TCL_ERROR;
}
@@ -1772,8 +3150,7 @@ ClockClicksObjCmd(
#endif
break;
case CLICKS_MICROS:
- Tcl_GetTime(&now);
- clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
+ clicks = TclpGetMicroseconds();
break;
}
@@ -1809,7 +3186,7 @@ ClockMillisecondsObjCmd(
Tcl_Time now;
if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds");
return TCL_ERROR;
}
Tcl_GetTime(&now);
@@ -1843,134 +3220,1272 @@ ClockMicrosecondsObjCmd(
int objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
- Tcl_Time now;
-
if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds");
return TCL_ERROR;
}
- Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
return TCL_OK;
}
+static inline void
+ClockInitFmtScnArgs(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ ClockFmtScnCmdArgs *opts)
+{
+ memset(opts, 0, sizeof(*opts));
+ opts->clientData = clientData;
+ opts->interp = interp;
+}
+
/*
*-----------------------------------------------------------------------------
*
- * ClockParseformatargsObjCmd --
+ * ClockParseFmtScnArgs --
*
- * Parses the arguments for [clock format].
+ * Parses the arguments for sub-commands "scan", "format" and "add".
*
- * Results:
- * Returns a standard Tcl result, whose value is a four-element list
- * comprising the time format, the locale, and the timezone.
+ * Note: common options table used here, because for the options often used
+ * the same literals (objects), so it avoids permanent "recompiling" of
+ * option object representation to indexType with another table.
*
- * 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.
+ * Results:
+ * Returns a standard Tcl result, and stores parsed options
+ * (format, the locale, timezone and base) in structure "opts".
*
*-----------------------------------------------------------------------------
*/
+#define CLC_FMT_ARGS (0)
+#define CLC_SCN_ARGS (1 << 0)
+#define CLC_ADD_ARGS (1 << 1)
+
static int
-ClockParseformatargsObjCmd(
- 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 */
-{
- 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]
+ Tcl_Obj *const objv[], /* Parameter vector */
+ int flags, /* Flags, differentiates between format, scan, add */
+ const char *syntax /* Syntax of the current command */
+) {
+ Tcl_Interp *interp = opts->interp;
+ ClockClientData *dataPtr = opts->clientData;
int gmtFlag = 0;
- static const char *const options[] = { /* Command line options expected */
- "-format", "-gmt", "-locale",
- "-timezone", NULL };
+ static const char *const options[] = {
+ "-base", "-format", "-gmt", "-locale", "-timezone", "-validate", NULL
+ };
enum optionInd {
- CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE,
- CLOCK_FORMAT_TIMEZONE
+ CLC_ARGS_BASE, CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE,
+ CLC_ARGS_TIMEZONE, CLC_ARGS_VALIDATE
};
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;
+ Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */
- /*
- * 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;
+ if ( flags & (CLC_SCN_ARGS) ) {
+ /* default flags (from configure) */
+ opts->flags |= dataPtr->defFlags & (CLF_VALIDATE);
+ } else {
+ /* clock value (as current base) */
+ opts->baseObj = objv[1];
+ saw |= (1 << CLC_ARGS_BASE);
}
/*
* 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;
+ /* 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) {
+ goto badOptionMsg;
+ }
+ /* if already specified */
+ if (saw & (1 << optionIndex)) {
+ if ( !(flags & CLC_SCN_ARGS)
+ && optionIndex == CLC_ARGS_BASE) {
+ goto badOptionMsg;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": doubly present",
+ TclGetString(objv[i]))
+ );
+ goto badOption;
}
switch (optionIndex) {
- case CLOCK_FORMAT_FORMAT:
- formatObj = objv[i+1];
+ 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:
- localeObj = objv[i+1];
+ case CLC_ARGS_LOCALE:
+ opts->localeObj = objv[i+1];
break;
- case CLOCK_FORMAT_TIMEZONE:
- timezoneObj = objv[i+1];
+ case CLC_ARGS_TIMEZONE:
+ opts->timezoneObj = objv[i+1];
+ break;
+ case CLC_ARGS_BASE:
+ opts->baseObj = objv[i+1];
+ break;
+ case CLC_ARGS_VALIDATE:
+ if ( !(flags & CLC_SCN_ARGS) ) {
+ goto badOptionMsg;
+ } else {
+ int val;
+ if (Tcl_GetBooleanFromObj(interp, objv[i+1], &val) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (val) {
+ opts->flags |= CLF_VALIDATE;
+ } else {
+ opts->flags &= ~CLF_VALIDATE;
+ }
+ }
break;
}
- saw |= 1 << optionIndex;
+ saw |= (1 << optionIndex);
}
/*
* Check options.
*/
- if (TclGetWideIntFromObj(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]);
+ if ((saw & (1 << CLC_ARGS_GMT))
+ && (saw & (1 << CLC_ARGS_TIMEZONE))) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1));
Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
return TCL_ERROR;
}
if (gmtFlag) {
- timezoneObj = litPtr[LIT_GMT];
+ opts->timezoneObj = dataPtr->literals[LIT_GMT];
+ }
+ else
+ /* If time zone not specified use system time zone */
+ if ( opts->timezoneObj == NULL
+ || TclGetString(opts->timezoneObj) == NULL
+ || opts->timezoneObj->length == 0
+ ) {
+ opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp);
+ if (opts->timezoneObj == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* Setup timezone (normalize object if needed and load TZ on demand) */
+
+ opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj);
+ if (opts->timezoneObj == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Base (by scan or add) or clock value (by format) */
+
+ if (opts->baseObj != NULL) {
+ register Tcl_Obj *baseObj = opts->baseObj;
+ /* bypass integer recognition if looks like option "-now" */
+ if (
+ (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') ||
+ TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK
+ ) {
+
+ /* we accept "-now" as current date-time */
+ static const char *const nowOpts[] = {
+ "-now", NULL
+ };
+ int idx;
+ if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now",
+ TCL_EXACT, &idx) == TCL_OK
+ ) {
+ goto baseNow;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(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. Additionally it may be too complex to calculate
+ * julianday etc (forwards/backwards) by too large/small values, thus
+ * just let accept a bit shorter values to avoid overflow.
+ * Note the year is currently an integer, thus avoid to overflow it also.
+ */
+
+ if ( baseObj->typePtr == &tclBignumType
+ || baseVal < TCL_MIN_SECONDS || baseVal > TCL_MAX_SECONDS
+ ) {
+ Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
+ return TCL_ERROR;
+ }
+
+ } else {
+
+baseNow:
+ {
+ Tcl_Time now;
+ Tcl_GetTime(&now);
+ baseVal = (Tcl_WideInt) now.sec;
+ }
+ }
+
+ /*
+ * 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(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);
+ }
+
+ return TCL_OK;
+
+badOptionMsg:
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": should be \"%s\"",
+ TclGetString(objv[i]), syntax)
+ );
+
+badOption:
+
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
+ i < objc ? Tcl_GetString(objv[i]) : NULL, NULL);
+
+ return TCL_ERROR;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+
+ static const char *syntax = "clock format clockval|-now "
+ "?-format string? "
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE?";
+ int ret;
+ ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
+ DateFormat dateFmt; /* Common structure used for formatting */
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 0, NULL, syntax);
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&dateFmt, 0, sizeof(dateFmt));
+
+ /*
+ * Extract values for the keywords.
+ */
+
+ ClockInitFmtScnArgs(clientData, interp, &opts);
+ ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv,
+ CLC_FMT_ARGS, syntax);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* Default format */
+ if (opts.formatObj == NULL) {
+ opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT];
+ }
+
+ /* Use compiled version of Format - */
+
+ ret = ClockFormat(&dateFmt, &opts);
+
+done:
+
+ Tcl_UnsetObjRef(dateFmt.date.tzName);
+
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockScanObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter values */
+{
+ static const char *syntax = "clock scan string "
+ "?-base seconds? "
+ "?-format string? "
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE? ?-validate boolean?";
+ int ret;
+ ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
+ DateInfo yy; /* Common structure used for parsing */
+ DateInfo *info = &yy;
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 0, NULL, syntax);
+ 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_SCN_ARGS, syntax);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* seconds are in localSeconds (relative base date), so reset time here */
+ yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; yyMeridian = MER24;
+
+ /* If free scan */
+ if (opts.formatObj == NULL) {
+ /* 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_SetObjResult(interp,
+ Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1));
+ Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL);
+ ret = TCL_ERROR;
+ goto done;
+ }
+ ret = ClockFreeScan(&yy, objv[1], &opts);
+ }
+ else {
+ /* Use compiled version of Scan - */
+
+ ret = ClockScan(&yy, objv[1], &opts);
+ }
+
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* Convert date info structure into UTC seconds */
+
+ ret = ClockScanCommit(&yy, &opts);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* Apply validation rules, if expected */
+ if ( (opts.flags & CLF_VALIDATE) ) {
+ ret = ClockValidDate(&yy, &opts, opts.formatObj == NULL ? 2 : 3);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+ }
+
+done:
+
+ Tcl_UnsetObjRef(yy.date.tzName);
+
+ if (ret != TCL_OK) {
+ 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(
+ 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_ISO8601WEAK)) {
+ GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ }
+ else
+ if ( !(info->flags & CLF_DAYOFYEAR) /* no day of year */
+ || (info->flags & (CLF_DAYOFMONTH|CLF_MONTH)) /* yymmdd over yyddd */
+ == (CLF_DAYOFMONTH|CLF_MONTH)
+ ) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ } else {
+ GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ }
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
+ }
+
+ /* some overflow checks, if not extended */
+ if (!(opts->flags & CLF_EXTENDED)) {
+ if (yydate.julianDay > 5373484) {
+ Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(
+ "requested date too large to represent", -1));
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Local seconds to UTC (stored in yydate.seconds) */
+
+ if (info->flags & (CLF_ASSEMBLE_SECONDS)) {
+ yydate.localSeconds =
+ -210866803200L
+ + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay )
+ + ( yySecondOfDay % SECONDS_PER_DAY );
+ }
+
+ if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_LOCALSEC)) {
+ if (ConvertLocalToUTC(opts->clientData, opts->interp, &yydate,
+ opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* Increment UTC seconds with relative time */
+
+ yydate.seconds += yyRelSeconds;
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockValidDate --
+ *
+ * Validate date info structure for wrong data (e. g. out of ranges).
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockValidDate(
+ register DateInfo *info, /* Clock scan info structure */
+ register
+ ClockFmtScnCmdArgs *opts, /* Scan options */
+ int stage) /* Stage to validate (1, 2 or 3 for both) */
+{
+ const char *errMsg = "", *errCode = "";
+ TclDateFields temp;
+ int tempCpyFlg = 0;
+ ClockClientData *dataPtr = opts->clientData;
+
+ #if 0
+ printf("yyMonth %d, yyDay %d, yyDayOfYear %d, yyHour %d, yyMinutes %d, yySeconds %d, "
+ "yySecondOfDay %d, sec %d, daySec %d, tzOffset %d\n",
+ yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds,
+ yySecondOfDay, (int)yydate.localSeconds, (int)(yydate.localSeconds % SECONDS_PER_DAY),
+ yydate.tzOffset);
+ #endif
+
+ if (!(stage & 1)) {
+ goto stage_2;
+ }
+
+ /* first year (used later in hath / daysInPriorMonths) */
+ if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR)) || yyHaveDate) {
+ if ((info->flags & CLF_ISO8601YEAR)) {
+ if ( yydate.iso8601Year < dataPtr->validMinYear
+ || yydate.iso8601Year > dataPtr->validMaxYear ) {
+ errMsg = "invalid iso year"; errCode = "iso year"; goto error;
+ }
+ }
+ if ((info->flags & CLF_YEAR) || yyHaveDate) {
+ if ( yyYear < dataPtr->validMinYear
+ || yyYear > dataPtr->validMaxYear ) {
+ errMsg = "invalid year"; errCode = "year"; goto error;
+ }
+ } else if ((info->flags & CLF_ISO8601YEAR)) {
+ yyYear = yydate.iso8601Year; /* used to recognize leap */
+ }
+ if ((info->flags & (CLF_ISO8601YEAR|CLF_YEAR))
+ == (CLF_ISO8601YEAR|CLF_YEAR)) {
+ if (yyYear != yydate.iso8601Year) {
+ errMsg = "ambiguous year"; errCode = "year"; goto error;
+ }
+ }
+ }
+ /* and month (used later in hath) */
+ if ((info->flags & CLF_MONTH) || yyHaveDate) {
+ info->flags |= CLF_MONTH;
+ if ( yyMonth < 1 || yyMonth > 12 ) {
+ errMsg = "invalid month"; errCode = "month"; goto error;
+ }
+ }
+ /* day of month */
+ if ((info->flags & CLF_DAYOFMONTH) || (yyHaveDate || yyHaveDay)) {
+ info->flags |= CLF_DAYOFMONTH;
+ if ( yyDay < 1 || yyDay > 31 ) {
+ errMsg = "invalid day"; errCode = "day"; goto error;
+ }
+ else
+ if ( (info->flags & CLF_MONTH) ) {
+ const int *h = hath[IsGregorianLeapYear(&yydate)];
+ if ( yyDay > h[yyMonth-1] ) {
+ errMsg = "invalid day"; goto error;
+ }
+ }
+ }
+ if ((info->flags & CLF_DAYOFYEAR)) {
+ if ( yydate.dayOfYear < 1
+ || yydate.dayOfYear > daysInPriorMonths[IsGregorianLeapYear(&yydate)][12] ) {
+ errMsg = "invalid day of year"; errCode = "day of year"; goto error;
+ }
+ }
+
+ /* mmdd !~ ddd */
+ if ((info->flags & (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH))
+ == (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH)) {
+ if (!tempCpyFlg) {
+ memcpy(&temp, &yydate, sizeof(temp));
+ tempCpyFlg = 1;
+ }
+ GetJulianDayFromEraYearDay(&temp, GREGORIAN_CHANGE_DATE);
+ if (temp.julianDay != yydate.julianDay) {
+ errMsg = "ambiguous day"; errCode = "day"; goto error;
+ }
+ }
+
+ if ((info->flags & CLF_TIME) || yyHaveTime) {
+ /* hour */
+ if ( yyHour < 0 || yyHour > ((yyMeridian == MER24) ? 23 : 12) ) {
+ errMsg = "invalid time (hour)"; errCode = "hour"; goto error;
+ }
+ /* minutes */
+ if ( yyMinutes < 0 || yyMinutes > 59 ) {
+ errMsg = "invalid time (minutes)"; errCode = "minutes"; goto error;
+ }
+ /* oldscan could return secondOfDay (parsedTime) -1 by invalid time (ex.: 25:00:00) */
+ if ( yySeconds < 0 || yySeconds > 59 || yySecondOfDay <= -1 ) {
+ errMsg = "invalid time"; errCode = "seconds"; goto error;
+ }
+ }
+
+ if (!(stage & 2)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Further tests expected ready calculated julianDay (inclusive relative),
+ * and time-zone conversion (local to UTC time).
+ */
+ stage_2:
+
+ /* time, regarding the modifications by the time-zone (looks for given time
+ * in between DST-time hole, so does not exist in this time-zone) */
+ if (((info->flags & CLF_TIME) || yyHaveTime)) {
+ /*
+ * we don't need to do the backwards time-conversion (UTC to local) and
+ * compare results, because the after conversion (local to UTC) we
+ * should have valid localSeconds (was not invalidated to TCL_INV_SECONDS),
+ * so if it was invalidated - invalid time, outside the time-zone (in DST-hole)
+ */
+ if ( yydate.localSeconds == TCL_INV_SECONDS ) {
+ errMsg = "invalid time (does not exist in this time-zone)";
+ errCode = "out-of-time"; goto error;
+ }
+ }
+
+ /* day of week */
+ if (info->flags & CLF_DAYOFWEEK) {
+ if (!tempCpyFlg) {
+ memcpy(&temp, &yydate, sizeof(temp));
+ tempCpyFlg = 1;
+ }
+ GetYearWeekDay(&temp, GREGORIAN_CHANGE_DATE);
+ if (temp.dayOfWeek != yyDayOfWeek) {
+ errMsg = "invalid day of week"; errCode = "day of week"; goto error;
+ }
+ }
+
+ return TCL_OK;
+
+ error:
+ Tcl_SetObjResult(opts->interp,
+ Tcl_ObjPrintf("unable to convert input string: %s", errMsg));
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, NULL);
+ return TCL_ERROR;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockFreeScan --
+ *
+ * Used by ClockScanObjCmd for free scanning without format.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockFreeScan(
+ register
+ 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 */
+{
+ Tcl_Interp *interp = opts->interp;
+ ClockClientData *dataPtr = opts->clientData;
+
+ int ret = TCL_ERROR;
+
+ /*
+ * 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. yySecondOfDay -> info->date.secondOfDay or
+ * yyMonth -> info->date.month (same as yydate.month)
+ */
+ yyInput = Tcl_GetString(strObj);
+
+ 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)));
+ 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 (yyHaveDate) {
+ if (yyYear < 100) {
+ if (yyYear >= dataPtr->yearOfCenturySwitch) {
+ yyYear -= 100;
+ }
+ yyYear += dataPtr->currentYearCentury;
+ }
+ yydate.era = CE;
+ if (yyHaveTime == 0) {
+ yyHaveTime = -1;
+ }
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+ }
+
+ /*
+ * 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 (yyHaveZone) {
+ Tcl_Obj *tzObjStor = NULL;
+ int minEast = -yyTimezone;
+ int dstFlag = 1 - yyDSTmode;
+ tzObjStor = ClockFormatNumericTimeZone(
+ 60 * minEast + 3600 * dstFlag);
+ Tcl_IncrRefCount(tzObjStor);
+
+ opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor);
+
+ Tcl_DecrRefCount(tzObjStor);
+ if (opts->timezoneObj == NULL) {
+ goto done;
+ }
+
+ // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj);
+
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+
+ /*
+ * For freescan apply validation rules (stage 1) before mixed with
+ * relative time (otherwise always valid recalculated date & time).
+ */
+ if ( (opts->flags & CLF_VALIDATE) ) {
+ if (ClockValidDate(info, opts, 1) != TCL_OK) {
+ goto done;
+ }
}
/*
- * Return options as a list.
+ * Assemble date, time, zone into seconds-from-epoch
*/
- Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
+ if (yyHaveTime == -1) {
+ yySecondOfDay = 0;
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else
+ if (yyHaveTime) {
+ yySecondOfDay = ToSeconds(yyHour, yyMinutes,
+ yySeconds, yyMeridian);
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else
+ if ( (yyHaveDay && !yyHaveDate)
+ || yyHaveOrdinalMonth
+ || ( yyHaveRel
+ && ( yyRelMonth != 0
+ || yyRelDay != 0 ) )
+ ) {
+ yySecondOfDay = 0;
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else {
+ yySecondOfDay = yydate.localSeconds % SECONDS_PER_DAY;
+ }
+
+ /*
+ * 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 */
+{
+
+ int prevDayOfWeek = yyDayOfWeek; /* preserve unchanged day of week */
+
+ /*
+ * Because some calculations require in-between conversion of the
+ * julian day, we can repeat this processing multiple times
+ */
+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 (info->flags & CLF_ASSEMBLE_DATE) {
+ GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ GetMonthDay(&yydate);
+ GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_DATE;
+ }
+
+ /* add the requisite number of months */
+ 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(&yydate)][m];
+ if (yyDay > h) {
+ yyDay = h;
+ }
+
+ /* on demand (lazy) assemble julianDay using new year, month, etc. */
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+
+ yyRelMonth = 0;
+ }
+
+ /* add days (or other parts aligned to days) */
+ if (yyRelDay) {
+
+ /* assemble julianDay using new year, month, etc. */
+ if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
+ }
+ yydate.julianDay += yyRelDay;
+
+ /* julianDay was changed, on demand (lazy) extract year, month, etc. again */
+ info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
+
+ yyRelDay = 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) {
+ int newSecs = yySecondOfDay + yyRelSeconds;
+
+ /* if seconds increment outside of current date, increment day */
+ if (newSecs / SECONDS_PER_DAY != yySecondOfDay / SECONDS_PER_DAY) {
+
+ yyRelDay += newSecs / SECONDS_PER_DAY;
+ yySecondOfDay = 0;
+ yyRelSeconds = newSecs % SECONDS_PER_DAY;
+
+ goto repeat_rel;
+ }
+ }
+
+ yyHaveRel = 0;
+ }
+
+ /*
+ * Do relative (ordinal) month
+ */
+
+ if (yyHaveOrdinalMonth) {
+ int monthDiff;
+
+ /* if needed extract year, month, etc. again */
+ if (info->flags & CLF_ASSEMBLE_DATE) {
+ GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ GetMonthDay(&yydate);
+ GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_DATE;
+ }
+
+ if (yyMonthOrdinalIncr > 0) {
+ monthDiff = yyMonthOrdinal - yyMonth;
+ if (monthDiff <= 0) {
+ monthDiff += 12;
+ }
+ yyMonthOrdinalIncr--;
+ } else {
+ monthDiff = yyMonth - yyMonthOrdinal;
+ if (monthDiff >= 0) {
+ monthDiff -= 12;
+ }
+ yyMonthOrdinalIncr++;
+ }
+
+ /* process it further via relative times */
+ yyHaveRel++;
+ yyYear += yyMonthOrdinalIncr;
+ yyRelMonth += monthDiff;
+ yyHaveOrdinalMonth = 0;
+
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+
+ goto repeat_rel;
+ }
+
+ /*
+ * Do relative weekday
+ */
+
+ if (yyHaveDay && !yyHaveDate) {
+
+ /* restore scanned day of week */
+ if (info->flags & CLF_DAYOFWEEK) {
+ yyDayOfWeek = prevDayOfWeek;
+ }
+ /* if needed assemble julianDay now */
+ if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
+ }
+
+ yydate.era = CE;
+ yydate.julianDay = WeekdayOnOrBefore(yyDayOfWeek, yydate.julianDay + 6)
+ + 7 * yyDayOrdinal;
+ if (yyDayOrdinal > 0) {
+ yydate.julianDay -= 7;
+ }
+ info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
+ }
+
return TCL_OK;
+}
-#undef timezoneObj
-#undef localeObj
-#undef formatObj
+
+/*----------------------------------------------------------------------
+ *
+ * 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 */
+{
+ static const char *syntax = "clock add clockval|-now ?number units?..."
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE?";
+ 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;
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 0, NULL, syntax);
+ 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, syntax);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* time together as seconds of the day */
+ yySecondOfDay = 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(&yy, &opts);
+
+done:
+
+ Tcl_UnsetObjRef(yy.date.tzName);
+
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds));
+ return TCL_OK;
}
/*----------------------------------------------------------------------
@@ -2001,7 +4516,7 @@ ClockSecondsObjCmd(
Tcl_Time now;
if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds");
return TCL_ERROR;
}
Tcl_GetTime(&now);
@@ -2026,15 +4541,37 @@ ClockSecondsObjCmd(
*----------------------------------------------------------------------
*/
-static void
+static size_t
TzsetIfNecessary(void)
{
- static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
- * clockMutex. */
- const char *tzIsNow; /* Current value of TZ */
+ static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
+ * clockMutex. */
+ static long tzLastRefresh = 0; /* Used for latency before next refresh */
+ static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */
+ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling,
+ that TZ changed via TCL */
+ const char *tzIsNow; /* Current value of TZ */
+
+ /*
+ * 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 == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
+ return tzWasEpoch;
+ }
+ tzEnvEpoch = TclEnvEpoch;
+ tzLastRefresh = now.sec;
+
+ /* 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();
@@ -2043,42 +4580,16 @@ 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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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]);
- }
- ckfree(data->literals);
- ckfree(data);
- }
+ return tzWasEpoch;
}
/*
diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c
new file mode 100644
index 0000000..254936c
--- /dev/null
+++ b/generic/tclClockFmt.c
@@ -0,0 +1,3226 @@
+/*
+ * tclClockFmt.c --
+ *
+ * Contains the date format (and scan) routines. This code is back-ported
+ * from the time and date facilities of tclSE engine, by Serg G. Brester.
+ *
+ * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include "tclStrIdxTree.h"
+#include "tclDate.h"
+
+/*
+ * Miscellaneous forward declarations and functions used within this file
+ */
+
+static void
+ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void
+ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr);
+static int
+ClockFmtObj_SetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void
+ClockFmtObj_UpdateString(Tcl_Obj *objPtr);
+
+
+TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */
+
+static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss);
+
+static void ClockFrmScnFinalize(ClientData clientData);
+
+/*
+ * Clock scan and format facilities.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _str2int -- , _str2wideInt --
+ *
+ * Fast inline-convertion of string to signed int or wide int by given
+ * start/end.
+ *
+ * The given string should contain numbers chars only (because already
+ * pre-validated within parsing routines)
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ * TCL_OK - by successful conversion, TCL_ERROR by (wide) int overflow
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+_str2int(
+ int *out,
+ register
+ const char *p,
+ const char *e,
+ int sign)
+{
+ register int val = 0, prev = 0;
+ if (sign >= 0) {
+ while (p < e) {
+ val = val * 10 + (*p++ - '0');
+ if (val < prev) {
+ return TCL_ERROR;
+ }
+ prev = val;
+ }
+ } else {
+ while (p < e) {
+ val = val * 10 - (*p++ - '0');
+ if (val > prev) {
+ return TCL_ERROR;
+ }
+ prev = val;
+ }
+ }
+ *out = val;
+ return TCL_OK;
+}
+
+static inline int
+_str2wideInt(
+ Tcl_WideInt *out,
+ register
+ const char *p,
+ const char *e,
+ int sign)
+{
+ register Tcl_WideInt val = 0, prev = 0;
+ if (sign >= 0) {
+ while (p < e) {
+ val = val * 10 + (*p++ - '0');
+ if (val < prev) {
+ return TCL_ERROR;
+ }
+ prev = val;
+ }
+ } else {
+ while (p < e) {
+ val = val * 10 - (*p++ - '0');
+ if (val > prev) {
+ return TCL_ERROR;
+ }
+ prev = val;
+ }
+ }
+ *out = val;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _itoaw -- , _witoaw --
+ *
+ * Fast inline-convertion of signed int or wide int to string, using
+ * given padding with specified padchar and width (or without padding).
+ *
+ * This is a very fast replacement for sprintf("%02d").
+ *
+ * Results:
+ * Returns position in buffer after end of conversion result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline char *
+_itoaw(
+ char *buf,
+ register int val,
+ char padchar,
+ unsigned short int width)
+{
+ register char *p;
+ static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000};
+
+ /* positive integer */
+
+ if (val >= 0)
+ {
+ /* check resp. recalculate width */
+ while (width <= 9 && val >= wrange[width]) {
+ width++;
+ }
+ /* number to string backwards */
+ p = buf + width;
+ *p-- = '\0';
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' + c;
+ } while (val > 0);
+ /* fulling with pad-char */
+ while (p >= buf) {
+ *p-- = padchar;
+ }
+
+ return buf + width;
+ }
+ /* negative integer */
+
+ if (!width) width++;
+ /* check resp. recalculate width (regarding sign) */
+ width--;
+ while (width <= 9 && val <= -wrange[width]) {
+ width++;
+ }
+ width++;
+ /* number to string backwards */
+ p = buf + width;
+ *p-- = '\0';
+ /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */
+ if (-1 % 10 == -1) {
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' - c;
+ } while (val < 0);
+ } else {
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' + c;
+ } while (val < 0);
+ }
+ /* sign by 0 padding */
+ if (padchar != '0') { *p-- = '-'; }
+ /* fulling with pad-char */
+ while (p >= buf + 1) {
+ *p-- = padchar;
+ }
+ /* sign by non 0 padding */
+ if (padchar == '0') { *p = '-'; }
+
+ return buf + width;
+}
+
+static inline char *
+_witoaw(
+ char *buf,
+ register Tcl_WideInt val,
+ char padchar,
+ unsigned short int width)
+{
+ register char *p;
+ static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000};
+
+ /* positive integer */
+
+ if (val >= 0)
+ {
+ /* check resp. recalculate width */
+ if (val >= 10000000000L) {
+ Tcl_WideInt val2;
+ val2 = val / 10000000000L;
+ while (width <= 9 && val2 >= wrange[width]) {
+ width++;
+ }
+ width += 10;
+ } else {
+ while (width <= 9 && val >= wrange[width]) {
+ width++;
+ }
+ }
+ /* number to string backwards */
+ p = buf + width;
+ *p-- = '\0';
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' + c;
+ } while (val > 0);
+ /* fulling with pad-char */
+ while (p >= buf) {
+ *p-- = padchar;
+ }
+
+ return buf + width;
+ }
+
+ /* negative integer */
+
+ if (!width) width++;
+ /* check resp. recalculate width (regarding sign) */
+ width--;
+ if (val <= 10000000000L) {
+ Tcl_WideInt val2;
+ val2 = val / 10000000000L;
+ while (width <= 9 && val2 <= -wrange[width]) {
+ width++;
+ }
+ width += 10;
+ } else {
+ while (width <= 9 && val <= -wrange[width]) {
+ width++;
+ }
+ }
+ width++;
+ /* number to string backwards */
+ p = buf + width;
+ *p-- = '\0';
+ /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */
+ if (-1 % 10 == -1) {
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' - c;
+ } while (val < 0);
+ } else {
+ do {
+ register char c = (val % 10); val /= 10;
+ *p-- = '0' + c;
+ } while (val < 0);
+ }
+ /* sign by 0 padding */
+ if (padchar != '0') { *p-- = '-'; }
+ /* fulling with pad-char */
+ while (p >= buf + 1) {
+ *p-- = padchar;
+ }
+ /* sign by non 0 padding */
+ if (padchar == '0') { *p = '-'; }
+
+ return buf + width;
+}
+
+/*
+ * Global GC as LIFO for released scan/format object storages.
+ *
+ * Used to holds last released CLOCK_FMT_SCN_STORAGE_GC_SIZE formats
+ * (after last reference from Tcl-object will be removed). This is helpful
+ * to avoid continuous (re)creation and compiling by some dynamically resp.
+ * variable format objects, that could be often reused.
+ *
+ * As long as format storage is used resp. belongs to GC, it takes place in
+ * FmtScnHashTable also.
+ */
+
+#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
+
+static struct {
+ ClockFmtScnStorage *stackPtr;
+ ClockFmtScnStorage *stackBound;
+ unsigned int count;
+} ClockFmtScnStorage_GC = {NULL, NULL, 0};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFmtScnStorageGC_In --
+ *
+ * Adds an format storage object to GC.
+ *
+ * If current GC is full (size larger as CLOCK_FMT_SCN_STORAGE_GC_SIZE)
+ * this removes last unused storage at begin of GC stack (LIFO).
+ *
+ * Assumes caller holds the ClockFmtMutex.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+ClockFmtScnStorageGC_In(ClockFmtScnStorage *entry)
+{
+ /* add new entry */
+ TclSpliceIn(entry, ClockFmtScnStorage_GC.stackPtr);
+ if (ClockFmtScnStorage_GC.stackBound == NULL) {
+ ClockFmtScnStorage_GC.stackBound = entry;
+ }
+ ClockFmtScnStorage_GC.count++;
+
+ /* if GC ist full */
+ if (ClockFmtScnStorage_GC.count > CLOCK_FMT_SCN_STORAGE_GC_SIZE) {
+
+ /* GC stack is LIFO: delete first inserted entry */
+ ClockFmtScnStorage *delEnt = ClockFmtScnStorage_GC.stackBound;
+ ClockFmtScnStorage_GC.stackBound = delEnt->prevPtr;
+ TclSpliceOut(delEnt, ClockFmtScnStorage_GC.stackPtr);
+ ClockFmtScnStorage_GC.count--;
+ delEnt->prevPtr = delEnt->nextPtr = NULL;
+ /* remove it now */
+ ClockFmtScnStorageDelete(delEnt);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFmtScnStorage_GC_Out --
+ *
+ * Restores (for reusing) given format storage object from GC.
+ *
+ * Assumes caller holds the ClockFmtMutex.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline void
+ClockFmtScnStorage_GC_Out(ClockFmtScnStorage *entry)
+{
+ TclSpliceOut(entry, ClockFmtScnStorage_GC.stackPtr);
+ ClockFmtScnStorage_GC.count--;
+ if (ClockFmtScnStorage_GC.stackBound == entry) {
+ ClockFmtScnStorage_GC.stackBound = entry->prevPtr;
+ }
+ entry->prevPtr = entry->nextPtr = NULL;
+}
+
+#endif
+
+
+/*
+ * Global format storage hash table of type ClockFmtScnStorageHashKeyType
+ * (contains list of scan/format object storages, shared across all threads).
+ *
+ * Used for fast searching by format string.
+ */
+static Tcl_HashTable FmtScnHashTable;
+static int initialized = 0;
+
+/*
+ * Wrappers between pointers to hash entry and format storage object
+ */
+static inline Tcl_HashEntry *
+HashEntry4FmtScn(ClockFmtScnStorage *fss) {
+ return (Tcl_HashEntry*)(fss + 1);
+};
+static inline ClockFmtScnStorage *
+FmtScn4HashEntry(Tcl_HashEntry *hKeyPtr) {
+ return (ClockFmtScnStorage*)(((char*)hKeyPtr) - sizeof(ClockFmtScnStorage));
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFmtScnStorageAllocProc --
+ *
+ * Allocate space for a hash entry containing format storage together
+ * with the string key.
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+ClockFmtScnStorageAllocProc(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key to store in the hash table entry. */
+{
+ ClockFmtScnStorage *fss;
+
+ const char *string = (const char *) keyPtr;
+ Tcl_HashEntry *hPtr;
+ unsigned int size,
+ allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry);
+
+ allocsize += (size = strlen(string) + 1);
+ if (size > sizeof(hPtr->key)) {
+ allocsize -= sizeof(hPtr->key);
+ }
+
+ fss = ckalloc(allocsize);
+
+ /* initialize */
+ memset(fss, 0, sizeof(*fss));
+
+ hPtr = HashEntry4FmtScn(fss);
+ memcpy(&hPtr->key.string, string, size);
+ hPtr->clientData = 0; /* currently unused */
+
+ return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFmtScnStorageFreeProc --
+ *
+ * Free format storage object and space of given hash entry.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockFmtScnStorageFreeProc(
+ Tcl_HashEntry *hPtr)
+{
+ ClockFmtScnStorage *fss = FmtScn4HashEntry(hPtr);
+
+ if (fss->scnTok != NULL) {
+ ckfree(fss->scnTok);
+ fss->scnTok = NULL;
+ fss->scnTokC = 0;
+ }
+ if (fss->fmtTok != NULL) {
+ ckfree(fss->fmtTok);
+ fss->fmtTok = NULL;
+ fss->fmtTokC = 0;
+ }
+
+ ckfree(fss);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFmtScnStorageDelete --
+ *
+ * Delete format storage object.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockFmtScnStorageDelete(ClockFmtScnStorage *fss) {
+ Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss);
+ /*
+ * This will delete a hash entry and call "ckfree" for storage self, if
+ * some additionally handling required, freeEntryProc can be used instead
+ */
+ Tcl_DeleteHashEntry(hPtr);
+}
+
+
+/*
+ * Derivation of tclStringHashKeyType with another allocEntryProc
+ */
+
+static Tcl_HashKeyType ClockFmtScnStorageHashKeyType;
+
+
+/*
+ * Type definition of clock-format tcl object type.
+ */
+
+Tcl_ObjType ClockFmtObjType = {
+ "clock-format", /* name */
+ ClockFmtObj_FreeInternalRep, /* freeIntRepProc */
+ ClockFmtObj_DupInternalRep, /* dupIntRepProc */
+ ClockFmtObj_UpdateString, /* updateStringProc */
+ ClockFmtObj_SetFromAny /* setFromAnyProc */
+};
+
+#define ObjClockFmtScn(objPtr) \
+ (*((ClockFmtScnStorage **)&(objPtr)->internalRep.twoPtrValue.ptr1))
+
+#define ObjLocFmtKey(objPtr) \
+ (*((Tcl_Obj **)&(objPtr)->internalRep.twoPtrValue.ptr2))
+
+static void
+ClockFmtObj_DupInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *copyPtr;
+{
+ ClockFmtScnStorage *fss = ObjClockFmtScn(srcPtr);
+
+ if (fss != NULL) {
+ Tcl_MutexLock(&ClockFmtMutex);
+ fss->objRefCount++;
+ Tcl_MutexUnlock(&ClockFmtMutex);
+ }
+
+ ObjClockFmtScn(copyPtr) = fss;
+ /* regards special case - format not localizable */
+ if (ObjLocFmtKey(srcPtr) != srcPtr) {
+ Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr));
+ } else {
+ ObjLocFmtKey(copyPtr) = copyPtr;
+ }
+ copyPtr->typePtr = &ClockFmtObjType;
+
+
+ /* if no format representation, dup string representation */
+ if (fss == NULL) {
+ copyPtr->bytes = ckalloc(srcPtr->length + 1);
+ memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1);
+ copyPtr->length = srcPtr->length;
+ }
+}
+
+static void
+ClockFmtObj_FreeInternalRep(objPtr)
+ Tcl_Obj *objPtr;
+{
+ ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr);
+ if (fss != NULL) {
+ Tcl_MutexLock(&ClockFmtMutex);
+ /* decrement object reference count of format/scan storage */
+ if (--fss->objRefCount <= 0) {
+ #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
+ /* don't remove it right now (may be reusable), just add to GC */
+ ClockFmtScnStorageGC_In(fss);
+ #else
+ /* remove storage (format representation) */
+ ClockFmtScnStorageDelete(fss);
+ #endif
+ }
+ Tcl_MutexUnlock(&ClockFmtMutex);
+ }
+ ObjClockFmtScn(objPtr) = NULL;
+ if (ObjLocFmtKey(objPtr) != objPtr) {
+ Tcl_UnsetObjRef(ObjLocFmtKey(objPtr));
+ } else {
+ ObjLocFmtKey(objPtr) = NULL;
+ }
+ objPtr->typePtr = NULL;
+};
+
+static int
+ClockFmtObj_SetFromAny(interp, objPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+{
+ /* validate string representation before free old internal represenation */
+ (void)TclGetString(objPtr);
+
+ /* free old internal represenation */
+ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc)
+ objPtr->typePtr->freeIntRepProc(objPtr);
+
+ /* initial state of format object */
+ ObjClockFmtScn(objPtr) = NULL;
+ ObjLocFmtKey(objPtr) = NULL;
+ objPtr->typePtr = &ClockFmtObjType;
+
+ return TCL_OK;
+};
+
+static void
+ClockFmtObj_UpdateString(objPtr)
+ Tcl_Obj *objPtr;
+{
+ const char *name = "UNKNOWN";
+ int len;
+ ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr);
+
+ if (fss != NULL) {
+ Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss);
+ name = hPtr->key.string;
+ }
+ len = strlen(name);
+ objPtr->length = len,
+ objPtr->bytes = ckalloc((size_t)++len);
+ if (objPtr->bytes)
+ memcpy(objPtr->bytes, name, len);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFrmObjGetLocFmtKey --
+ *
+ * Retrieves format key object used to search localized format.
+ *
+ * This is normally stored in second pointer of internal representation.
+ * If format object is not localizable, it is equal the given format
+ * pointer (special case to fast fallback by not-localizable formats).
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+ClockFrmObjGetLocFmtKey(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
+{
+ Tcl_Obj *keyObj;
+
+ if (objPtr->typePtr != &ClockFmtObjType) {
+ if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) {
+ return NULL;
+ }
+ }
+
+ keyObj = ObjLocFmtKey(objPtr);
+ if (keyObj) {
+ return keyObj;
+ }
+
+ keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr));
+ Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj);
+
+ return keyObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindOrCreateFmtScnStorage --
+ *
+ * Retrieves format storage for given string format.
+ *
+ * This will find the given format in the global storage hash table
+ * or create a format storage object on demaind and save the
+ * reference in the first pointer of internal representation of given
+ * object.
+ *
+ * Results:
+ * Returns scan/format storage pointer to ClockFmtScnStorage.
+ *
+ * Side effects:
+ * Converts given format object to ClockFmtObjType on demand for caching
+ * the format storage reference inside its internal representation.
+ * Increments objRefCount of the ClockFmtScnStorage reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClockFmtScnStorage *
+FindOrCreateFmtScnStorage(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
+{
+ const char *strFmt = TclGetString(objPtr);
+ ClockFmtScnStorage *fss = NULL;
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ Tcl_MutexLock(&ClockFmtMutex);
+
+ /* if not yet initialized */
+ if (!initialized) {
+ /* initialize type */
+ memcpy(&ClockFmtScnStorageHashKeyType, &tclStringHashKeyType, sizeof(tclStringHashKeyType));
+ ClockFmtScnStorageHashKeyType.allocEntryProc = ClockFmtScnStorageAllocProc;
+ ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc;
+
+ /* initialize hash table */
+ Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS,
+ &ClockFmtScnStorageHashKeyType);
+
+ initialized = 1;
+ Tcl_CreateExitHandler(ClockFrmScnFinalize, NULL);
+ }
+
+ /* get or create entry (and alocate storage) */
+ hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new);
+ if (hPtr != NULL) {
+
+ fss = FmtScn4HashEntry(hPtr);
+
+ #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
+ /* unlink if it is currently in GC */
+ if (new == 0 && fss->objRefCount == 0) {
+ ClockFmtScnStorage_GC_Out(fss);
+ }
+ #endif
+
+ /* new reference, so increment in lock right now */
+ fss->objRefCount++;
+
+ ObjClockFmtScn(objPtr) = fss;
+ }
+
+ Tcl_MutexUnlock(&ClockFmtMutex);
+
+ if (fss == NULL && interp != NULL) {
+ Tcl_AppendResult(interp, "retrieve clock format failed \"",
+ strFmt ? strFmt : "", "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL);
+ }
+
+ return fss;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetClockFrmScnFromObj --
+ *
+ * Returns a clock format/scan representation of (*objPtr), if possible.
+ * If something goes wrong, NULL is returned, and if interp is non-NULL,
+ * an error message is written there.
+ *
+ * Results:
+ * Valid representation of type ClockFmtScnStorage.
+ *
+ * Side effects:
+ * Caches the ClockFmtScnStorage reference as the internal rep of (*objPtr)
+ * and in global hash table, shared across all threads.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClockFmtScnStorage *
+Tcl_GetClockFrmScnFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
+{
+ ClockFmtScnStorage *fss;
+
+ if (objPtr->typePtr != &ClockFmtObjType) {
+ if (ClockFmtObj_SetFromAny(interp, objPtr) != TCL_OK) {
+ return NULL;
+ }
+ }
+
+ fss = ObjClockFmtScn(objPtr);
+
+ if (fss == NULL) {
+ fss = FindOrCreateFmtScnStorage(interp, objPtr);
+ }
+
+ return fss;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockLocalizeFormat --
+ *
+ * Wrap the format object in options to the localized format,
+ * corresponding given locale.
+ *
+ * This searches localized format in locale catalog, and if not yet
+ * exists, it executes ::tcl::clock::LocalizeFormat in given interpreter
+ * and caches its result in the locale catalog.
+ *
+ * Results:
+ * Localized format object.
+ *
+ * Side effects:
+ * Caches the localized format inside locale catalog.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+
+ /* prevents loss of key object if the format object (where key stored)
+ * becomes changed (loses its internal representation during evals) */
+ Tcl_IncrRefCount(keyObj);
+
+ if (opts->mcDictObj == NULL) {
+ ClockMCDict(opts);
+ if (opts->mcDictObj == NULL)
+ goto done;
+ }
+
+ /* try to find in cache within locale mc-catalog */
+ if (Tcl_DictObjGet(NULL, opts->mcDictObj,
+ keyObj, &valObj) != TCL_OK) {
+ goto done;
+ }
+
+ /* 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;
+ if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK
+ ) {
+ goto done;
+ }
+
+ 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 done;
+ }
+
+ Tcl_ResetResult(opts->interp);
+
+ /* check special case - format object is not localizable */
+ if (valObj == opts->formatObj) {
+ /* mark it as unlocalizable, by setting self as key (without refcount incr) */
+ if (valObj->typePtr == &ClockFmtObjType) {
+ Tcl_UnsetObjRef(ObjLocFmtKey(valObj));
+ ObjLocFmtKey(valObj) = valObj;
+ }
+ }
+ }
+
+done:
+
+ Tcl_UnsetObjRef(keyObj);
+ return (opts->formatObj = valObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTokenBegin --
+ *
+ * Find begin of given scan token in string, corresponding token type.
+ *
+ * Results:
+ * Position of token inside string if found. Otherwise - end of string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+FindTokenBegin(
+ register const char *p,
+ register const char *end,
+ ClockScanToken *tok)
+{
+ char c;
+ if (p < end) {
+ /* next token a known token type */
+ switch (tok->map->type) {
+ case CTOKT_INT:
+ case CTOKT_WIDE:
+ /* should match at least one digit */
+ while (!isdigit(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {};
+ return p;
+ break;
+ case CTOKT_WORD:
+ c = *(tok->tokWord.start);
+ /* should match at least to the first char of this word */
+ while (*p != c && (p = TclUtfNext(p)) < end) {};
+ return p;
+ break;
+ case CTOKT_SPACE:
+ while (!isspace(UCHAR(*p)) && (p = TclUtfNext(p)) < end) {};
+ return p;
+ break;
+ case CTOKT_CHAR:
+ c = *((char *)tok->map->data);
+ while (*p != c && (p = TclUtfNext(p)) < end) {};
+ return p;
+ break;
+ }
+ }
+ return p;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DetermineGreedySearchLen --
+ *
+ * Determine min/max lengths as exact as possible (speed, greedy match).
+ *
+ * Results:
+ * None. Lengths are stored in *minLenPtr, *maxLenPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok,
+ int *minLenPtr, int *maxLenPtr)
+{
+ register int minLen = tok->map->minSize;
+ register int maxLen;
+ register const char *p = yyInput + minLen,
+ *end = info->dateEnd;
+
+ /* if still tokens available, try to correct minimum length */
+ if ((tok+1)->map) {
+ end -= tok->endDistance + yySpaceCount;
+ /* find position of next known token */
+ p = FindTokenBegin(p, end, tok+1);
+ if (p < end) {
+ minLen = p - yyInput;
+ }
+ }
+
+ /* max length to the end regarding distance to end (min-width of following tokens) */
+ maxLen = end - yyInput;
+ /* several amendments */
+ if (maxLen > tok->map->maxSize) {
+ maxLen = tok->map->maxSize;
+ };
+ if (minLen < tok->map->minSize) {
+ minLen = tok->map->minSize;
+ }
+ if (minLen > maxLen) {
+ maxLen = minLen;
+ }
+ if (maxLen > info->dateEnd - yyInput) {
+ maxLen = info->dateEnd - yyInput;
+ }
+
+ /* check digits rigth now */
+ if (tok->map->type == CTOKT_INT || tok->map->type == CTOKT_WIDE) {
+ p = yyInput;
+ end = p + maxLen;
+ if (end > info->dateEnd) { end = info->dateEnd; };
+ while (isdigit(UCHAR(*p)) && p < end) { p++; };
+ maxLen = p - yyInput;
+ }
+
+ /* try to get max length more precise for greedy match,
+ * check the next ahead token available there */
+ if (minLen < maxLen && tok->lookAhTok) {
+ ClockScanToken *laTok = tok + tok->lookAhTok + 1;
+ p = yyInput + maxLen;
+ /* regards all possible spaces here (because they are optional) */
+ end = p + tok->lookAhMax + yySpaceCount + 1;
+ if (end > info->dateEnd) {
+ end = info->dateEnd;
+ }
+ p += tok->lookAhMin;
+ if (laTok->map && p < end) {
+ const char *f;
+ /* try to find laTok between [lookAhMin, lookAhMax] */
+ while (minLen < maxLen) {
+ f = FindTokenBegin(p, end, laTok);
+ /* if found (not below lookAhMax) */
+ if (f < end) {
+ break;
+ }
+ /* try again with fewer length */
+ maxLen--;
+ p--;
+ end--;
+ }
+ } else if (p > end) {
+ maxLen -= (p - end);
+ if (maxLen < minLen) {
+ maxLen = minLen;
+ }
+ }
+ }
+
+ *minLenPtr = minLen;
+ *maxLenPtr = maxLen;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ObjListSearch --
+ *
+ * Find largest part of the input string from start regarding min and
+ * max lengths in the given list (utf-8, case sensitive).
+ *
+ * Results:
+ * TCL_OK - match found, TCL_RETURN - not matched, TCL_ERROR in error case.
+ *
+ * Side effects:
+ * Input points to end of the found token in string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ObjListSearch(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, int *val,
+ Tcl_Obj **lstv, int lstc,
+ int minLen, int maxLen)
+{
+ int i, l, lf = -1;
+ const char *s, *f, *sf;
+ /* search in list */
+ for (i = 0; i < lstc; i++) {
+ s = TclGetString(lstv[i]);
+ l = lstv[i]->length;
+
+ if ( l >= minLen
+ && (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput
+ ) {
+ l = f - yyInput;
+ if (l < minLen) {
+ continue;
+ }
+ /* found, try to find longest value (greedy search) */
+ if (l < maxLen && minLen != maxLen) {
+ lf = i;
+ minLen = l + 1;
+ continue;
+ }
+ /* max possible - end of search */
+ *val = i;
+ yyInput += l;
+ break;
+ }
+ }
+
+ /* if found */
+ if (i < lstc) {
+ return TCL_OK;
+ }
+ if (lf >= 0) {
+ *val = lf;
+ yyInput += minLen - 1;
+ return TCL_OK;
+ }
+ return TCL_RETURN;
+}
+#if 0
+/* currently unused */
+
+static int
+LocaleListSearch(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, int mcKey, int *val,
+ int minLen, int maxLen)
+{
+ Tcl_Obj **lstv;
+ int lstc;
+ Tcl_Obj *valObj;
+
+ /* get msgcat value */
+ valObj = ClockMCGet(opts, mcKey);
+ if (valObj == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* is a list */
+ if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* search in list */
+ return ObjListSearch(opts, info, val, lstv, lstc,
+ minLen, maxLen);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCGetListIdxTree --
+ *
+ * Retrieves localized string indexed tree in the locale catalog for
+ * given literal index mcKey (and builds it on demand).
+ *
+ * Searches localized index in locale catalog, and if not yet exists,
+ * creates string indexed tree and stores it in the locale catalog.
+ *
+ * Results:
+ * Localized string index tree.
+ *
+ * Side effects:
+ * Caches the localized string index tree inside locale catalog.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclStrIdxTree *
+ClockMCGetListIdxTree(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey)
+{
+ TclStrIdxTree * idxTree;
+ Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey);
+ if ( objPtr != NULL
+ && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL
+ ) {
+ return idxTree;
+
+ } else {
+ /* build new index */
+
+ Tcl_Obj **lstv;
+ int lstc;
+ Tcl_Obj *valObj;
+
+ objPtr = TclStrIdxTreeNewObj();
+ if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
+ goto done; /* unexpected, but ...*/
+ }
+
+ valObj = ClockMCGet(opts, mcKey);
+ if (valObj == NULL) {
+ goto done;
+ }
+
+ if (TclListObjGetElements(opts->interp, valObj,
+ &lstc, &lstv) != TCL_OK) {
+ goto done;
+ };
+
+ if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
+ goto done;
+ }
+
+ ClockMCSetIdx(opts, mcKey, objPtr);
+ objPtr = NULL;
+ };
+
+done:
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ idxTree = NULL;
+ }
+
+ return idxTree;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCGetMultiListIdxTree --
+ *
+ * Retrieves localized string indexed tree in the locale catalog for
+ * multiple lists by literal indices mcKeys (and builds it on demand).
+ *
+ * Searches localized index in locale catalog for mcKey, and if not
+ * yet exists, creates string indexed tree and stores it in the
+ * locale catalog.
+ *
+ * Results:
+ * Localized string index tree.
+ *
+ * Side effects:
+ * Caches the localized string index tree inside locale catalog.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclStrIdxTree *
+ClockMCGetMultiListIdxTree(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey,
+ int *mcKeys)
+{
+ TclStrIdxTree * idxTree;
+ Tcl_Obj *objPtr = ClockMCGetIdx(opts, mcKey);
+ if ( objPtr != NULL
+ && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL
+ ) {
+ return idxTree;
+
+ } else {
+ /* build new index */
+
+ Tcl_Obj **lstv;
+ int lstc;
+ Tcl_Obj *valObj;
+
+ objPtr = TclStrIdxTreeNewObj();
+ if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
+ goto done; /* unexpected, but ...*/
+ }
+
+ while (*mcKeys) {
+
+ valObj = ClockMCGet(opts, *mcKeys);
+ if (valObj == NULL) {
+ goto done;
+ }
+
+ if (TclListObjGetElements(opts->interp, valObj,
+ &lstc, &lstv) != TCL_OK) {
+ goto done;
+ };
+
+ if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
+ goto done;
+ }
+ mcKeys++;
+ }
+
+ ClockMCSetIdx(opts, mcKey, objPtr);
+ objPtr = NULL;
+ };
+
+done:
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ idxTree = NULL;
+ }
+
+ return idxTree;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockStrIdxTreeSearch --
+ *
+ * Find largest part of the input string from start regarding lengths
+ * in the given localized string indexed tree (utf-8, case sensitive).
+ *
+ * Results:
+ * TCL_OK - match found and the index stored in *val,
+ * TCL_RETURN - not matched or ambigous,
+ * TCL_ERROR - in error case.
+ *
+ * Side effects:
+ * Input points to end of the found token in string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, TclStrIdxTree *idxTree, int *val,
+ int minLen, int maxLen)
+{
+ const char *f;
+ TclStrIdx *foundItem;
+ f = TclStrIdxTreeSearch(NULL, &foundItem, idxTree,
+ yyInput, yyInput + maxLen);
+
+ if (f <= yyInput || (f - yyInput) < minLen) {
+ /* not found */
+ return TCL_RETURN;
+ }
+ if (!foundItem->value) {
+ /* ambigous */
+ return TCL_RETURN;
+ }
+
+ *val = PTR2INT(foundItem->value);
+
+ /* shift input pointer */
+ yyInput = f;
+
+ return TCL_OK;
+}
+#if 0
+/* currently unused */
+
+static int
+StaticListSearch(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, const char **lst, int *val)
+{
+ int len;
+ const char **s = lst;
+ while (*s != NULL) {
+ len = strlen(*s);
+ if ( len <= info->dateEnd - yyInput
+ && strncasecmp(yyInput, *s, len) == 0
+ ) {
+ *val = (s - lst);
+ yyInput += len;
+ break;
+ }
+ s++;
+ }
+ if (*s != NULL) {
+ return TCL_OK;
+ }
+ return TCL_RETURN;
+}
+#endif
+
+static inline const char *
+FindWordEnd(
+ ClockScanToken *tok,
+ register const char * p, const char * end)
+{
+ register const char *x = tok->tokWord.start;
+ const char *pfnd = p;
+ if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */
+ if (*p == *x) {
+ return ++p;
+ }
+ }
+ /* multi-char word */
+ x = TclUtfFindEqualNC(x, tok->tokWord.end, p, end, &pfnd);
+ if (x < tok->tokWord.end) {
+ /* no match -> error */
+ return NULL;
+ }
+ return pfnd;
+}
+
+static int
+ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+#if 0
+/* currently unused, test purposes only */
+ static const char * months[] = {
+ /* full */
+ "January", "February", "March",
+ "April", "May", "June",
+ "July", "August", "September",
+ "October", "November", "December",
+ /* abbr */
+ "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
+ NULL
+ };
+ int val;
+ if (StaticListSearch(opts, info, months, &val) != TCL_OK) {
+ return TCL_RETURN;
+ }
+ yyMonth = (val % 12) + 1;
+ return TCL_OK;
+#endif
+
+ static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0};
+
+ int ret, val;
+ int minLen, maxLen;
+ TclStrIdxTree *idxTree;
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ /* get or create tree in msgcat dict */
+
+ idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys);
+ if (idxTree == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ yyMonth = val;
+ return TCL_OK;
+
+}
+
+static int
+ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0};
+
+ int ret, val;
+ int minLen, maxLen;
+ char curTok = *tok->tokWord.start;
+ TclStrIdxTree *idxTree;
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ /* %u %w %Ou %Ow */
+ if ( curTok != 'a' && curTok != 'A'
+ && ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data))
+ ) {
+
+ val = -1;
+
+ if (PTR2INT(tok->map->data) == 0) {
+ if (*yyInput >= '0' && *yyInput <= '9') {
+ val = *yyInput - '0';
+ }
+ } else {
+ idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */);
+ if (idxTree == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+ --val;
+ }
+
+ if (val != -1) {
+ if (val == 0) {
+ val = 7;
+ }
+ if (val > 7) {
+ Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("day of week is greater than 7", -1));
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL);
+ return TCL_ERROR;
+ }
+ info->date.dayOfWeek = val;
+ yyInput++;
+ return TCL_OK;
+ }
+
+
+ return TCL_RETURN;
+ }
+
+ /* %a %A */
+ idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_DAYS_OF_WEEK_COMB, dowKeys);
+ if (idxTree == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+ --val;
+
+ if (val == 0) {
+ val = 7;
+ }
+ info->date.dayOfWeek = val;
+ return TCL_OK;
+
+}
+
+static int
+ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ int ret, val;
+ int minLen, maxLen;
+ Tcl_Obj *amPmObj[2];
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ amPmObj[0] = ClockMCGet(opts, MCLIT_AM);
+ amPmObj[1] = ClockMCGet(opts, MCLIT_PM);
+
+ if (amPmObj[0] == NULL || amPmObj[1] == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ObjListSearch(opts, info, &val, amPmObj, 2,
+ minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ if (val == 0) {
+ yyMeridian = MERam;
+ } else {
+ yyMeridian = MERpm;
+ }
+
+ return TCL_OK;
+}
+
+static int
+ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ int ret, val;
+ int minLen, maxLen;
+ Tcl_Obj *eraObj[6];
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ eraObj[0] = ClockMCGet(opts, MCLIT_BCE);
+ eraObj[1] = ClockMCGet(opts, MCLIT_CE);
+ eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2];
+ eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2];
+ eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3];
+ eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3];
+
+ if (eraObj[0] == NULL || eraObj[1] == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ObjListSearch(opts, info, &val, eraObj, 6,
+ minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ if (val & 1) {
+ yydate.era = CE;
+ } else {
+ yydate.era = BCE;
+ }
+
+ return TCL_OK;
+}
+
+static int
+ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ int ret, val;
+ int minLen, maxLen;
+ TclStrIdxTree *idxTree;
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ /* get or create tree in msgcat dict */
+
+ idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */);
+ if (idxTree == NULL) {
+ return TCL_ERROR;
+ }
+
+ ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen);
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ if (tok->map->offs > 0) {
+ *(int *)(((char *)info) + tok->map->offs) = --val;
+ }
+
+ return TCL_OK;
+}
+
+static int
+ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ int minLen, maxLen;
+ int len = 0;
+ register const char *p = yyInput;
+ Tcl_Obj *tzObjStor = NULL;
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ /* numeric timezone */
+ if (*p == '+' || *p == '-') {
+ /* max chars in numeric zone = "+00:00:00" */
+ #define MAX_ZONE_LEN 9
+ char buf[MAX_ZONE_LEN + 1];
+ char *bp = buf;
+ *bp++ = *p++; len++;
+ if (maxLen > MAX_ZONE_LEN)
+ maxLen = MAX_ZONE_LEN;
+ /* cumulate zone into buf without ':' */
+ while (len + 1 < maxLen) {
+ if (!isdigit(UCHAR(*p))) break;
+ *bp++ = *p++; len++;
+ if (!isdigit(UCHAR(*p))) break;
+ *bp++ = *p++; len++;
+ if (len + 2 < maxLen) {
+ if (*p == ':') {
+ p++; len++;
+ }
+ }
+ }
+ *bp = '\0';
+
+ if (len < minLen) {
+ return TCL_RETURN;
+ }
+ #undef MAX_ZONE_LEN
+
+ /* timezone */
+ tzObjStor = Tcl_NewStringObj(buf, bp-buf);
+ } else {
+ /* legacy (alnum) timezone like CEST, etc. */
+ if (maxLen > 4)
+ maxLen = 4;
+ while (len < maxLen) {
+ if ( (*p & 0x80)
+ || (!isalpha(UCHAR(*p)) && !isdigit(UCHAR(*p)))
+ ) { /* INTL: ISO only. */
+ break;
+ }
+ p++; len++;
+ }
+
+ if (len < minLen) {
+ return TCL_RETURN;
+ }
+
+ /* timezone */
+ tzObjStor = Tcl_NewStringObj(yyInput, p-yyInput);
+
+ /* convert using dict */
+ }
+
+ /* try to apply new time zone */
+ Tcl_IncrRefCount(tzObjStor);
+
+ opts->timezoneObj = ClockSetupTimeZone(opts->clientData, opts->interp,
+ tzObjStor);
+
+ Tcl_DecrRefCount(tzObjStor);
+ if (opts->timezoneObj == NULL) {
+ return TCL_ERROR;
+ }
+
+ yyInput += len;
+
+ return TCL_OK;
+}
+
+static int
+ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts,
+ DateInfo *info, ClockScanToken *tok)
+{
+ int minLen, maxLen;
+ register const char *p = yyInput, *end; const char *s;
+ int year, fractYear, fractDayDiv, fractDay;
+ static const char *stardatePref = "stardate ";
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);
+
+ end = yyInput + maxLen;
+
+ /* stardate string */
+ p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s);
+ if (p >= end || p - yyInput < 9) {
+ return TCL_RETURN;
+ }
+ /* bypass spaces */
+ while (p < end && isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (p >= end) {
+ return TCL_RETURN;
+ }
+ /* currently positive stardate only */
+ if (*p == '+') { p++; };
+ s = p;
+ while (p < end && isdigit(UCHAR(*p))) {
+ p++;
+ }
+ if (p >= end || p - s < 4) {
+ return TCL_RETURN;
+ }
+ if ( _str2int(&year, s, p-3, 1) != TCL_OK
+ || _str2int(&fractYear, p-3, p, 1) != TCL_OK) {
+ return TCL_RETURN;
+ };
+ if (*p++ != '.') {
+ return TCL_RETURN;
+ }
+ s = p;
+ fractDayDiv = 1;
+ while (p < end && isdigit(UCHAR(*p))) {
+ fractDayDiv *= 10;
+ p++;
+ }
+ if ( _str2int(&fractDay, s, p, 1) != TCL_OK) {
+ return TCL_RETURN;
+ };
+ yyInput = p;
+
+ /* Build a date from year and fraction. */
+
+ yydate.year = year + RODDENBERRY;
+ yydate.era = CE;
+ yydate.gregorian = 1;
+
+ if (IsGregorianLeapYear(&yydate)) {
+ fractYear *= 366;
+ } else {
+ fractYear *= 365;
+ }
+ yydate.dayOfYear = fractYear / 1000 + 1;
+ if (fractYear % 1000 >= 500) {
+ yydate.dayOfYear++;
+ }
+
+ GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+
+ yydate.localSeconds =
+ -210866803200L
+ + ( SECONDS_PER_DAY * yydate.julianDay )
+ + ( SECONDS_PER_DAY * fractDay / fractDayDiv );
+
+ return TCL_OK;
+}
+
+static const char *ScnSTokenMapIndex =
+ "dmbyYHMSpJjCgGVazUsntQ";
+static ClockScanTokenMap ScnSTokenMap[] = {
+ /* %d %e */
+ {CTOKT_INT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth),
+ NULL},
+ /* %m %N */
+ {CTOKT_INT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month),
+ NULL},
+ /* %b %B %h */
+ {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0,
+ ClockScnToken_Month_Proc},
+ /* %y */
+ {CTOKT_INT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year),
+ NULL},
+ /* %Y */
+ {CTOKT_INT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year),
+ NULL},
+ /* %H %k %I %l */
+ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour),
+ NULL},
+ /* %M */
+ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes),
+ NULL},
+ /* %S */
+ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfMin),
+ NULL},
+ /* %p %P */
+ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0,
+ ClockScnToken_amPmInd_Proc, NULL},
+ /* %J */
+ {CTOKT_WIDE, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay),
+ NULL},
+ /* %j */
+ {CTOKT_INT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear),
+ NULL},
+ /* %C */
+ {CTOKT_INT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury),
+ NULL},
+ /* %g */
+ {CTOKT_INT, CLF_ISO8601YEAR, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year),
+ NULL},
+ /* %G */
+ {CTOKT_INT, CLF_ISO8601YEAR | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year),
+ NULL},
+ /* %V */
+ {CTOKT_INT, CLF_ISO8601WEAK, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week),
+ NULL},
+ /* %a %A %u %w */
+ {CTOKT_PARSER, CLF_DAYOFWEEK, 0, 0, 0xffff, 0,
+ ClockScnToken_DayOfWeek_Proc, NULL},
+ /* %z %Z */
+ {CTOKT_PARSER, CLF_OPTIONAL, 0, 0, 0xffff, 0,
+ ClockScnToken_TimeZone_Proc, NULL},
+ /* %U %W */
+ {CTOKT_INT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */
+ NULL},
+ /* %s */
+ {CTOKT_WIDE, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds),
+ NULL},
+ /* %n */
+ {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"},
+ /* %t */
+ {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\t"},
+ /* %Q */
+ {CTOKT_PARSER, CLF_LOCALSEC, 0, 16, 30, 0,
+ ClockScnToken_StarDate_Proc, NULL},
+};
+static const char *ScnSTokenMapAliasIndex[2] = {
+ "eNBhkIlPAuwZW",
+ "dmbbHHHpaaazU"
+};
+
+static const char *ScnETokenMapIndex =
+ "Eys";
+static ClockScanTokenMap ScnETokenMap[] = {
+ /* %EE */
+ {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year),
+ ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Ey */
+ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Es */
+ {CTOKT_WIDE, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds),
+ NULL},
+};
+static const char *ScnETokenMapAliasIndex[2] = {
+ "",
+ ""
+};
+
+static const char *ScnOTokenMapIndex =
+ "dmyHMSu";
+static ClockScanTokenMap ScnOTokenMap[] = {
+ /* %Od %Oe */
+ {CTOKT_PARSER, CLF_DAYOFMONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.dayOfMonth),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Om */
+ {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, TclOffset(DateInfo, date.month),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Oy */
+ {CTOKT_PARSER, CLF_YEAR, 0, 0, 0xffff, TclOffset(DateInfo, date.year),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OH %Ok %OI %Ol */
+ {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.hour),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OM */
+ {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.minutes),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OS */
+ {CTOKT_PARSER, CLF_TIME, 0, 0, 0xffff, TclOffset(DateInfo, date.secondOfMin),
+ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Ou Ow */
+ {CTOKT_PARSER, CLF_DAYOFWEEK, 0, 0, 0xffff, 0,
+ ClockScnToken_DayOfWeek_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+};
+static const char *ScnOTokenMapAliasIndex[2] = {
+ "ekIlw",
+ "dHHHu"
+};
+
+/* Token map reserved for CTOKT_SPACE */
+static ClockScanTokenMap ScnSpaceTokenMap = {
+ CTOKT_SPACE, 0, 0, 1, 1, 0,
+ NULL,
+};
+
+static ClockScanTokenMap ScnWordTokenMap = {
+ CTOKT_WORD, 0, 0, 1, 1, 0,
+ NULL
+};
+
+
+static inline unsigned int
+EstimateTokenCount(
+ register const char *fmt,
+ register const char *end)
+{
+ register const char *p = fmt;
+ unsigned int tokcnt;
+ /* estimate token count by % char and format length */
+ tokcnt = 0;
+ while (p <= end) {
+ if (*p++ == '%') {
+ tokcnt++;
+ p++;
+ }
+ }
+ p = fmt + tokcnt * 2;
+ if (p < end) {
+ if ((unsigned int)(end - p) < tokcnt) {
+ tokcnt += (end - p);
+ } else {
+ tokcnt += tokcnt;
+ }
+ }
+ return ++tokcnt;
+}
+
+#define AllocTokenInChain(tok, chain, tokCnt) \
+ if (++(tok) >= (chain) + (tokCnt)) { \
+ chain = ckrealloc((char *)(chain), \
+ (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \
+ if ((chain) == NULL) { goto done; }; \
+ (tok) = (chain) + (tokCnt); \
+ (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \
+ } \
+ memset(tok, 0, sizeof(*(tok)));
+
+/*
+ *----------------------------------------------------------------------
+ */
+ClockFmtScnStorage *
+ClockGetOrParseScanFormat(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *formatObj) /* Format container */
+{
+ ClockFmtScnStorage *fss;
+
+ fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);
+ if (fss == NULL) {
+ return NULL;
+ }
+
+ /* if format (scnTok) already tokenized */
+ if (fss->scnTok != NULL) {
+ return fss;
+ }
+
+ Tcl_MutexLock(&ClockFmtMutex);
+
+ /* first time scanning - tokenize format */
+ if (fss->scnTok == NULL) {
+ ClockScanToken *tok, *scnTok;
+ unsigned int tokCnt;
+ register const char *p, *e, *cp;
+
+ e = p = HashEntry4FmtScn(fss)->key.string;
+ e += strlen(p);
+
+ /* estimate token count by % char and format length */
+ fss->scnTokC = EstimateTokenCount(p, e);
+
+ fss->scnSpaceCount = 0;
+
+ scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC);
+ memset(tok, 0, sizeof(*(tok)));
+ tokCnt = 1;
+ while (p < e) {
+ switch (*p) {
+ case '%':
+ if (1) {
+ ClockScanTokenMap * scnMap = ScnSTokenMap;
+ const char *mapIndex = ScnSTokenMapIndex,
+ **aliasIndex = ScnSTokenMapAliasIndex;
+ if (p+1 >= e) {
+ goto word_tok;
+ }
+ p++;
+ /* try to find modifier: */
+ switch (*p) {
+ case '%':
+ /* begin new word token - don't join with previous word token,
+ * because current mapping should be "...%%..." -> "...%..." */
+ tok->map = &ScnWordTokenMap;
+ tok->tokWord.start = p;
+ tok->tokWord.end = p+1;
+ AllocTokenInChain(tok, scnTok, fss->scnTokC); tokCnt++;
+ p++;
+ continue;
+ break;
+ case 'E':
+ scnMap = ScnETokenMap,
+ mapIndex = ScnETokenMapIndex,
+ aliasIndex = ScnETokenMapAliasIndex;
+ p++;
+ break;
+ case 'O':
+ scnMap = ScnOTokenMap,
+ mapIndex = ScnOTokenMapIndex,
+ aliasIndex = ScnOTokenMapAliasIndex;
+ p++;
+ break;
+ }
+ /* search direct index */
+ cp = strchr(mapIndex, *p);
+ if (!cp || *cp == '\0') {
+ /* search wrapper index (multiple chars for same token) */
+ cp = strchr(aliasIndex[0], *p);
+ if (!cp || *cp == '\0') {
+ p--; if (scnMap != ScnSTokenMap) p--;
+ goto word_tok;
+ }
+ cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]);
+ if (!cp || *cp == '\0') { /* unexpected, but ... */
+ #ifdef DEBUG
+ Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p);
+ #endif
+ p--; if (scnMap != ScnSTokenMap) p--;
+ goto word_tok;
+ }
+ }
+ tok->map = &scnMap[cp - mapIndex];
+ tok->tokWord.start = p;
+
+ /* calculate look ahead value by standing together tokens */
+ if (tok > scnTok) {
+ ClockScanToken *prevTok = tok - 1;
+
+ while (prevTok >= scnTok) {
+ if (prevTok->map->type != tok->map->type) {
+ break;
+ }
+ prevTok->lookAhMin += tok->map->minSize;
+ prevTok->lookAhMax += tok->map->maxSize;
+ prevTok->lookAhTok++;
+ prevTok--;
+ }
+ }
+
+ /* increase space count used in format */
+ if ( tok->map->type == CTOKT_CHAR
+ && isspace(UCHAR(*((char *)tok->map->data)))
+ ) {
+ fss->scnSpaceCount++;
+ }
+
+ /* next token */
+ AllocTokenInChain(tok, scnTok, fss->scnTokC); tokCnt++;
+ p++;
+ continue;
+ }
+ break;
+ default:
+ if ( *p == ' ' || isspace(UCHAR(*p)) ) {
+ tok->map = &ScnSpaceTokenMap;
+ tok->tokWord.start = p++;
+ while (p < e && isspace(UCHAR(*p))) {
+ p++;
+ }
+ tok->tokWord.end = p;
+ /* increase space count used in format */
+ fss->scnSpaceCount++;
+ /* next token */
+ AllocTokenInChain(tok, scnTok, fss->scnTokC); tokCnt++;
+ continue;
+ }
+word_tok:
+ if (1) {
+ ClockScanToken *wordTok = tok;
+ if (tok > scnTok && (tok-1)->map == &ScnWordTokenMap) {
+ wordTok = tok-1;
+ }
+ /* new word token */
+ if (wordTok == tok) {
+ wordTok->tokWord.start = p;
+ wordTok->map = &ScnWordTokenMap;
+ AllocTokenInChain(tok, scnTok, fss->scnTokC); tokCnt++;
+ }
+ if (isspace(UCHAR(*p))) {
+ fss->scnSpaceCount++;
+ }
+ p = TclUtfNext(p);
+ wordTok->tokWord.end = p;
+ }
+ break;
+ }
+ }
+
+ /* calculate end distance value for each tokens */
+ if (tok > scnTok) {
+ unsigned int endDist = 0;
+ ClockScanToken *prevTok = tok-1;
+
+ while (prevTok >= scnTok) {
+ prevTok->endDistance = endDist;
+ if (prevTok->map->type != CTOKT_WORD) {
+ endDist += prevTok->map->minSize;
+ } else {
+ endDist += prevTok->tokWord.end - prevTok->tokWord.start;
+ }
+ prevTok--;
+ }
+ }
+
+ /* correct count of real used tokens and free mem if desired
+ * (1 is acceptable delta to prevent memory fragmentation) */
+ if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) {
+ if ( (tok = ckrealloc(scnTok, tokCnt * sizeof(*tok))) != NULL ) {
+ scnTok = tok;
+ }
+ }
+
+ /* now we're ready - assign now to storage (note the threaded race condition) */
+ fss->scnTok = scnTok;
+ fss->scnTokC = tokCnt;
+ }
+done:
+ Tcl_MutexUnlock(&ClockFmtMutex);
+
+ return fss;
+}
+
+/*
+ *----------------------------------------------------------------------
+ */
+int
+ClockScan(
+ register DateInfo *info, /* Date fields used for parsing & converting */
+ Tcl_Obj *strObj, /* String containing the time to scan */
+ ClockFmtScnCmdArgs *opts) /* Command options */
+{
+ ClockClientData *dataPtr = opts->clientData;
+ ClockFmtScnStorage *fss;
+ ClockScanToken *tok;
+ ClockScanTokenMap *map;
+ register const char *p, *x, *end;
+ unsigned short int flags = 0;
+ int ret = TCL_ERROR;
+
+ /* get localized format */
+ if (ClockLocalizeFormat(opts) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if ( !(fss = ClockGetOrParseScanFormat(opts->interp, opts->formatObj))
+ || !(tok = fss->scnTok)
+ ) {
+ return TCL_ERROR;
+ }
+
+ /* prepare parsing */
+
+ yyMeridian = MER24;
+
+ p = TclGetString(strObj);
+ end = p + strObj->length;
+ /* in strict mode - bypass spaces at begin / end only (not between tokens) */
+ if (opts->flags & CLF_STRICT) {
+ while (p < end && isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+ yyInput = p;
+ /* look ahead to count spaces (bypass it by count length and distances) */
+ x = end;
+ while (p < end) {
+ if (isspace(UCHAR(*p))) {
+ x = ++p; /* after first space in space block */
+ yySpaceCount++;
+ while (p < end && isspace(UCHAR(*p))) {
+ p++;
+ yySpaceCount++;
+ }
+ continue;
+ }
+ x = end;
+ p++;
+ }
+ /* ignore more as 1 space at end */
+ yySpaceCount -= (end - x);
+ end = x;
+ /* ignore mandatory spaces used in format */
+ yySpaceCount -= fss->scnSpaceCount;
+ if (yySpaceCount < 0) {
+ yySpaceCount = 0;
+ }
+ info->dateStart = p = yyInput;
+ info->dateEnd = end;
+
+ /* parse string */
+ for (; tok->map != NULL; tok++) {
+ map = tok->map;
+ /* bypass spaces at begin of input before parsing each token */
+ if ( !(opts->flags & CLF_STRICT)
+ && ( map->type != CTOKT_SPACE
+ && map->type != CTOKT_WORD
+ && map->type != CTOKT_CHAR )
+ ) {
+ while (p < end && isspace(UCHAR(*p))) {
+ yySpaceCount--;
+ p++;
+ }
+ }
+ yyInput = p;
+ /* end of input string */
+ if (p >= end) {
+ break;
+ }
+ switch (map->type)
+ {
+ case CTOKT_INT:
+ case CTOKT_WIDE:
+ if (1) {
+ int minLen, size;
+ int sign = 1;
+ if (map->flags & CLF_SIGNED) {
+ if (*p == '+') { yyInput = ++p; }
+ else
+ if (*p == '-') { yyInput = ++p; sign = -1; };
+ }
+
+ DetermineGreedySearchLen(opts, info, tok, &minLen, &size);
+
+ if (size < map->minSize) {
+ /* missing input -> error */
+ if ((map->flags & CLF_OPTIONAL)) {
+ continue;
+ }
+ goto not_match;
+ }
+ /* string 2 number, put number into info structure by offset */
+ if (map->offs) {
+ p = yyInput; x = p + size;
+ if (map->type == CTOKT_INT) {
+ if (_str2int((int *)(((char *)info) + map->offs),
+ p, x, sign) != TCL_OK) {
+ goto overflow;
+ }
+ p = x;
+ } else {
+ if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs),
+ p, x, sign) != TCL_OK) {
+ goto overflow;
+ }
+ p = x;
+ }
+ flags = (flags & ~map->clearFlags) | map->flags;
+ }
+ }
+ break;
+ case CTOKT_PARSER:
+ switch (map->parser(opts, info, tok)) {
+ case TCL_OK:
+ break;
+ case TCL_RETURN:
+ if ((map->flags & CLF_OPTIONAL)) {
+ yyInput = p;
+ continue;
+ }
+ goto not_match;
+ break;
+ default:
+ goto done;
+ break;
+ };
+ /* decrement count for possible spaces in match */
+ while (p < yyInput) {
+ if (isspace(UCHAR(*p))) {
+ yySpaceCount--;
+ }
+ p++;
+ }
+ p = yyInput;
+ flags = (flags & ~map->clearFlags) | map->flags;
+ break;
+ case CTOKT_SPACE:
+ /* at least one space */
+ if (!isspace(UCHAR(*p))) {
+ /* unmatched -> error */
+ goto not_match;
+ }
+ /* don't decrement yySpaceCount by regular (first expected space),
+ * already considered above with fss->scnSpaceCount */;
+ p++;
+ while (p < end && isspace(UCHAR(*p))) {
+ yySpaceCount--;
+ p++;
+ }
+ break;
+ case CTOKT_WORD:
+ x = FindWordEnd(tok, p, end);
+ if (!x) {
+ /* no match -> error */
+ goto not_match;
+ }
+ p = x;
+ break;
+ case CTOKT_CHAR:
+ x = (char *)map->data;
+ if (*x != *p) {
+ /* no match -> error */
+ goto not_match;
+ }
+ if (isspace(UCHAR(*x))) {
+ yySpaceCount--;
+ }
+ p++;
+ break;
+ }
+ }
+ /* check end was reached */
+ if (p < end) {
+ /* in non-strict mode bypass spaces at end of input */
+ if ( !(opts->flags & CLF_STRICT) && isspace(UCHAR(*p)) ) {
+ p++;
+ while (p < end && isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+ /* something after last token - wrong format */
+ if (p < end) {
+ 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) {
+ /* no tokens anymore - trailing spaces are mandatory */
+ goto not_match;
+ }
+ }
+ if (!(tok->map->flags & CLF_OPTIONAL)) {
+ goto not_match;
+ }
+ tok++;
+ }
+
+ /*
+ * Invalidate result
+ */
+
+ /* seconds token (%s) take precedence over all other tokens */
+ if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) {
+ if (flags & CLF_DATE) {
+
+ if (!(flags & CLF_JULIANDAY)) {
+ info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY;
+
+ /* dd precedence below ddd */
+ switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) {
+ case (CLF_DAYOFYEAR|CLF_DAYOFMONTH):
+ /* miss month: ddd over dd (without month) */
+ flags &= ~CLF_DAYOFMONTH;
+ case (CLF_DAYOFYEAR):
+ /* ddd over naked weekday */
+ if (!(flags & CLF_ISO8601YEAR)) {
+ flags &= ~CLF_ISO8601WEAK;
+ }
+ break;
+ case (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH):
+ /* both available: mmdd over ddd */
+ case (CLF_MONTH|CLF_DAYOFMONTH):
+ case (CLF_DAYOFMONTH):
+ /* mmdd / dd over naked weekday */
+ if (!(flags & CLF_ISO8601YEAR)) {
+ flags &= ~CLF_ISO8601WEAK;
+ }
+ break;
+ /* neither mmdd nor ddd available */
+ case 0:
+ /* but we have day of the week, which can be used */
+ if (flags & CLF_DAYOFWEEK) {
+ /* prefer week based calculation of julianday */
+ flags |= CLF_ISO8601WEAK;
+ }
+ }
+
+ /* YearWeekDay below YearMonthDay */
+ if ( (flags & CLF_ISO8601WEAK)
+ && ( (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_ISO8601WEAK;
+ }
+ else
+ /* yymmdd or yyddd over naked weekday */
+ if (!(flags & CLF_ISO8601YEAR)) {
+ flags &= ~CLF_ISO8601WEAK;
+ }
+ }
+
+ if ( (flags & CLF_YEAR) ) {
+ if (yyYear < 100) {
+ if (!(flags & CLF_CENTURY)) {
+ if (yyYear >= dataPtr->yearOfCenturySwitch) {
+ yyYear -= 100;
+ }
+ yyYear += dataPtr->currentYearCentury;
+ } else {
+ yyYear += info->dateCentury * 100;
+ }
+ }
+ }
+ if ( (flags & (CLF_ISO8601WEAK|CLF_ISO8601YEAR)) ) {
+ if ((flags & (CLF_ISO8601YEAR|CLF_YEAR)) == CLF_YEAR) {
+ /* for calculations expected iso year */
+ info->date.iso8601Year = yyYear;
+ }
+ 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 ((flags & (CLF_ISO8601YEAR|CLF_YEAR)) == CLF_ISO8601YEAR) {
+ /* for calculations expected year (e. g. CLF_ISO8601WEAK not set) */
+ yyYear = info->date.iso8601Year;
+ }
+ }
+ }
+ }
+
+ /* if no time - reset time */
+ if (!(flags & (CLF_TIME|CLF_LOCALSEC|CLF_POSIXSEC))) {
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ yydate.localSeconds = 0;
+ }
+
+ if (flags & CLF_TIME) {
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ yySecondOfDay = ToSeconds(yyHour, yyMinutes,
+ yySeconds, yyMeridian);
+ } else
+ if (!(flags & (CLF_LOCALSEC|CLF_POSIXSEC))) {
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ yySecondOfDay = yydate.localSeconds % SECONDS_PER_DAY;
+ }
+ }
+
+ /* tell caller which flags were set */
+ info->flags |= flags;
+
+ ret = TCL_OK;
+ goto done;
+
+overflow:
+
+ Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("requested date too large to represent",
+ -1));
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL);
+ goto done;
+
+not_match:
+
+ #if 1
+ Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("input string does not match supplied format",
+ -1));
+ #else
+ /* to debug where exactly scan breaks */
+ Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf(
+ "input string \"%s\" does not match supplied format \"%s\","
+ " locale \"%s\" - token \"%s\"",
+ info->dateStart, HashEntry4FmtScn(fss)->key.string,
+ Tcl_GetString(opts->localeObj),
+ tok && tok->tokWord.start ? tok->tokWord.start : "NULL"));
+ #endif
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL);
+
+done:
+
+ return ret;
+}
+
+#define FrmResultIsAllocated(dateFmt) \
+ (dateFmt->resEnd - dateFmt->resMem > MIN_FMT_RESULT_BLOCK_ALLOC)
+
+static inline int
+FrmResultAllocate(
+ register DateFormat *dateFmt,
+ int len)
+{
+ int needed = dateFmt->output + len - dateFmt->resEnd;
+ if (needed >= 0) { /* >= 0 - regards NTS zero */
+ int newsize = dateFmt->resEnd - dateFmt->resMem
+ + needed + MIN_FMT_RESULT_BLOCK_ALLOC*2;
+ char *newRes;
+ /* differentiate between stack and memory */
+ if (!FrmResultIsAllocated(dateFmt)) {
+ newRes = ckalloc(newsize);
+ if (newRes == NULL) {
+ return TCL_ERROR;
+ }
+ memcpy(newRes, dateFmt->resMem, dateFmt->output - dateFmt->resMem);
+ } else {
+ newRes = ckrealloc(dateFmt->resMem, newsize);
+ if (newRes == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ dateFmt->output = newRes + (dateFmt->output - dateFmt->resMem);
+ dateFmt->resMem = newRes;
+ dateFmt->resEnd = newRes + newsize;
+ }
+ return TCL_OK;
+}
+
+static int
+ClockFmtToken_HourAMPM_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ *val = ( ( *val + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1;
+ return TCL_OK;
+}
+
+static int
+ClockFmtToken_AMPM_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ Tcl_Obj *mcObj;
+ const char *s;
+ int len;
+
+ if (*val < (SECONDS_PER_DAY / 2)) {
+ mcObj = ClockMCGet(opts, MCLIT_AM);
+ } else {
+ mcObj = ClockMCGet(opts, MCLIT_PM);
+ }
+ if (mcObj == NULL) {
+ return TCL_ERROR;
+ }
+ s = TclGetString(mcObj); len = mcObj->length;
+ if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
+ memcpy(dateFmt->output, s, len + 1);
+ if (*tok->tokWord.start == 'p') {
+ len = Tcl_UtfToUpper(dateFmt->output);
+ }
+ dateFmt->output += len;
+
+ return TCL_OK;
+}
+
+static int
+ClockFmtToken_StarDate_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+ {
+ int fractYear;
+ /* Get day of year, zero based */
+ int v = dateFmt->date.dayOfYear - 1;
+
+ /* Convert day of year to a fractional year */
+ if (IsGregorianLeapYear(&dateFmt->date)) {
+ fractYear = 1000 * v / 366;
+ } else {
+ fractYear = 1000 * v / 365;
+ }
+
+ /* Put together the StarDate as "Stardate %02d%03d.%1d" */
+ if (FrmResultAllocate(dateFmt, 30) != TCL_OK) { return TCL_ERROR; };
+ memcpy(dateFmt->output, "Stardate ", 9);
+ dateFmt->output += 9;
+ dateFmt->output = _itoaw(dateFmt->output,
+ dateFmt->date.year - RODDENBERRY, '0', 2);
+ dateFmt->output = _itoaw(dateFmt->output,
+ fractYear, '0', 3);
+ *dateFmt->output++ = '.';
+ /* be sure positive after decimal point (note: clock-value can be negative) */
+ v = dateFmt->date.secondOfDay / ( SECONDS_PER_DAY / 10 );
+ if (v < 0) v = 10 + v;
+ dateFmt->output = _itoaw(dateFmt->output, v, '0', 1);
+
+ return TCL_OK;
+}
+static int
+ClockFmtToken_WeekOfYear_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ int dow = dateFmt->date.dayOfWeek;
+ if (*tok->tokWord.start == 'U') {
+ if (dow == 7) {
+ dow = 0;
+ }
+ dow++;
+ }
+ *val = ( dateFmt->date.dayOfYear - dow + 7 ) / 7;
+ return TCL_OK;
+}
+static int
+ClockFmtToken_TimeZone_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ if (*tok->tokWord.start == 'z') {
+ int z = dateFmt->date.tzOffset;
+ char sign = '+';
+ if ( z < 0 ) {
+ z = -z;
+ sign = '-';
+ }
+ if (FrmResultAllocate(dateFmt, 7) != TCL_OK) { return TCL_ERROR; };
+ *dateFmt->output++ = sign;
+ dateFmt->output = _itoaw(dateFmt->output, z / 3600, '0', 2);
+ z %= 3600;
+ dateFmt->output = _itoaw(dateFmt->output, z / 60, '0', 2);
+ z %= 60;
+ if (z != 0) {
+ dateFmt->output = _itoaw(dateFmt->output, z, '0', 2);
+ }
+ } else {
+ Tcl_Obj * objPtr;
+ const char *s; int len;
+ /* convert seconds to local seconds to obtain tzName object */
+ if (ConvertUTCToLocal(opts->clientData, opts->interp,
+ &dateFmt->date, opts->timezoneObj,
+ GREGORIAN_CHANGE_DATE) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ objPtr = dateFmt->date.tzName;
+ s = TclGetString(objPtr);
+ len = objPtr->length;
+ if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
+ memcpy(dateFmt->output, s, len + 1);
+ dateFmt->output += len;
+ }
+ return TCL_OK;
+}
+
+static int
+ClockFmtToken_LocaleERA_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ Tcl_Obj *mcObj;
+ const char *s;
+ int len;
+
+ if (dateFmt->date.era == BCE) {
+ mcObj = ClockMCGet(opts, MCLIT_BCE);
+ } else {
+ mcObj = ClockMCGet(opts, MCLIT_CE);
+ }
+ if (mcObj == NULL) {
+ return TCL_ERROR;
+ }
+ s = TclGetString(mcObj); len = mcObj->length;
+ if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
+ memcpy(dateFmt->output, s, len + 1);
+ dateFmt->output += len;
+
+ return TCL_OK;
+}
+
+static int
+ClockFmtToken_LocaleERAYear_Proc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val)
+{
+ int rowc;
+ Tcl_Obj **rowv;
+
+ if (dateFmt->localeEra == NULL) {
+ Tcl_Obj *mcObj = ClockMCGet(opts, MCLIT_LOCALE_ERAS);
+ if (mcObj == NULL) {
+ return TCL_ERROR;
+ }
+ if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (rowc != 0) {
+ dateFmt->localeEra = LookupLastTransition(opts->interp,
+ dateFmt->date.localSeconds, rowc, rowv, NULL);
+ }
+ if (dateFmt->localeEra == NULL) {
+ dateFmt->localeEra = (Tcl_Obj*)1;
+ }
+ }
+
+ /* if no LOCALE_ERAS in catalog or era not found */
+ if (dateFmt->localeEra == (Tcl_Obj*)1) {
+ if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; };
+ if (*tok->tokWord.start == 'C') { /* %EC */
+ *val = dateFmt->date.year / 100;
+ dateFmt->output = _itoaw(dateFmt->output,
+ *val, '0', 2);
+ } else { /* %Ey */
+ *val = dateFmt->date.year % 100;
+ dateFmt->output = _itoaw(dateFmt->output,
+ *val, '0', 2);
+ }
+ } else {
+ Tcl_Obj *objPtr;
+ const char *s;
+ int len;
+ if (*tok->tokWord.start == 'C') { /* %EC */
+ if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1,
+ &objPtr) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ } else { /* %Ey */
+ if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 2,
+ &objPtr) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *val = dateFmt->date.year - *val;
+ /* if year in locale numerals */
+ if (*val >= 0 && *val < 100) {
+ /* year as integer */
+ Tcl_Obj * mcObj = ClockMCGet(opts, MCLIT_LOCALE_NUMERALS);
+ if (mcObj == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ /* year as integer */
+ if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { return TCL_ERROR; };
+ dateFmt->output = _itoaw(dateFmt->output,
+ *val, '0', 2);
+ return TCL_OK;
+ }
+ }
+ s = TclGetString(objPtr);
+ len = objPtr->length;
+ if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; };
+ memcpy(dateFmt->output, s, len + 1);
+ dateFmt->output += len;
+ }
+ return TCL_OK;
+}
+
+
+static const char *FmtSTokenMapIndex =
+ "demNbByYCHMSIklpaAuwUVzgGjJsntQ";
+static ClockFormatTokenMap FmtSTokenMap[] = {
+ /* %d */
+ {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL},
+ /* %e */
+ {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL},
+ /* %m */
+ {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL},
+ /* %N */
+ {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL},
+ /* %b %h */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month),
+ NULL, (void *)MCLIT_MONTHS_ABBREV},
+ /* %B */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month),
+ NULL, (void *)MCLIT_MONTHS_FULL},
+ /* %y */
+ {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL},
+ /* %Y */
+ {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL},
+ /* %C */
+ {CTOKT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL},
+ /* %H */
+ {CTOKT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL},
+ /* %M */
+ {CTOKT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL},
+ /* %S */
+ {CTOKT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL},
+ /* %I */
+ {CTOKT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay),
+ ClockFmtToken_HourAMPM_Proc, NULL},
+ /* %k */
+ {CTOKT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL},
+ /* %l */
+ {CTOKT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay),
+ ClockFmtToken_HourAMPM_Proc, NULL},
+ /* %p %P */
+ {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.secondOfDay),
+ ClockFmtToken_AMPM_Proc, NULL},
+ /* %a */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
+ NULL, (void *)MCLIT_DAYS_OF_WEEK_ABBREV},
+ /* %A */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
+ NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL},
+ /* %u */
+ {CTOKT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL},
+ /* %w */
+ {CTOKT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL},
+ /* %U %W */
+ {CTOKT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear),
+ ClockFmtToken_WeekOfYear_Proc, NULL},
+ /* %V */
+ {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL},
+ /* %z %Z */
+ {CTOKT_INT, NULL, 0, 0, 0, 0, 0,
+ ClockFmtToken_TimeZone_Proc, NULL},
+ /* %g */
+ {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL},
+ /* %G */
+ {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL},
+ /* %j */
+ {CTOKT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL},
+ /* %J */
+ {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL},
+ /* %s */
+ {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL},
+ /* %n */
+ {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL},
+ /* %t */
+ {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL},
+ /* %Q */
+ {CTOKT_INT, NULL, 0, 0, 0, 0, 0,
+ ClockFmtToken_StarDate_Proc, NULL},
+};
+static const char *FmtSTokenMapAliasIndex[2] = {
+ "hPWZ",
+ "bpUz"
+};
+
+static const char *FmtETokenMapIndex =
+ "Eys";
+static ClockFormatTokenMap FmtETokenMap[] = {
+ /* %EE */
+ {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era),
+ ClockFmtToken_LocaleERA_Proc, NULL},
+ /* %Ey %EC */
+ {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year),
+ ClockFmtToken_LocaleERAYear_Proc, NULL},
+ /* %Es */
+ {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL},
+};
+static const char *FmtETokenMapAliasIndex[2] = {
+ "C",
+ "y"
+};
+
+static const char *FmtOTokenMapIndex =
+ "dmyHIMSuw";
+static ClockFormatTokenMap FmtOTokenMap[] = {
+ /* %Od %Oe */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfMonth),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Om */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.month),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Oy */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.year),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OH %Ok */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 3600, 24, TclOffset(DateFormat, date.secondOfDay),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OI %Ol */
+ {CTOKT_INT, NULL, 0, CLFMT_CALC | CLFMT_LOCALE_INDX, 0, 0, TclOffset(DateFormat, date.secondOfDay),
+ ClockFmtToken_HourAMPM_Proc, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OM */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 60, 60, TclOffset(DateFormat, date.secondOfDay),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %OS */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 60, TclOffset(DateFormat, date.secondOfDay),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Ou */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 100, TclOffset(DateFormat, date.dayOfWeek),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+ /* %Ow */
+ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek),
+ NULL, (void *)MCLIT_LOCALE_NUMERALS},
+};
+static const char *FmtOTokenMapAliasIndex[2] = {
+ "ekl",
+ "dHI"
+};
+
+static ClockFormatTokenMap FmtWordTokenMap = {
+ CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL
+};
+
+/*
+ *----------------------------------------------------------------------
+ */
+ClockFmtScnStorage *
+ClockGetOrParseFmtFormat(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *formatObj) /* Format container */
+{
+ ClockFmtScnStorage *fss;
+
+ fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);
+ if (fss == NULL) {
+ return NULL;
+ }
+
+ /* if format (fmtTok) already tokenized */
+ if (fss->fmtTok != NULL) {
+ return fss;
+ }
+
+ Tcl_MutexLock(&ClockFmtMutex);
+
+ /* first time formatting - tokenize format */
+ if (fss->fmtTok == NULL) {
+ ClockFormatToken *tok, *fmtTok;
+ unsigned int tokCnt;
+ register const char *p, *e, *cp;
+
+ e = p = HashEntry4FmtScn(fss)->key.string;
+ e += strlen(p);
+
+ /* estimate token count by % char and format length */
+ fss->fmtTokC = EstimateTokenCount(p, e);
+
+ fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC);
+ memset(tok, 0, sizeof(*(tok)));
+ tokCnt = 1;
+ while (p < e) {
+ switch (*p) {
+ case '%':
+ if (1) {
+ ClockFormatTokenMap * fmtMap = FmtSTokenMap;
+ const char *mapIndex = FmtSTokenMapIndex,
+ **aliasIndex = FmtSTokenMapAliasIndex;
+ if (p+1 >= e) {
+ goto word_tok;
+ }
+ p++;
+ /* try to find modifier: */
+ switch (*p) {
+ case '%':
+ /* begin new word token - don't join with previous word token,
+ * because current mapping should be "...%%..." -> "...%..." */
+ tok->map = &FmtWordTokenMap;
+ tok->tokWord.start = p;
+ tok->tokWord.end = p+1;
+ AllocTokenInChain(tok, fmtTok, fss->fmtTokC); tokCnt++;
+ p++;
+ continue;
+ break;
+ case 'E':
+ fmtMap = FmtETokenMap,
+ mapIndex = FmtETokenMapIndex,
+ aliasIndex = FmtETokenMapAliasIndex;
+ p++;
+ break;
+ case 'O':
+ fmtMap = FmtOTokenMap,
+ mapIndex = FmtOTokenMapIndex,
+ aliasIndex = FmtOTokenMapAliasIndex;
+ p++;
+ break;
+ }
+ /* search direct index */
+ cp = strchr(mapIndex, *p);
+ if (!cp || *cp == '\0') {
+ /* search wrapper index (multiple chars for same token) */
+ cp = strchr(aliasIndex[0], *p);
+ if (!cp || *cp == '\0') {
+ p--; if (fmtMap != FmtSTokenMap) p--;
+ goto word_tok;
+ }
+ cp = strchr(mapIndex, aliasIndex[1][cp - aliasIndex[0]]);
+ if (!cp || *cp == '\0') { /* unexpected, but ... */
+ #ifdef DEBUG
+ Tcl_Panic("token \"%c\" has no map in wrapper resolver", *p);
+ #endif
+ p--; if (fmtMap != FmtSTokenMap) p--;
+ goto word_tok;
+ }
+ }
+ tok->map = &fmtMap[cp - mapIndex];
+ tok->tokWord.start = p;
+ /* next token */
+ AllocTokenInChain(tok, fmtTok, fss->fmtTokC); tokCnt++;
+ p++;
+ continue;
+ }
+ break;
+ default:
+word_tok:
+ if (1) {
+ ClockFormatToken *wordTok = tok;
+ if (tok > fmtTok && (tok-1)->map == &FmtWordTokenMap) {
+ wordTok = tok-1;
+ }
+ if (wordTok == tok) {
+ wordTok->tokWord.start = p;
+ wordTok->map = &FmtWordTokenMap;
+ AllocTokenInChain(tok, fmtTok, fss->fmtTokC); tokCnt++;
+ }
+ p = TclUtfNext(p);
+ wordTok->tokWord.end = p;
+ }
+ break;
+ }
+ }
+
+ /* correct count of real used tokens and free mem if desired
+ * (1 is acceptable delta to prevent memory fragmentation) */
+ if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) {
+ if ( (tok = ckrealloc(fmtTok, tokCnt * sizeof(*tok))) != NULL ) {
+ fmtTok = tok;
+ }
+ }
+
+ /* now we're ready - assign now to storage (note the threaded race condition) */
+ fss->fmtTok = fmtTok;
+ fss->fmtTokC = tokCnt;
+ }
+done:
+ Tcl_MutexUnlock(&ClockFmtMutex);
+
+ return fss;
+}
+
+/*
+ *----------------------------------------------------------------------
+ */
+int
+ClockFormat(
+ register DateFormat *dateFmt, /* Date fields used for parsing & converting */
+ ClockFmtScnCmdArgs *opts) /* Command options */
+{
+ ClockFmtScnStorage *fss;
+ ClockFormatToken *tok;
+ ClockFormatTokenMap *map;
+ char resMem[MIN_FMT_RESULT_BLOCK_ALLOC];
+
+ /* get localized format */
+ if (ClockLocalizeFormat(opts) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if ( !(fss = ClockGetOrParseFmtFormat(opts->interp, opts->formatObj))
+ || !(tok = fss->fmtTok)
+ ) {
+ return TCL_ERROR;
+ }
+
+ /* result container object */
+ dateFmt->resMem = resMem;
+ dateFmt->resEnd = dateFmt->resMem + sizeof(resMem);
+ if (fss->fmtMinAlloc > sizeof(resMem)) {
+ dateFmt->resMem = ckalloc(fss->fmtMinAlloc);
+ dateFmt->resEnd = dateFmt->resMem + fss->fmtMinAlloc;
+ if (dateFmt->resMem == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ dateFmt->output = dateFmt->resMem;
+ *dateFmt->output = '\0';
+
+ /* do format each token */
+ for (; tok->map != NULL; tok++) {
+ map = tok->map;
+ switch (map->type)
+ {
+ case CTOKT_INT:
+ if (1) {
+ int val = (int)*(int *)(((char *)dateFmt) + map->offs);
+ if (map->fmtproc == NULL) {
+ if (map->flags & CLFMT_DECR) {
+ val--;
+ }
+ if (map->flags & CLFMT_INCR) {
+ val++;
+ }
+ if (map->divider) {
+ val /= map->divider;
+ }
+ if (map->divmod) {
+ val %= map->divmod;
+ }
+ } else {
+ if (map->fmtproc(opts, dateFmt, tok, &val) != TCL_OK) {
+ goto done;
+ }
+ /* if not calculate only (output inside fmtproc) */
+ if (!(map->flags & CLFMT_CALC)) {
+ continue;
+ }
+ }
+ if (!(map->flags & CLFMT_LOCALE_INDX)) {
+ if (FrmResultAllocate(dateFmt, 11) != TCL_OK) { goto error; };
+ if (map->width) {
+ dateFmt->output = _itoaw(dateFmt->output, val, *map->tostr, map->width);
+ } else {
+ dateFmt->output += sprintf(dateFmt->output, map->tostr, val);
+ }
+ } else {
+ const char *s;
+ Tcl_Obj * mcObj = ClockMCGet(opts, PTR2INT(map->data) /* mcKey */);
+ if (mcObj == NULL) {
+ goto error;
+ }
+ if ( Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK
+ || mcObj == NULL
+ ) {
+ goto error;
+ }
+ s = TclGetString(mcObj);
+ if (FrmResultAllocate(dateFmt, mcObj->length) != TCL_OK) { goto error; };
+ memcpy(dateFmt->output, s, mcObj->length + 1);
+ dateFmt->output += mcObj->length;
+ }
+ }
+ break;
+ case CTOKT_WIDE:
+ if (1) {
+ Tcl_WideInt val = *(Tcl_WideInt *)(((char *)dateFmt) + map->offs);
+ if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { goto error; };
+ if (map->width) {
+ dateFmt->output = _witoaw(dateFmt->output, val, *map->tostr, map->width);
+ } else {
+ dateFmt->output += sprintf(dateFmt->output, map->tostr, val);
+ }
+ }
+ break;
+ case CTOKT_CHAR:
+ if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { goto error; };
+ *dateFmt->output++ = *map->tostr;
+ break;
+ case CFMTT_PROC:
+ if (map->fmtproc(opts, dateFmt, tok, NULL) != TCL_OK) {
+ goto error;
+ };
+ break;
+ case CTOKT_WORD:
+ if (1) {
+ int len = tok->tokWord.end - tok->tokWord.start;
+ if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; };
+ if (len == 1) {
+ *dateFmt->output++ = *tok->tokWord.start;
+ } else {
+ memcpy(dateFmt->output, tok->tokWord.start, len);
+ dateFmt->output += len;
+ }
+ }
+ break;
+ }
+ }
+
+ goto done;
+
+error:
+
+ if (dateFmt->resMem != resMem) {
+ ckfree(dateFmt->resMem);
+ }
+ dateFmt->resMem = NULL;
+
+done:
+
+ if (dateFmt->resMem) {
+ size_t size;
+ Tcl_Obj * result = Tcl_NewObj();
+ result->length = dateFmt->output - dateFmt->resMem;
+ size = result->length+1;
+ if (dateFmt->resMem == resMem) {
+ result->bytes = ckalloc(size);
+ if (result->bytes == NULL) {
+ return TCL_ERROR;
+ }
+ memcpy(result->bytes, dateFmt->resMem, size);
+ } else if ((dateFmt->resEnd - dateFmt->resMem) / size > MAX_FMT_RESULT_THRESHOLD) {
+ result->bytes = ckrealloc(dateFmt->resMem, size);
+ if (result->bytes == NULL) {
+ result->bytes = dateFmt->resMem;
+ }
+ } else {
+ result->bytes = dateFmt->resMem;
+ }
+ /* save last used buffer length */
+ if ( dateFmt->resMem != resMem
+ && fss->fmtMinAlloc < size + MIN_FMT_RESULT_BLOCK_DELTA
+ ) {
+ fss->fmtMinAlloc = size + MIN_FMT_RESULT_BLOCK_DELTA;
+ }
+ result->bytes[result->length] = '\0';
+ Tcl_SetObjResult(opts->interp, result);
+ return TCL_OK;
+ }
+
+ return TCL_ERROR;
+}
+
+
+void
+ClockFrmScnClearCaches(void)
+{
+ Tcl_MutexLock(&ClockFmtMutex);
+ /* clear caches ... */
+ Tcl_MutexUnlock(&ClockFmtMutex);
+}
+
+static void
+ClockFrmScnFinalize(
+ ClientData clientData) /* Not used. */
+{
+ Tcl_MutexLock(&ClockFmtMutex);
+#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
+ /* clear GC */
+ ClockFmtScnStorage_GC.stackPtr = NULL;
+ ClockFmtScnStorage_GC.stackBound = NULL;
+ ClockFmtScnStorage_GC.count = 0;
+#endif
+ if (initialized) {
+ Tcl_DeleteHashTable(&FmtScnHashTable);
+ initialized = 0;
+ }
+ Tcl_MutexUnlock(&ClockFmtMutex);
+ Tcl_MutexFinalize(&ClockFmtMutex);
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 602bd40..9c5b76a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -17,6 +17,7 @@
*/
#include "tclInt.h"
+#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
@@ -4265,6 +4266,351 @@ Tcl_TimeObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_TimeRateObjCmd --
+ *
+ * This object-based procedure is invoked to process the "timerate" Tcl
+ * command.
+ * This is similar to command "time", except the execution limited by
+ * given time (in milliseconds) instead of repetition count.
+ *
+ * Example:
+ * timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]`
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TimeRateObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static double measureOverhead = 0; /* global measure-overhead */
+ double overhead = -1; /* given measure-overhead */
+ register Tcl_Obj *objPtr;
+ register int result, i;
+ Tcl_Obj *calibrate = NULL, *direct = NULL;
+ Tcl_WideInt count = 0; /* Holds repetition count */
+ Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL;
+ /* Maximal running time (in milliseconds) */
+ Tcl_WideInt threshold = 1; /* Current threshold for check time (faster
+ * repeat count without time check) */
+ Tcl_WideInt maxIterTm = 1; /* Max time of some iteration as max threshold
+ * additionally avoid divide to zero (never < 1) */
+ register Tcl_WideInt start, middle, stop;
+#ifndef TCL_WIDE_CLICKS
+ Tcl_Time now;
+#endif
+
+ static const char *const options[] = {
+ "-direct", "-overhead", "-calibrate", "--", NULL
+ };
+ enum options {
+ TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
+ };
+
+ NRE_callback *rootPtr;
+ ByteCode *codePtr = NULL;
+
+ for (i = 1; i < objc - 1; i++) {
+ int index;
+ if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
+ &index) != TCL_OK) {
+ break;
+ }
+ if (index == TMRT_LAST) {
+ i++;
+ break;
+ }
+ switch (index) {
+ case TMRT_EV_DIRECT:
+ direct = objv[i];
+ break;
+ case TMRT_OVERHEAD:
+ if (++i >= objc - 1) {
+ goto usage;
+ }
+ if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TMRT_CALIBRATE:
+ calibrate = objv[i];
+ break;
+ }
+ }
+
+ if (i >= objc || i < objc-2) {
+usage:
+ Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?");
+ return TCL_ERROR;
+ }
+ objPtr = objv[i++];
+ if (i < objc) {
+ result = TclGetWideIntFromObj(interp, objv[i], &maxms);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /* if calibrate */
+ if (calibrate) {
+
+ /* if no time specified for the calibration */
+ if (maxms == -0x7FFFFFFFFFFFFFFFL) {
+ Tcl_Obj *clobjv[6];
+ Tcl_WideInt maxCalTime = 5000;
+ double lastMeasureOverhead = measureOverhead;
+
+ clobjv[0] = objv[0];
+ i = 1;
+ if (direct) {
+ clobjv[i++] = direct;
+ }
+ clobjv[i++] = objPtr;
+
+ /* reset last measurement overhead */
+ measureOverhead = (double)0;
+
+ /* self-call with 100 milliseconds to warm-up,
+ * before entering the calibration cycle */
+ TclNewLongObj(clobjv[i], 100);
+ Tcl_IncrRefCount(clobjv[i]);
+ result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
+ Tcl_DecrRefCount(clobjv[i]);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ i--;
+ clobjv[i++] = calibrate;
+ clobjv[i++] = objPtr;
+
+ /* set last measurement overhead to max */
+ measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
+
+ /* calibration cycle until it'll be preciser */
+ maxms = -1000;
+ do {
+ lastMeasureOverhead = measureOverhead;
+ TclNewLongObj(clobjv[i], (int)maxms);
+ Tcl_IncrRefCount(clobjv[i]);
+ result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
+ Tcl_DecrRefCount(clobjv[i]);
+ if (result != TCL_OK) {
+ return result;
+ }
+ maxCalTime += maxms;
+ /* increase maxms for preciser calibration */
+ maxms -= (-maxms / 4);
+ /* as long as new value more as 0.05% better */
+ } while ( (measureOverhead >= lastMeasureOverhead
+ || measureOverhead / lastMeasureOverhead <= 0.9995)
+ && maxCalTime > 0
+ );
+
+ return result;
+ }
+ if (maxms == 0) {
+ /* reset last measurement overhead */
+ measureOverhead = 0;
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+ return TCL_OK;
+ }
+
+ /* if time is negative - make current overhead more precise */
+ if (maxms > 0) {
+ /* set last measurement overhead to max */
+ measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
+ } else {
+ maxms = -maxms;
+ }
+
+ }
+
+ if (maxms == -0x7FFFFFFFFFFFFFFFL) {
+ maxms = 1000;
+ }
+ if (overhead == -1) {
+ overhead = measureOverhead;
+ }
+
+ /* be sure that resetting of result will not smudge the further measurement */
+ Tcl_ResetResult(interp);
+
+ /* compile object */
+ if (!direct) {
+ if (TclInterpReady(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ codePtr = TclCompileObj(interp, objPtr, NULL, 0);
+ codePtr->refCount++;
+ }
+
+ /* get start and stop time */
+#ifdef TCL_WIDE_CLICKS
+ start = middle = TclpGetWideClicks();
+ /* time to stop execution (in wide clicks) */
+ stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
+#else
+ Tcl_GetTime(&now);
+ start = now.sec; start *= 1000000; start += now.usec;
+ middle = start;
+ /* time to stop execution (in microsecs) */
+ stop = start + maxms * 1000;
+#endif
+
+ /* start measurement */
+ while (1) {
+ /* eval single iteration */
+ count++;
+
+ if (!direct) {
+ /* precompiled */
+ rootPtr = TOP_CB(interp);
+ result = TclNRExecuteByteCode(interp, codePtr);
+ result = TclNRRunCallbacks(interp, result, rootPtr);
+ } else {
+ /* eval */
+ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+
+ /* don't check time up to threshold */
+ if (--threshold > 0) continue;
+
+ /* check stop time reached, estimate new threshold */
+ #ifdef TCL_WIDE_CLICKS
+ middle = TclpGetWideClicks();
+ #else
+ Tcl_GetTime(&now);
+ middle = now.sec; middle *= 1000000; middle += now.usec;
+ #endif
+ if (middle >= stop) {
+ break;
+ }
+
+ /* don't calculate threshold by few iterations, because sometimes
+ * first iteration(s) can be too fast (cached, delayed clean up, etc) */
+ if (count < 10) {
+ threshold = 1; continue;
+ }
+
+ /* average iteration time in microsecs */
+ threshold = (middle - start) / count;
+ if (threshold > maxIterTm) {
+ maxIterTm = threshold;
+ }
+ /* as relation between remaining time and time since last check */
+ threshold = ((stop - middle) / maxIterTm) / 4;
+ if (threshold > 100000) { /* fix for too large threshold */
+ threshold = 100000;
+ }
+ }
+
+ {
+ Tcl_Obj *objarr[8], **objs = objarr;
+ Tcl_WideInt val;
+ const char *fmt;
+
+ middle -= start; /* execution time in microsecs */
+
+ #ifdef TCL_WIDE_CLICKS
+ /* convert execution time in wide clicks to microsecs */
+ middle *= TclpWideClickInMicrosec();
+ #endif
+
+ /* if not calibrate */
+ if (!calibrate) {
+ /* minimize influence of measurement overhead */
+ if (overhead > 0) {
+ /* estimate the time of overhead (microsecs) */
+ Tcl_WideInt curOverhead = overhead * count;
+ if (middle > curOverhead) {
+ middle -= curOverhead;
+ } else {
+ middle = 1;
+ }
+ }
+ } else {
+ /* calibration - obtaining new measurement overhead */
+ if (measureOverhead > (double)middle / count) {
+ measureOverhead = (double)middle / count;
+ }
+ objs[0] = Tcl_NewDoubleObj(measureOverhead);
+ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
+ objs += 2;
+ }
+
+ val = middle / count; /* microsecs per iteration */
+ if (val >= 1000000) {
+ objs[0] = Tcl_NewWideIntObj(val);
+ } else {
+ if (val < 10) { fmt = "%.6f"; } else
+ if (val < 100) { fmt = "%.4f"; } else
+ if (val < 1000) { fmt = "%.3f"; } else
+ if (val < 10000) { fmt = "%.2f"; } else
+ { fmt = "%.1f"; };
+ objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
+ }
+
+ objs[2] = Tcl_NewWideIntObj(count); /* iterations */
+
+ /* calculate speed as rate (count) per sec */
+ if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
+ if (count < (0x7FFFFFFFFFFFFFFFL / 1000000)) {
+ val = (count * 1000000) / middle;
+ if (val < 100000) {
+ if (val < 100) { fmt = "%.3f"; } else
+ if (val < 1000) { fmt = "%.2f"; } else
+ { fmt = "%.1f"; };
+ objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
+ } else {
+ objs[4] = Tcl_NewWideIntObj(val);
+ }
+ } else {
+ objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
+ }
+
+ /* estimated net execution time (in millisecs) */
+ if (!calibrate) {
+ objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
+ TclNewLiteralStringObj(objs[7], "nett-ms");
+ }
+
+ /*
+ * Construct the result as a list because many programs have always parsed
+ * as such (extracting the first element, typically).
+ */
+
+ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
+ TclNewLiteralStringObj(objs[3], "#");
+ TclNewLiteralStringObj(objs[5], "#/sec");
+ Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
+ }
+
+done:
+
+ if ((codePtr != NULL) && (codePtr->refCount-- <= 1)) {
+ /* Just dropped to refcount==0. Clean up. */
+ TclCleanupByteCode(codePtr);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_TryObjCmd, TclNRTryObjCmd --
*
* This procedure is invoked to process the "try" Tcl command. See the
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 717a1b3..165f911 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,14 +1,13 @@
-/* A Bison parser, made by GNU Bison 2.3. */
+/* A Bison parser, made by GNU Bison 3.1. */
-/* Skeleton implementation for Bison's Yacc-like parsers in C
+/* Bison implementation for Yacc-like parsers in C
- Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
- Free Software Foundation, Inc.
+ Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc.
- This program is free software; you can redistribute it and/or modify
+ 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
@@ -16,9 +15,7 @@
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
@@ -47,7 +44,7 @@
#define YYBISON 1
/* Bison version. */
-#define YYBISON_VERSION "2.3"
+#define YYBISON_VERSION "3.1"
/* Skeleton name. */
#define YYSKELETON_NAME "yacc.c"
@@ -55,64 +52,19 @@
/* Pure parsers. */
#define YYPURE 1
-/* Using locations. */
-#define YYLSP_NEEDED 1
+/* Push parsers. */
+#define YYPUSH 0
-/* 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
+/* Pull parsers. */
+#define YYPULL 1
+/* Substitute the variable and function names. */
+#define yyparse TclDateparse
+#define yylex TclDatelex
+#define yyerror TclDateerror
+#define yydebug TclDatedebug
+#define yynerrs TclDatenerrs
/* Copy the first part of user declarations. */
@@ -129,6 +81,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"
@@ -141,78 +94,20 @@
#pragma warning( disable : 4102 )
#endif /* _MSC_VER */
+#if 0
+#define YYDEBUG 1
+#endif
+
/*
* yyparse will accept a 'struct DateInfo' as its parameter; that's where the
* 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)))
-#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
@@ -246,20 +141,16 @@ typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
-/*
- * Meridian: am, pm, or 24-hour style.
- */
-typedef enum _MERIDIAN {
- MERam, MERpm, MER24
-} MERIDIAN;
-
-/* Enabling traces. */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
+# ifndef YY_NULLPTR
+# if defined __cplusplus && 201103L <= __cplusplus
+# define YY_NULLPTR nullptr
+# else
+# define YY_NULLPTR 0
+# endif
+# endif
/* Enabling verbose error messages. */
#ifdef YYERROR_VERBOSE
@@ -269,40 +160,80 @@ typedef enum _MERIDIAN {
# define YYERROR_VERBOSE 0
#endif
-/* Enabling the token table. */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
+
+/* Debug traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+#if YYDEBUG
+extern int TclDatedebug;
#endif
+/* Token type. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ enum yytokentype
+ {
+ tAGO = 258,
+ tDAY = 259,
+ tDAYZONE = 260,
+ tID = 261,
+ tMERIDIAN = 262,
+ tMONTH = 263,
+ tMONTH_UNIT = 264,
+ tSTARDATE = 265,
+ tSEC_UNIT = 266,
+ tUNUMBER = 267,
+ tZONE = 268,
+ tZONEwO4 = 269,
+ tZONEwO2 = 270,
+ tEPOCH = 271,
+ tDST = 272,
+ tISOBASE = 273,
+ tDAY_UNIT = 274,
+ tNEXT = 275,
+ SP = 276
+ };
+#endif
+
+/* Value type. */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
-typedef union YYSTYPE
+union YYSTYPE
{
+
+
time_t Number;
enum _MERIDIAN Meridian;
-}
-/* Line 187 of yacc.c. */
- YYSTYPE;
-# define yystype YYSTYPE /* obsolescent; will be withdrawn */
-# define YYSTYPE_IS_DECLARED 1
+
+};
+
+typedef union YYSTYPE YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
+# define YYSTYPE_IS_DECLARED 1
#endif
+/* Location type. */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
-typedef struct YYLTYPE
+typedef struct YYLTYPE YYLTYPE;
+struct YYLTYPE
{
int first_line;
int first_column;
int last_line;
int last_column;
-} YYLTYPE;
-# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
+};
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif
+
+int TclDateparse (DateInfo* info);
+
+
+
/* Copy the second part of user declarations. */
@@ -316,14 +247,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
@@ -337,72 +264,103 @@ typedef unsigned char yytype_uint8;
#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;
-#elif (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-typedef signed char yytype_int8;
#else
-typedef short int yytype_int8;
+typedef signed char yytype_int8;
#endif
#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
-typedef unsigned short int yytype_uint16;
+typedef unsigned short yytype_uint16;
#endif
#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
-typedef short int yytype_int16;
+typedef short yytype_int16;
#endif
#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
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
# define YYSIZE_T size_t
+# else
+# define YYSIZE_T unsigned
# 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)
+# define YY_(Msgid) dgettext ("bison-runtime", Msgid)
# endif
# endif
# ifndef YY_
-# define YY_(msgid) msgid
+# define YY_(Msgid) Msgid
+# endif
+#endif
+
+#ifndef YY_ATTRIBUTE
+# if (defined __GNUC__ \
+ && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \
+ || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C
+# define YY_ATTRIBUTE(Spec) __attribute__(Spec)
+# else
+# define YY_ATTRIBUTE(Spec) /* empty */
+# endif
+#endif
+
+#ifndef YY_ATTRIBUTE_PURE
+# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__))
+#endif
+
+#ifndef YY_ATTRIBUTE_UNUSED
+# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__))
+#endif
+
+#if !defined _Noreturn \
+ && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112)
+# if defined _MSC_VER && 1200 <= _MSC_VER
+# define _Noreturn __declspec (noreturn)
+# else
+# define _Noreturn YY_ATTRIBUTE ((__noreturn__))
# endif
#endif
/* Suppress unused-variable warnings by "using" E. */
#if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
+# define YYUSE(E) ((void) (E))
#else
-# define YYUSE(e) /* empty */
+# define YYUSE(E) /* empty */
#endif
-/* Identity function, used to suppress warnings about constant conditions. */
-#ifndef lint
-# define YYID(n) (n)
+#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__
+/* Suppress an incorrect diagnostic about yylval being uninitialized. */
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\
+ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END \
+ _Pragma ("GCC diagnostic pop")
#else
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-static int
-YYID (int i)
-#else
-static int
-YYID (i)
- int i;
+# define YY_INITIAL_VALUE(Value) Value
#endif
-{
- return i;
-}
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
+#endif
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
#endif
+
#if ! defined yyoverflow || YYERROR_VERBOSE
/* The parser invokes alloca or malloc; define the necessary symbols. */
@@ -420,11 +378,11 @@ YYID (i)
# define alloca _alloca
# else
# define YYSTACK_ALLOC alloca
-# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS
# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-# ifndef _STDLIB_H
-# define _STDLIB_H 1
+ /* Use EXIT_SUCCESS as a witness for stdlib.h. */
+# ifndef EXIT_SUCCESS
+# define EXIT_SUCCESS 0
# endif
# endif
# endif
@@ -432,8 +390,8 @@ YYID (i)
# endif
# ifdef YYSTACK_ALLOC
- /* Pacify GCC's `empty if-body' warning. */
-# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+ /* Pacify GCC's 'empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
# ifndef YYSTACK_ALLOC_MAXIMUM
/* The OS might guarantee only one guard page at the bottom of the stack,
and a page size can be as small as 4096 bytes. So we cannot safely
@@ -447,25 +405,23 @@ YYID (i)
# ifndef YYSTACK_ALLOC_MAXIMUM
# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
# endif
-# if (defined __cplusplus && ! defined _STDLIB_H \
+# if (defined __cplusplus && ! defined EXIT_SUCCESS \
&& ! ((defined YYMALLOC || defined malloc) \
- && (defined YYFREE || defined free)))
+ && (defined YYFREE || defined free)))
# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-# ifndef _STDLIB_H
-# define _STDLIB_H 1
+# ifndef EXIT_SUCCESS
+# define EXIT_SUCCESS 0
# endif
# endif
# ifndef YYMALLOC
# define YYMALLOC malloc
-# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined malloc && ! defined EXIT_SUCCESS
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
# endif
# endif
# ifndef YYFREE
# define YYFREE free
-# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined free && ! defined EXIT_SUCCESS
void free (void *); /* INFRINGES ON USER NAME SPACE */
# endif
# endif
@@ -475,15 +431,15 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */
#if (! defined yyoverflow \
&& (! defined __cplusplus \
- || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
- && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
+ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
/* 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. */
@@ -495,72 +451,78 @@ union yyalloc
((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
+ 2 * YYSTACK_GAP_MAXIMUM)
-/* Copy COUNT objects from FROM to TO. The source and destination do
- not overlap. */
-# ifndef YYCOPY
-# if defined __GNUC__ && 1 < __GNUC__
-# define YYCOPY(To, From, Count) \
- __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-# else
-# define YYCOPY(To, From, Count) \
- do \
- { \
- YYSIZE_T yyi; \
- for (yyi = 0; yyi < (Count); yyi++) \
- (To)[yyi] = (From)[yyi]; \
- } \
- while (YYID (0))
-# endif
-# endif
+# define YYCOPY_NEEDED 1
/* Relocate STACK from its old location to the new one. The
local variables YYSIZE and YYSTACKSIZE give the old and new number of
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) \
- do \
- { \
- YYSIZE_T yynewbytes; \
- YYCOPY (&yyptr->Stack, Stack, yysize); \
- Stack = &yyptr->Stack; \
- yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
- yyptr += yynewbytes / sizeof (*yyptr); \
- } \
- while (YYID (0))
+# define YYSTACK_RELOCATE(Stack_alloc, Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \
+ Stack = &yyptr->Stack_alloc; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
#endif
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if defined __GNUC__ && 1 < __GNUC__
+# define YYCOPY(Dst, Src, Count) \
+ __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+# else
+# define YYCOPY(Dst, Src, Count) \
+ do \
+ { \
+ YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (Dst)[yyi] = (Src)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
/* YYFINAL -- State number of the termination state. */
#define YYFINAL 2
/* YYLAST -- Last index in YYTABLE. */
-#define YYLAST 79
+#define YYLAST 116
/* YYNTOKENS -- Number of terminals. */
-#define YYNTOKENS 26
+#define YYNTOKENS 28
/* YYNNTS -- Number of nonterminals. */
-#define YYNNTS 16
+#define YYNNTS 18
/* YYNRULES -- Number of rules. */
-#define YYNRULES 56
-/* YYNRULES -- Number of states. */
-#define YYNSTATES 83
+#define YYNRULES 66
+/* YYNSTATES -- Number of states. */
+#define YYNSTATES 106
-/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
+ by yylex, with out-of-bounds checking. */
#define YYUNDEFTOK 2
-#define YYMAXUTOK 274
+#define YYMAXUTOK 276
-#define YYTRANSLATE(YYX) \
- ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+#define YYTRANSLATE(YYX) \
+ ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
-/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
+ as returned by yylex, without out-of-bounds checking. */
static const yytype_uint8 yytranslate[] =
{
0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 25, 22, 21, 24, 23, 2, 2,
- 2, 2, 2, 2, 2, 2, 2, 2, 20, 2,
+ 2, 2, 2, 27, 23, 25, 26, 24, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 22, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
@@ -582,345 +544,335 @@ static const yytype_uint8 yytranslate[] =
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
- 15, 16, 17, 18, 19
+ 15, 16, 17, 18, 19, 20, 21
};
#if YYDEBUG
-/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
- YYRHS. */
-static const yytype_uint8 yyprhs[] =
-{
- 0, 0, 3, 4, 7, 9, 11, 13, 15, 17,
- 19, 21, 23, 25, 28, 33, 39, 46, 54, 57,
- 59, 61, 63, 66, 69, 73, 76, 80, 86, 88,
- 94, 100, 103, 108, 111, 113, 117, 120, 124, 128,
- 136, 139, 144, 147, 149, 153, 156, 159, 163, 165,
- 167, 169, 171, 173, 175, 177, 178
-};
-
-/* YYRHS -- A `-1'-separated list of the rules' RHS. */
-static const yytype_int8 yyrhs[] =
-{
- 27, 0, -1, -1, 27, 28, -1, 29, -1, 30,
- -1, 32, -1, 33, -1, 31, -1, 36, -1, 34,
- -1, 35, -1, 40, -1, 13, 7, -1, 13, 20,
- 13, 41, -1, 13, 20, 13, 21, 13, -1, 13,
- 20, 13, 20, 13, 41, -1, 13, 20, 13, 20,
- 13, 21, 13, -1, 14, 16, -1, 14, -1, 5,
- -1, 4, -1, 4, 22, -1, 13, 4, -1, 38,
- 13, 4, -1, 19, 4, -1, 13, 23, 13, -1,
- 13, 23, 13, 23, 13, -1, 17, -1, 13, 21,
- 8, 21, 13, -1, 13, 21, 13, 21, 13, -1,
- 8, 13, -1, 8, 13, 22, 13, -1, 13, 8,
- -1, 15, -1, 13, 8, 13, -1, 19, 8, -1,
- 19, 13, 8, -1, 17, 14, 17, -1, 17, 14,
- 13, 20, 13, 20, 13, -1, 17, 17, -1, 10,
- 13, 24, 13, -1, 37, 3, -1, 37, -1, 38,
- 13, 39, -1, 13, 39, -1, 19, 39, -1, 19,
- 13, 39, -1, 39, -1, 21, -1, 25, -1, 11,
- -1, 18, -1, 9, -1, 13, -1, -1, 7, -1
-};
-
-/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+ /* 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, 160, 160, 161, 162, 165, 168, 171, 174, 177,
+ 180, 183, 187, 192, 195, 201, 207, 215, 219, 223,
+ 227, 231, 235, 241, 242, 245, 250, 255, 260, 265,
+ 270, 277, 281, 286, 291, 296, 301, 305, 310, 314,
+ 319, 326, 330, 336, 345, 353, 361, 370, 380, 394,
+ 399, 402, 405, 408, 411, 414, 417, 422, 425, 430,
+ 434, 438, 444, 447, 452, 470, 473
};
#endif
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+#if YYDEBUG || YYERROR_VERBOSE || 0
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
First, the terminals, then, starting at YYNTOKENS, nonterminals. */
static const char *const yytname[] =
{
"$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
"tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
- "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
- "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
- "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
- "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
- "o_merid", 0
+ "tUNUMBER", "tZONE", "tZONEwO4", "tZONEwO2", "tEPOCH", "tDST",
+ "tISOBASE", "tDAY_UNIT", "tNEXT", "SP", "':'", "','", "'/'", "'-'",
+ "'.'", "'+'", "$accept", "spec", "item", "time", "zone", "comma", "day",
+ "date", "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit",
+ "INTNUM", "number", "o_merid", YY_NULLPTR
};
#endif
# ifdef YYPRINT
-/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
- token YYLEX-NUM. */
+/* YYTOKNUM[NUM] -- (External) token number corresponding to the
+ (internal) symbol number NUM (which must be that of a token). */
static const yytype_uint16 yytoknum[] =
{
0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
- 58, 45, 44, 47, 46, 43
+ 275, 276, 58, 44, 47, 45, 46, 43
};
# endif
-/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
-static const yytype_uint8 yyr1[] =
+#define YYPACT_NINF -17
+
+#define yypact_value_is_default(Yystate) \
+ (!!((Yystate) == (-17)))
+
+#define YYTABLE_NINF -1
+
+#define yytable_value_is_error(Yytable_value) \
+ 0
+
+ /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
+static const yytype_int8 yypact[] =
{
- 0, 26, 27, 27, 28, 28, 28, 28, 28, 28,
- 28, 28, 28, 29, 29, 29, 29, 29, 30, 30,
- 30, 31, 31, 31, 31, 31, 32, 32, 32, 32,
- 32, 32, 32, 32, 32, 32, 33, 33, 34, 34,
- 34, 35, 36, 36, 37, 37, 37, 37, 37, 38,
- 38, 39, 39, 39, 40, 41, 41
+ -17, 48, -17, -9, -17, 34, -17, 19, -17, -2,
+ 30, -10, -10, -17, 8, -17, 0, 72, -17, -17,
+ -17, -17, -17, -17, -17, -17, -17, -17, -17, 52,
+ 18, -17, 16, -17, 49, -17, -9, -17, -17, 25,
+ -17, -17, 59, 60, 62, -5, -17, 19, 19, 20,
+ -17, 31, -17, -17, 70, -17, 16, -17, -17, 75,
+ 32, 16, -17, -17, 77, 81, -17, 6, 71, 69,
+ 73, -17, -17, 74, -17, 78, -17, -17, -17, -17,
+ 97, 16, -17, -17, -17, -17, 90, -17, 91, 92,
+ 93, 94, 95, -17, -17, 101, -17, -17, -17, 87,
+ 88, -17, 99, 100, -17, -17
};
-/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
-static const yytype_uint8 yyr2[] =
+ /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
+ Performed when YYTABLE does not specify something else to do. Zero
+ means the default is an error. */
+static const yytype_uint8 yydefact[] =
{
- 0, 2, 0, 2, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 2, 4, 5, 6, 7, 2, 1,
- 1, 1, 2, 2, 3, 2, 3, 5, 1, 5,
- 5, 2, 4, 2, 1, 3, 2, 3, 3, 7,
- 2, 4, 2, 1, 3, 2, 2, 3, 1, 1,
- 1, 1, 1, 1, 1, 0, 1
+ 2, 0, 1, 25, 19, 0, 61, 0, 59, 62,
+ 18, 0, 0, 39, 33, 60, 0, 0, 57, 58,
+ 3, 5, 6, 9, 7, 8, 11, 12, 10, 50,
+ 0, 56, 64, 13, 23, 26, 36, 62, 63, 0,
+ 27, 14, 38, 0, 0, 0, 17, 0, 0, 0,
+ 44, 0, 30, 41, 62, 54, 0, 4, 49, 62,
+ 0, 22, 53, 24, 0, 0, 40, 65, 31, 0,
+ 0, 20, 21, 0, 43, 0, 47, 42, 55, 29,
+ 62, 0, 52, 37, 48, 66, 0, 15, 0, 0,
+ 0, 0, 0, 28, 51, 65, 32, 34, 35, 0,
+ 0, 16, 0, 0, 46, 45
};
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
- STATE-NUM when YYTABLE doesn't specify something else to do. Zero
- means the default is an error. */
-static const yytype_uint8 yydefact[] =
+ /* YYPGOTO[NTERM-NUM]. */
+static const yytype_int8 yypgoto[] =
{
- 2, 0, 1, 21, 20, 0, 53, 0, 51, 54,
- 19, 34, 28, 52, 0, 49, 50, 3, 4, 5,
- 8, 6, 7, 10, 11, 9, 43, 0, 48, 12,
- 22, 31, 0, 23, 13, 33, 0, 0, 0, 45,
- 18, 0, 40, 25, 36, 0, 46, 42, 0, 0,
- 0, 35, 55, 0, 0, 26, 0, 38, 37, 47,
- 24, 44, 32, 41, 56, 0, 0, 14, 0, 0,
- 0, 0, 55, 15, 29, 30, 27, 0, 0, 16,
- 0, 17, 39
+ -17, -17, 96, -17, -17, 79, -17, -17, -17, -17,
+ -17, -17, -17, 22, -16, -6, -17, 21
};
-/* YYDEFGOTO[NTERM-NUM]. */
+ /* YYDEFGOTO[NTERM-NUM]. */
static const yytype_int8 yydefgoto[] =
{
- -1, 1, 17, 18, 19, 20, 21, 22, 23, 24,
- 25, 26, 27, 28, 29, 67
+ -1, 1, 20, 21, 22, 35, 23, 24, 25, 26,
+ 27, 28, 29, 30, 31, 32, 33, 87
};
-/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
- STATE-NUM. */
-#define YYPACT_NINF -22
-static const yytype_int8 yypact[] =
+ /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule whose
+ number is the opposite. If YYTABLE_NINF, syntax error. */
+static const yytype_uint8 yytable[] =
{
- -22, 2, -22, -21, -22, -4, -22, 1, -22, 22,
- 18, -22, 8, -22, 40, -22, -22, -22, -22, -22,
- -22, -22, -22, -22, -22, -22, 32, 28, -22, -22,
- -22, 24, 26, -22, -22, 42, 47, -5, 49, -22,
- -22, 15, -22, -22, -22, 48, -22, -22, 43, 50,
- 51, -22, 17, 44, 46, 45, 52, -22, -22, -22,
- -22, -22, -22, -22, -22, 56, 57, -22, 58, 60,
- 61, 62, -3, -22, -22, -22, -22, 59, 63, -22,
- 64, -22, -22
+ 55, 39, 40, 69, 52, 41, 42, 70, 53, 6,
+ 56, 8, 54, 85, 34, 18, 62, 19, 38, 15,
+ 43, 49, 44, 45, 61, 6, 50, 8, 86, 51,
+ 59, 37, 73, 47, 48, 15, 38, 38, 74, 60,
+ 78, 71, 72, 75, 80, 82, 36, 46, 2, 76,
+ 38, 65, 3, 4, 81, 58, 5, 6, 7, 8,
+ 9, 10, 11, 12, 13, 94, 14, 15, 16, 17,
+ 63, 66, 67, 18, 68, 19, 3, 4, 77, 79,
+ 5, 6, 7, 8, 9, 10, 11, 12, 13, 83,
+ 14, 15, 16, 84, 89, 88, 91, 18, 90, 19,
+ 92, 93, 95, 96, 97, 98, 99, 100, 85, 102,
+ 103, 104, 105, 57, 0, 64, 101
};
-/* YYPGOTO[NTERM-NUM]. */
-static const yytype_int8 yypgoto[] =
+static const yytype_int8 yycheck[] =
{
- -22, -22, -22, -22, -22, -22, -22, -22, -22, -22,
- -22, -22, -22, -9, -22, 6
+ 16, 7, 4, 8, 4, 7, 8, 12, 8, 9,
+ 16, 11, 12, 7, 23, 25, 32, 27, 18, 19,
+ 22, 13, 24, 25, 30, 9, 18, 11, 22, 21,
+ 12, 12, 12, 11, 12, 19, 18, 18, 18, 21,
+ 56, 47, 48, 12, 12, 61, 12, 17, 0, 18,
+ 18, 26, 4, 5, 60, 3, 8, 9, 10, 11,
+ 12, 13, 14, 15, 16, 81, 18, 19, 20, 21,
+ 21, 12, 12, 25, 12, 27, 4, 5, 8, 4,
+ 8, 9, 10, 11, 12, 13, 14, 15, 16, 12,
+ 18, 19, 20, 12, 25, 24, 22, 25, 25, 27,
+ 22, 4, 12, 12, 12, 12, 12, 12, 7, 22,
+ 22, 12, 12, 17, -1, 36, 95
};
-/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
- positive, shift that token. If negative, reduce the rule which
- number is the opposite. If zero, do what YYDEFACT says.
- If YYTABLE_NINF, syntax error. */
-#define YYTABLE_NINF -1
-static const yytype_uint8 yytable[] =
+ /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
+static const yytype_uint8 yystos[] =
{
- 39, 30, 2, 53, 64, 46, 3, 4, 54, 31,
- 5, 6, 7, 8, 32, 9, 10, 11, 78, 12,
- 13, 14, 41, 15, 64, 42, 33, 16, 56, 34,
- 35, 6, 57, 8, 40, 47, 59, 65, 66, 61,
- 13, 48, 36, 37, 43, 38, 49, 60, 44, 6,
- 50, 8, 6, 45, 8, 51, 58, 6, 13, 8,
- 52, 13, 55, 62, 63, 68, 13, 69, 70, 72,
- 73, 74, 71, 75, 76, 77, 81, 82, 79, 80
+ 0, 29, 0, 4, 5, 8, 9, 10, 11, 12,
+ 13, 14, 15, 16, 18, 19, 20, 21, 25, 27,
+ 30, 31, 32, 34, 35, 36, 37, 38, 39, 40,
+ 41, 42, 43, 44, 23, 33, 12, 12, 18, 43,
+ 4, 7, 8, 22, 24, 25, 17, 41, 41, 13,
+ 18, 21, 4, 8, 12, 42, 43, 30, 3, 12,
+ 21, 43, 42, 21, 33, 26, 12, 12, 12, 8,
+ 12, 43, 43, 12, 18, 12, 18, 8, 42, 4,
+ 12, 43, 42, 12, 12, 7, 22, 45, 24, 25,
+ 25, 22, 22, 4, 42, 12, 12, 12, 12, 12,
+ 12, 45, 22, 22, 12, 12
};
-static const yytype_uint8 yycheck[] =
+ /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const yytype_uint8 yyr1[] =
{
- 9, 22, 0, 8, 7, 14, 4, 5, 13, 13,
- 8, 9, 10, 11, 13, 13, 14, 15, 21, 17,
- 18, 19, 14, 21, 7, 17, 4, 25, 13, 7,
- 8, 9, 17, 11, 16, 3, 45, 20, 21, 48,
- 18, 13, 20, 21, 4, 23, 22, 4, 8, 9,
- 24, 11, 9, 13, 11, 13, 8, 9, 18, 11,
- 13, 18, 13, 13, 13, 21, 18, 21, 23, 13,
- 13, 13, 20, 13, 13, 13, 13, 13, 72, 20
+ 0, 28, 29, 29, 29, 30, 30, 30, 30, 30,
+ 30, 30, 30, 30, 31, 31, 31, 32, 32, 32,
+ 32, 32, 32, 33, 33, 34, 34, 34, 34, 34,
+ 34, 35, 35, 35, 35, 35, 35, 35, 35, 35,
+ 35, 36, 36, 37, 37, 37, 37, 37, 38, 39,
+ 39, 40, 40, 40, 40, 40, 40, 41, 41, 42,
+ 42, 42, 43, 43, 44, 45, 45
};
-/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
- symbol of state STATE-NUM. */
-static const yytype_uint8 yystos[] =
+ /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */
+static const yytype_uint8 yyr2[] =
{
- 0, 27, 0, 4, 5, 8, 9, 10, 11, 13,
- 14, 15, 17, 18, 19, 21, 25, 28, 29, 30,
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
- 22, 13, 13, 4, 7, 8, 20, 21, 23, 39,
- 16, 14, 17, 4, 8, 13, 39, 3, 13, 22,
- 24, 13, 13, 8, 13, 13, 13, 17, 8, 39,
- 4, 39, 13, 13, 7, 20, 21, 41, 21, 21,
- 23, 20, 13, 13, 13, 13, 13, 13, 21, 41,
- 20, 13, 13
+ 0, 2, 0, 2, 3, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 2, 4, 6, 2, 1, 1,
+ 3, 3, 2, 1, 2, 1, 2, 2, 4, 3,
+ 2, 3, 5, 1, 5, 5, 2, 4, 2, 1,
+ 3, 2, 3, 3, 2, 7, 7, 3, 4, 2,
+ 1, 4, 3, 2, 2, 3, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 0, 1
};
-#define yyerrok (yyerrstatus = 0)
-#define yyclearin (yychar = YYEMPTY)
-#define YYEMPTY (-2)
-#define YYEOF 0
-#define YYACCEPT goto yyacceptlab
-#define YYABORT goto yyabortlab
-#define YYERROR goto yyerrorlab
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrorlab
-/* 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. */
-
-#define YYFAIL goto yyerrlab
#define YYRECOVERING() (!!yyerrstatus)
-#define YYBACKUP(Token, Value) \
-do \
- if (yychar == YYEMPTY && yylen == 1) \
- { \
- yychar = (Token); \
- yylval = (Value); \
- yytoken = YYTRANSLATE (yychar); \
- YYPOPSTACK (1); \
- goto yybackup; \
- } \
- else \
- { \
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ YYPOPSTACK (yylen); \
+ yystate = *yyssp; \
+ goto yybackup; \
+ } \
+ else \
+ { \
yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
- YYERROR; \
- } \
-while (YYID (0))
-
+ YYERROR; \
+ } \
+while (0)
-#define YYTERROR 1
-#define YYERRCODE 256
+/* Error token number */
+#define YYTERROR 1
+#define YYERRCODE 256
/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
If N is 0, then set CURRENT to the empty location which ends
the previous symbol: RHS[0] (always defined). */
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N) \
- do \
- if (YYID (N)) \
- { \
- (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
- (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
- (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
- (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
- } \
- else \
- { \
- (Current).first_line = (Current).last_line = \
- YYRHSLOC (Rhs, 0).last_line; \
- (Current).first_column = (Current).last_column = \
- YYRHSLOC (Rhs, 0).last_column; \
- } \
- while (YYID (0))
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ do \
+ if (N) \
+ { \
+ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
+ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
+ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
+ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
+ } \
+ else \
+ { \
+ (Current).first_line = (Current).last_line = \
+ YYRHSLOC (Rhs, 0).last_line; \
+ (Current).first_column = (Current).last_column = \
+ YYRHSLOC (Rhs, 0).last_column; \
+ } \
+ while (0)
#endif
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
/* YY_LOCATION_PRINT -- Print the location on the stream.
This macro was not mandated originally: define only if we know
we won't break user code: when these are the locations we know. */
#ifndef YY_LOCATION_PRINT
-# if YYLTYPE_IS_TRIVIAL
-# define YY_LOCATION_PRINT(File, Loc) \
- fprintf (File, "%d.%d-%d.%d", \
- (Loc).first_line, (Loc).first_column, \
- (Loc).last_line, (Loc).last_column)
-# else
-# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+/* Print *YYLOCP on YYO. Private, do not rely on its existence. */
-/* YYLEX -- calling `yylex' with the right arguments. */
-
-#ifdef YYLEX_PARAM
-# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
-#else
-# define YYLEX yylex (&yylval, &yylloc, info)
-#endif
+YY_ATTRIBUTE_UNUSED
+static unsigned
+yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
+{
+ unsigned res = 0;
+ int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
+ if (0 <= yylocp->first_line)
+ {
+ res += YYFPRINTF (yyo, "%d", yylocp->first_line);
+ if (0 <= yylocp->first_column)
+ res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
+ }
+ if (0 <= yylocp->last_line)
+ {
+ if (yylocp->first_line < yylocp->last_line)
+ {
+ res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
+ if (0 <= end_col)
+ res += YYFPRINTF (yyo, ".%d", end_col);
+ }
+ else if (0 <= end_col && yylocp->first_column < end_col)
+ res += YYFPRINTF (yyo, "-%d", end_col);
+ }
+ return res;
+ }
-/* Enable debugging if requested. */
-#if YYDEBUG
+# define YY_LOCATION_PRINT(File, Loc) \
+ yy_location_print_ (File, &(Loc))
-# ifndef YYFPRINTF
-# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
-# define YYFPRINTF fprintf
+# else
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
+#endif
-# define YYDPRINTF(Args) \
-do { \
- if (yydebug) \
- YYFPRINTF Args; \
-} while (YYID (0))
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
-do { \
- if (yydebug) \
- { \
- YYFPRINTF (stderr, "%s ", Title); \
- yy_symbol_print (stderr, \
- Type, Value, Location, info); \
- YYFPRINTF (stderr, "\n"); \
- } \
-} while (YYID (0))
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yy_symbol_print (stderr, \
+ Type, Value, Location, info); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
-/*--------------------------------.
-| Print this symbol on YYOUTPUT. |
-`--------------------------------*/
+/*----------------------------------------.
+| Print this symbol's value on YYOUTPUT. |
+`----------------------------------------*/
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
-#else
-static void
-yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
- FILE *yyoutput;
- int yytype;
- YYSTYPE const * const yyvaluep;
- YYLTYPE const * const yylocationp;
- DateInfo* info;
-#endif
{
- if (!yyvaluep)
- return;
+ FILE *yyo = yyoutput;
+ YYUSE (yyo);
YYUSE (yylocationp);
YYUSE (info);
+ if (!yyvaluep)
+ return;
# ifdef YYPRINT
if (yytype < YYNTOKENS)
YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
-# else
- YYUSE (yyoutput);
# endif
- switch (yytype)
- {
- default:
- break;
- }
+ YYUSE (yytype);
}
@@ -928,24 +880,11 @@ yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
| Print this symbol on YYOUTPUT. |
`--------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
-#else
-static void
-yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
- FILE *yyoutput;
- int yytype;
- YYSTYPE const * const yyvaluep;
- YYLTYPE const * const yylocationp;
- DateInfo* info;
-#endif
{
- if (yytype < YYNTOKENS)
- YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
- else
- YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+ YYFPRINTF (yyoutput, "%s %s (",
+ yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);
YY_LOCATION_PRINT (yyoutput, *yylocationp);
YYFPRINTF (yyoutput, ": ");
@@ -958,68 +897,54 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
| TOP (included). |
`------------------------------------------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
-#else
static void
-yy_stack_print (bottom, top)
- yytype_int16 *bottom;
- yytype_int16 *top;
-#endif
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
{
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");
}
-# define YY_STACK_PRINT(Bottom, Top) \
-do { \
- if (yydebug) \
- yy_stack_print ((Bottom), (Top)); \
-} while (YYID (0))
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
/*------------------------------------------------.
| Report that the YYRULE is going to be reduced. |
`------------------------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
-yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
-#else
-static void
-yy_reduce_print (yyvsp, yylsp, yyrule, info)
- YYSTYPE *yyvsp;
- YYLTYPE *yylsp;
- int yyrule;
- DateInfo* info;
-#endif
+yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
{
+ unsigned long yylno = yyrline[yyrule];
int yynrhs = yyr2[yyrule];
int yyi;
- unsigned long int yylno = yyrline[yyrule];
YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
- yyrule - 1, yylno);
+ yyrule - 1, yylno);
/* The symbols being reduced. */
for (yyi = 0; yyi < yynrhs; yyi++)
{
- fprintf (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, " $%d = ", yyi + 1);
+ yy_symbol_print (stderr,
+ yystos[yyssp[yyi + 1 - yynrhs]],
+ &(yyvsp[(yyi + 1) - (yynrhs)])
+ , &(yylsp[(yyi + 1) - (yynrhs)]) , info);
+ YYFPRINTF (stderr, "\n");
}
}
-# define YY_REDUCE_PRINT(Rule) \
-do { \
- if (yydebug) \
- yy_reduce_print (yyvsp, yylsp, Rule, info); \
-} while (YYID (0))
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
+} while (0)
/* Nonzero means print parse trace. It is left uninitialized so that
multiple parsers can coexist. */
@@ -1033,7 +958,7 @@ int yydebug;
/* YYINITDEPTH -- initial size of the parser's stacks. */
-#ifndef YYINITDEPTH
+#ifndef YYINITDEPTH
# define YYINITDEPTH 200
#endif
@@ -1048,7 +973,6 @@ int yydebug;
# define YYMAXDEPTH 10000
#endif
-
#if YYERROR_VERBOSE
@@ -1057,15 +981,8 @@ int yydebug;
# define yystrlen strlen
# else
/* Return the length of YYSTR. */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
yystrlen (const char *yystr)
-#else
-static YYSIZE_T
-yystrlen (yystr)
- const char *yystr;
-#endif
{
YYSIZE_T yylen;
for (yylen = 0; yystr[yylen]; yylen++)
@@ -1081,16 +998,8 @@ yystrlen (yystr)
# else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
YYDEST. */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static char *
yystpcpy (char *yydest, const char *yysrc)
-#else
-static char *
-yystpcpy (yydest, yysrc)
- char *yydest;
- const char *yysrc;
-#endif
{
char *yyd = yydest;
const char *yys = yysrc;
@@ -1120,27 +1029,27 @@ yytnamerr (char *yyres, const char *yystr)
char const *yyp = yystr;
for (;;)
- switch (*++yyp)
- {
- case '\'':
- case ',':
- goto do_not_strip_quotes;
-
- case '\\':
- if (*++yyp != '\\')
- goto do_not_strip_quotes;
- /* Fall through. */
- default:
- if (yyres)
- yyres[yyn] = *yyp;
- yyn++;
- break;
-
- case '"':
- if (yyres)
- yyres[yyn] = '\0';
- return yyn;
- }
+ switch (*++yyp)
+ {
+ case '\'':
+ case ',':
+ goto do_not_strip_quotes;
+
+ case '\\':
+ if (*++yyp != '\\')
+ goto do_not_strip_quotes;
+ /* Fall through. */
+ default:
+ if (yyres)
+ yyres[yyn] = *yyp;
+ yyn++;
+ break;
+
+ case '"':
+ if (yyres)
+ yyres[yyn] = '\0';
+ return yyn;
+ }
do_not_strip_quotes: ;
}
@@ -1151,169 +1060,161 @@ yytnamerr (char *yyres, const char *yystr)
}
# endif
-/* Copy into YYRESULT an error message about the unexpected token
- YYCHAR while in state YYSTATE. Return the number of bytes copied,
- including the terminating null byte. If YYRESULT is null, do not
- copy anything; just return the number of bytes that would be
- copied. As a special case, return 0 if an ordinary "syntax error"
- message will do. Return YYSIZE_MAXIMUM if overflow occurs during
- size calculation. */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+ about the unexpected token YYTOKEN for the state stack whose top is
+ YYSSP.
+
+ Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is
+ not large enough to hold the message. In that case, also set
+ *YYMSG_ALLOC to the required number of bytes. Return 2 if the
+ required number of bytes is too large to store. */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+ yytype_int16 *yyssp, int yytoken)
{
- int yyn = yypact[yystate];
+ YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);
+ YYSIZE_T yysize = yysize0;
+ enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+ /* Internationalized format string. */
+ const char *yyformat = YY_NULLPTR;
+ /* Arguments of yyformat. */
+ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+ /* Number of reported tokens (one for the "unexpected", one per
+ "expected"). */
+ int yycount = 0;
+
+ /* There are many possibilities here to consider:
+ - If this state is a consistent state with a default action, then
+ the only way this function was invoked is if the default action
+ is an error action. In that case, don't check for expected
+ tokens because there are none.
+ - The only way there can be no lookahead present (in yychar) is if
+ this state is a consistent state with a default action. Thus,
+ detecting the absence of a lookahead is sufficient to determine
+ that there is no unexpected or expected token to report. In that
+ case, just report a simple "syntax error".
+ - Don't assume there isn't a lookahead just because this state is a
+ consistent state with a default action. There might have been a
+ previous inconsistent state, consistent state with a non-default
+ action, or user semantic action that manipulated yychar.
+ - Of course, the expected token list depends on states to have
+ correct lookahead information, and it depends on the parser not
+ to perform extra reductions after fetching a lookahead from the
+ scanner and before detecting a syntax error. Thus, state merging
+ (from LALR or IELR) and default reductions corrupt the expected
+ token list. However, the list is correct for canonical LR with
+ one exception: it will still contain any token that will not be
+ accepted due to an error action in a later state.
+ */
+ if (yytoken != YYEMPTY)
+ {
+ int yyn = yypact[*yyssp];
+ yyarg[yycount++] = yytname[yytoken];
+ if (!yypact_value_is_default (yyn))
+ {
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. In other words, skip the first -YYN actions for
+ this state because they are default actions. */
+ int yyxbegin = yyn < 0 ? -yyn : 0;
+ /* Stay within bounds of both yycheck and yytname. */
+ int yychecklim = YYLAST - yyn + 1;
+ int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+ int yyx;
+
+ for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+ && !yytable_value_is_error (yytable[yyx + yyn]))
+ {
+ if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+ {
+ yycount = 1;
+ yysize = yysize0;
+ break;
+ }
+ yyarg[yycount++] = yytname[yyx];
+ {
+ YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);
+ if (! (yysize <= yysize1
+ && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+ return 2;
+ yysize = yysize1;
+ }
+ }
+ }
+ }
- if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
- return 0;
- else
+ switch (yycount)
+ {
+# define YYCASE_(N, S) \
+ case N: \
+ yyformat = S; \
+ break
+ default: /* Avoid compiler warnings. */
+ YYCASE_(0, YY_("syntax error"));
+ YYCASE_(1, YY_("syntax error, unexpected %s"));
+ YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+ YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+ YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+ YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+ }
+
+ {
+ YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+ if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+ return 2;
+ yysize = yysize1;
+ }
+
+ if (*yymsg_alloc < yysize)
{
- int yytype = YYTRANSLATE (yychar);
- YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
- YYSIZE_T yysize = yysize0;
- YYSIZE_T yysize1;
- int yysize_overflow = 0;
- enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
- char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
- int yyx;
-
-# if 0
- /* This is so xgettext sees the translatable formats that are
- constructed on the fly. */
- YY_("syntax error, unexpected %s");
- YY_("syntax error, unexpected %s, expecting %s");
- YY_("syntax error, unexpected %s, expecting %s or %s");
- YY_("syntax error, unexpected %s, expecting %s or %s or %s");
- YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
- char *yyfmt;
- char const *yyf;
- static char const yyunexpected[] = "syntax error, unexpected %s";
- static char const yyexpecting[] = ", expecting %s";
- static char const yyor[] = " or %s";
- char yyformat[sizeof yyunexpected
- + sizeof yyexpecting - 1
- + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
- * (sizeof yyor - 1))];
- char const *yyprefix = yyexpecting;
-
- /* Start YYX at -YYN if negative to avoid negative indexes in
- YYCHECK. */
- int yyxbegin = yyn < 0 ? -yyn : 0;
-
- /* Stay within bounds of both yycheck and yytname. */
- int yychecklim = YYLAST - yyn + 1;
- int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
- int yycount = 1;
-
- yyarg[0] = yytname[yytype];
- yyfmt = yystpcpy (yyformat, yyunexpected);
-
- for (yyx = yyxbegin; yyx < yyxend; ++yyx)
- if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
- {
- if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
- {
- yycount = 1;
- yysize = yysize0;
- yyformat[sizeof yyunexpected - 1] = '\0';
- break;
- }
- yyarg[yycount++] = yytname[yyx];
- yysize1 = yysize + yytnamerr (0, yytname[yyx]);
- yysize_overflow |= (yysize1 < yysize);
- yysize = yysize1;
- yyfmt = yystpcpy (yyfmt, yyprefix);
- yyprefix = yyor;
- }
-
- yyf = YY_(yyformat);
- yysize1 = yysize + yystrlen (yyf);
- yysize_overflow |= (yysize1 < yysize);
- yysize = yysize1;
-
- if (yysize_overflow)
- return YYSIZE_MAXIMUM;
-
- if (yyresult)
- {
- /* Avoid sprintf, as that infringes on the user's name space.
- Don't have undefined behavior even if the translation
- produced a string with the wrong number of "%s"s. */
- char *yyp = yyresult;
- int yyi = 0;
- while ((*yyp = *yyf) != '\0')
- {
- if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
- {
- yyp += yytnamerr (yyp, yyarg[yyi++]);
- yyf += 2;
- }
- else
- {
- yyp++;
- yyf++;
- }
- }
- }
- return yysize;
+ *yymsg_alloc = 2 * yysize;
+ if (! (yysize <= *yymsg_alloc
+ && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+ *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+ return 1;
}
+
+ /* Avoid sprintf, as that infringes on the user's name space.
+ Don't have undefined behavior even if the translation
+ produced a string with the wrong number of "%s"s. */
+ {
+ char *yyp = *yymsg;
+ int yyi = 0;
+ while ((*yyp = *yyformat) != '\0')
+ if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+ {
+ yyp += yytnamerr (yyp, yyarg[yyi++]);
+ yyformat += 2;
+ }
+ else
+ {
+ yyp++;
+ yyformat++;
+ }
+ }
+ return 0;
}
#endif /* YYERROR_VERBOSE */
-
/*-----------------------------------------------.
| Release the memory associated to this symbol. |
`-----------------------------------------------*/
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
-#else
-static void
-yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
- const char *yymsg;
- int yytype;
- YYSTYPE *yyvaluep;
- YYLTYPE *yylocationp;
- DateInfo* info;
-#endif
{
YYUSE (yyvaluep);
YYUSE (yylocationp);
YYUSE (info);
-
if (!yymsg)
yymsg = "Deleting";
YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
- switch (yytype)
- {
-
- default:
- break;
- }
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+ YYUSE (yytype);
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
}
-
-
-/* Prevent warnings from -Wmissing-prototypes. */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (DateInfo* info);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
-
-
@@ -1322,112 +1223,96 @@ int yyparse ();
| yyparse. |
`----------*/
-#ifdef YYPARSE_PARAM
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void *YYPARSE_PARAM)
-#else
-int
-yyparse (YYPARSE_PARAM)
- void *YYPARSE_PARAM;
-#endif
-#else /* ! YYPARSE_PARAM */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
int
yyparse (DateInfo* info)
-#else
-int
-yyparse (info)
- DateInfo* info;
-#endif
-#endif
{
- /* The look-ahead symbol. */
+/* The lookahead symbol. */
int yychar;
-/* The semantic value of the look-ahead symbol. */
-YYSTYPE yylval = {0};
-/* Number of syntax errors so far. */
-int yynerrs;
-/* Location data for the look-ahead symbol. */
-YYLTYPE yylloc;
+/* The semantic value of the lookahead symbol. */
+/* Default value used for initialization, for pacifying older GCCs
+ or non-GCC compilers. */
+YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
+YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);
- 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
+/* Location data for the lookahead symbol. */
+static YYLTYPE yyloc_default
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+ = { 1, 1, 1, 1 }
+# endif
+;
+YYLTYPE yylloc = yyloc_default;
- /* Three stacks and their tools:
- `yyss': related to states,
- `yyvs': related to semantic values,
- `yyls': related to locations.
+ /* Number of syntax errors so far. */
+ int yynerrs;
- Refer to the stacks thru separate pointers, to allow yyoverflow
- to reallocate them elsewhere. */
+ int yystate;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
- /* The state stack. */
- yytype_int16 yyssa[YYINITDEPTH];
- yytype_int16 *yyss = yyssa;
- yytype_int16 *yyssp;
+ /* The stacks and their tools:
+ 'yyss': related to states.
+ 'yyvs': related to semantic values.
+ 'yyls': related to locations.
- /* The semantic value stack. */
- YYSTYPE yyvsa[YYINITDEPTH];
- YYSTYPE *yyvs = yyvsa;
- YYSTYPE *yyvsp;
+ Refer to the stacks through separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
- /* The location stack. */
- YYLTYPE yylsa[YYINITDEPTH];
- YYLTYPE *yyls = yylsa;
- YYLTYPE *yylsp;
- /* The locations where the error started and ended. */
- YYLTYPE yyerror_range[2];
+ /* The state stack. */
+ yytype_int16 yyssa[YYINITDEPTH];
+ yytype_int16 *yyss;
+ yytype_int16 *yyssp;
-#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs;
+ YYSTYPE *yyvsp;
+
+ /* The location stack. */
+ YYLTYPE yylsa[YYINITDEPTH];
+ YYLTYPE *yyls;
+ YYLTYPE *yylsp;
- YYSIZE_T yystacksize = YYINITDEPTH;
+ /* The locations where the error started and ended. */
+ YYLTYPE yyerror_range[3];
+ YYSIZE_T yystacksize;
+
+ int yyn;
+ int yyresult;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
/* 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;
+ yyssp = yyss = yyssa;
+ yyvsp = yyvs = yyvsa;
+ yylsp = yyls = yylsa;
+ yystacksize = YYINITDEPTH;
+
YYDPRINTF ((stderr, "Starting parse\n"));
yystate = 0;
yyerrstatus = 0;
yynerrs = 0;
- 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
- /* Initialize the default location before parsing starts. */
- yylloc.first_line = yylloc.last_line = 1;
- yylloc.first_column = yylloc.last_column = 0;
-#endif
-
+ yychar = YYEMPTY; /* Cause a token to be read. */
+ yylsp[0] = yylloc;
goto yysetstate;
/*------------------------------------------------------------.
@@ -1448,25 +1333,26 @@ YYLTYPE yylloc;
#ifdef yyoverflow
{
- /* Give user a chance to reallocate the stack. Use copies of
- these so that the &'s don't force the real ones into
- memory. */
- YYSTYPE *yyvs1 = yyvs;
- yytype_int16 *yyss1 = yyss;
- YYLTYPE *yyls1 = yyls;
-
- /* Each stack pointer address is followed by the size of the
- data in use in that stack, in bytes. This used to be a
- conditional around just the two extra args, but that might
- be undefined if yyoverflow is a macro. */
- yyoverflow (YY_("memory exhausted"),
- &yyss1, yysize * sizeof (*yyssp),
- &yyvs1, yysize * sizeof (*yyvsp),
- &yyls1, yysize * sizeof (*yylsp),
- &yystacksize);
- yyls = yyls1;
- yyss = yyss1;
- yyvs = yyvs1;
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ yytype_int16 *yyss1 = yyss;
+ YYLTYPE *yyls1 = yyls;
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow (YY_("memory exhausted"),
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+ &yyls1, yysize * sizeof (*yylsp),
+ &yystacksize);
+
+ yyls = yyls1;
+ yyss = yyss1;
+ yyvs = yyvs1;
}
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
@@ -1474,23 +1360,23 @@ YYLTYPE yylloc;
# else
/* Extend the stack our own way. */
if (YYMAXDEPTH <= yystacksize)
- goto yyexhaustedlab;
+ goto yyexhaustedlab;
yystacksize *= 2;
if (YYMAXDEPTH < yystacksize)
- yystacksize = YYMAXDEPTH;
+ yystacksize = YYMAXDEPTH;
{
- yytype_int16 *yyss1 = yyss;
- union yyalloc *yyptr =
- (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
- if (! yyptr)
- goto yyexhaustedlab;
- YYSTACK_RELOCATE (yyss);
- YYSTACK_RELOCATE (yyvs);
- YYSTACK_RELOCATE (yyls);
+ yytype_int16 *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyexhaustedlab;
+ YYSTACK_RELOCATE (yyss_alloc, yyss);
+ YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+ YYSTACK_RELOCATE (yyls_alloc, yyls);
# undef YYSTACK_RELOCATE
- if (yyss1 != yyssa)
- YYSTACK_FREE (yyss1);
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
}
# endif
#endif /* no yyoverflow */
@@ -1500,14 +1386,17 @@ YYLTYPE yylloc;
yylsp = yyls + yysize - 1;
YYDPRINTF ((stderr, "Stack size increased to %lu\n",
- (unsigned long int) yystacksize));
+ (unsigned long) yystacksize));
if (yyss + yystacksize - 1 <= yyssp)
- YYABORT;
+ YYABORT;
}
YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+ if (yystate == YYFINAL)
+ YYACCEPT;
+
goto yybackup;
/*-----------.
@@ -1516,20 +1405,20 @@ 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)
+ if (yypact_value_is_default (yyn))
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: "));
- yychar = YYLEX;
+ yychar = yylex (&yylval, &yylloc, info);
}
if (yychar <= YYEOF)
@@ -1551,29 +1440,27 @@ yybackup:
yyn = yytable[yyn];
if (yyn <= 0)
{
- if (yyn == 0 || yyn == YYTABLE_NINF)
- goto yyerrlab;
+ if (yytable_value_is_error (yyn))
+ goto yyerrlab;
yyn = -yyn;
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;
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
*++yyvsp = yylval;
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
*++yylsp = yylloc;
goto yynewstate;
@@ -1596,7 +1483,7 @@ yyreduce:
yylen = yyr2[yyn];
/* If YYLEN is nonzero, implement the default value of the action:
- `$$ = $1'.
+ '$$ = $1'.
Otherwise, the following line sets YYVAL to garbage.
This behavior is undocumented and Bison
@@ -1605,467 +1492,594 @@ yyreduce:
GCC warning that YYVAL may be used uninitialized. */
yyval = yyvsp[1-yylen];
- /* Default location. */
+ /* Default location. */
YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
+ yyerror_range[1] = yyloc;
YY_REDUCE_PRINT (yyn);
switch (yyn)
{
- case 4:
+ case 5:
{
yyHaveTime++;
- ;}
+ }
+
break;
- case 5:
+ case 6:
{
yyHaveZone++;
- ;}
+ }
+
break;
- case 6:
+ case 7:
{
yyHaveDate++;
- ;}
+ }
+
break;
- case 7:
+ case 8:
{
yyHaveOrdinalMonth++;
- ;}
+ }
+
break;
- case 8:
+ case 9:
{
yyHaveDay++;
- ;}
+ }
+
break;
- case 9:
+ case 10:
{
yyHaveRel++;
- ;}
+ }
+
break;
- case 10:
+ case 11:
{
yyHaveTime++;
yyHaveDate++;
- ;}
+ }
+
break;
- case 11:
+ case 12:
{
yyHaveTime++;
yyHaveDate++;
yyHaveRel++;
- ;}
- break;
-
- case 13:
+ }
- {
- yyHour = (yyvsp[(1) - (2)].Number);
- yyMinutes = 0;
- yySeconds = 0;
- yyMeridian = (yyvsp[(2) - (2)].Meridian);
- ;}
break;
case 14:
{
- yyHour = (yyvsp[(1) - (4)].Number);
- yyMinutes = (yyvsp[(3) - (4)].Number);
+ yyHour = (yyvsp[-1].Number);
+ yyMinutes = 0;
yySeconds = 0;
- yyMeridian = (yyvsp[(4) - (4)].Meridian);
- ;}
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 15:
{
- yyHour = (yyvsp[(1) - (5)].Number);
- yyMinutes = (yyvsp[(3) - (5)].Number);
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
- ++yyHaveZone;
- ;}
+ yyHour = (yyvsp[-3].Number);
+ yyMinutes = (yyvsp[-1].Number);
+ yySeconds = 0;
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 16:
{
- yyHour = (yyvsp[(1) - (6)].Number);
- yyMinutes = (yyvsp[(3) - (6)].Number);
- yySeconds = (yyvsp[(5) - (6)].Number);
- yyMeridian = (yyvsp[(6) - (6)].Meridian);
- ;}
+ yyHour = (yyvsp[-5].Number);
+ yyMinutes = (yyvsp[-3].Number);
+ yySeconds = (yyvsp[-1].Number);
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 17:
{
- yyHour = (yyvsp[(1) - (7)].Number);
- yyMinutes = (yyvsp[(3) - (7)].Number);
- yySeconds = (yyvsp[(5) - (7)].Number);
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
- ++yyHaveZone;
- ;}
+ yyTimezone = (yyvsp[-1].Number);
+ yyDSTmode = DSTon;
+ }
+
break;
case 18:
{
- yyTimezone = (yyvsp[(1) - (2)].Number);
- yyDSTmode = DSTon;
- ;}
+ yyTimezone = (yyvsp[0].Number);
+ yyDSTmode = DSToff;
+ }
+
break;
case 19:
{
- yyTimezone = (yyvsp[(1) - (1)].Number);
- yyDSTmode = DSToff;
- ;}
+ yyTimezone = (yyvsp[0].Number);
+ yyDSTmode = DSTon;
+ }
+
break;
case 20:
- {
- yyTimezone = (yyvsp[(1) - (1)].Number);
- yyDSTmode = DSTon;
- ;}
+ { /* GMT+0100, GMT-1000, etc. */
+ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
+ yyDSTmode = DSToff;
+ }
+
break;
case 21:
- {
- yyDayOrdinal = 1;
- yyDayNumber = (yyvsp[(1) - (1)].Number);
- ;}
- break;
-
- case 22:
+ { /* GMT+1, GMT-10, etc. */
+ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) * 60);
+ yyDSTmode = DSToff;
+ }
- {
- yyDayOrdinal = 1;
- yyDayNumber = (yyvsp[(1) - (2)].Number);
- ;}
break;
- case 23:
-
- {
- yyDayOrdinal = (yyvsp[(1) - (2)].Number);
- yyDayNumber = (yyvsp[(2) - (2)].Number);
- ;}
- break;
+ case 22:
- case 24:
+ { /* +0100, -0100 */
+ yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
+ yyDSTmode = DSToff;
+ }
- {
- yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
- yyDayNumber = (yyvsp[(3) - (3)].Number);
- ;}
break;
case 25:
{
- yyDayOrdinal = 2;
- yyDayNumber = (yyvsp[(2) - (2)].Number);
- ;}
+ yyDayOrdinal = 1;
+ yyDayOfWeek = (yyvsp[0].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 26:
{
- yyMonth = (yyvsp[(1) - (3)].Number);
- yyDay = (yyvsp[(3) - (3)].Number);
- ;}
+ yyDayOrdinal = 1;
+ yyDayOfWeek = (yyvsp[-1].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 27:
{
- yyMonth = (yyvsp[(1) - (5)].Number);
- yyDay = (yyvsp[(3) - (5)].Number);
- yyYear = (yyvsp[(5) - (5)].Number);
- ;}
+ yyDayOrdinal = (yyvsp[-1].Number);
+ yyDayOfWeek = (yyvsp[0].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 28:
{
- yyYear = (yyvsp[(1) - (1)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (1)].Number) % 100;
- ;}
+ yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number);
+ yyDayOfWeek = (yyvsp[0].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 29:
{
- yyDay = (yyvsp[(1) - (5)].Number);
- yyMonth = (yyvsp[(3) - (5)].Number);
- yyYear = (yyvsp[(5) - (5)].Number);
- ;}
+ yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
+ yyDayOfWeek = (yyvsp[0].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 30:
{
- yyMonth = (yyvsp[(3) - (5)].Number);
- yyDay = (yyvsp[(5) - (5)].Number);
- yyYear = (yyvsp[(1) - (5)].Number);
- ;}
+ yyDayOrdinal = 2;
+ yyDayOfWeek = (yyvsp[0].Number);
+ info->flags |= CLF_DAYOFWEEK;
+ }
+
break;
case 31:
{
- yyMonth = (yyvsp[(1) - (2)].Number);
- yyDay = (yyvsp[(2) - (2)].Number);
- ;}
+ yyMonth = (yyvsp[-2].Number);
+ yyDay = (yyvsp[0].Number);
+ }
+
break;
case 32:
{
- yyMonth = (yyvsp[(1) - (4)].Number);
- yyDay = (yyvsp[(2) - (4)].Number);
- yyYear = (yyvsp[(4) - (4)].Number);
- ;}
+ yyMonth = (yyvsp[-4].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 33:
{
- yyMonth = (yyvsp[(2) - (2)].Number);
- yyDay = (yyvsp[(1) - (2)].Number);
- ;}
+ yyYear = (yyvsp[0].Number) / 10000;
+ yyMonth = ((yyvsp[0].Number) % 10000)/100;
+ yyDay = (yyvsp[0].Number) % 100;
+ }
+
break;
case 34:
{
- yyMonth = 1;
- yyDay = 1;
- yyYear = EPOCH;
- ;}
+ yyDay = (yyvsp[-4].Number);
+ yyMonth = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 35:
{
- yyMonth = (yyvsp[(2) - (3)].Number);
- yyDay = (yyvsp[(1) - (3)].Number);
- yyYear = (yyvsp[(3) - (3)].Number);
- ;}
+ yyMonth = (yyvsp[-2].Number);
+ yyDay = (yyvsp[0].Number);
+ yyYear = (yyvsp[-4].Number);
+ }
+
break;
case 36:
{
- yyMonthOrdinal = 1;
- yyMonth = (yyvsp[(2) - (2)].Number);
- ;}
+ yyMonth = (yyvsp[-1].Number);
+ yyDay = (yyvsp[0].Number);
+ }
+
break;
case 37:
{
- yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
- yyMonth = (yyvsp[(3) - (3)].Number);
- ;}
+ yyMonth = (yyvsp[-3].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 38:
{
- if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
- yyYear = (yyvsp[(1) - (3)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (3)].Number) % 100;
- yyHour = (yyvsp[(3) - (3)].Number) / 10000;
- yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
- yySeconds = (yyvsp[(3) - (3)].Number) % 100;
- ;}
+ yyMonth = (yyvsp[0].Number);
+ yyDay = (yyvsp[-1].Number);
+ }
+
break;
case 39:
{
- if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
- yyYear = (yyvsp[(1) - (7)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (7)].Number) % 100;
- yyHour = (yyvsp[(3) - (7)].Number);
- yyMinutes = (yyvsp[(5) - (7)].Number);
- yySeconds = (yyvsp[(7) - (7)].Number);
- ;}
+ yyMonth = 1;
+ yyDay = 1;
+ yyYear = EPOCH;
+ }
+
break;
case 40:
{
- yyYear = (yyvsp[(1) - (2)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (2)].Number) % 100;
- yyHour = (yyvsp[(2) - (2)].Number) / 10000;
- yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
- yySeconds = (yyvsp[(2) - (2)].Number) % 100;
- ;}
+ yyMonth = (yyvsp[-1].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 41:
{
+ yyMonthOrdinalIncr = 1;
+ yyMonthOrdinal = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 42:
+
+ {
+ yyMonthOrdinalIncr = (yyvsp[-1].Number);
+ yyMonthOrdinal = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 43:
+
+ {
+ if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT; /* T */
+ yyYear = (yyvsp[-2].Number) / 10000;
+ yyMonth = ((yyvsp[-2].Number) % 10000)/100;
+ yyDay = (yyvsp[-2].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 10000;
+ yyMinutes = ((yyvsp[0].Number) % 10000)/100;
+ yySeconds = (yyvsp[0].Number) % 100;
+ }
+
+ break;
+
+ case 44:
+
+ {
+ yyYear = (yyvsp[-1].Number) / 10000;
+ yyMonth = ((yyvsp[-1].Number) % 10000)/100;
+ yyDay = (yyvsp[-1].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 10000;
+ yyMinutes = ((yyvsp[0].Number) % 10000)/100;
+ yySeconds = (yyvsp[0].Number) % 100;
+ }
+
+ break;
+
+ case 45:
+
+ {
+ yyYear = (yyvsp[-6].Number) / 10000;
+ yyMonth = ((yyvsp[-6].Number) % 10000)/100;
+ yyDay = (yyvsp[-6].Number) % 100;
+ yyHour = (yyvsp[-4].Number);
+ yyMinutes = (yyvsp[-2].Number);
+ yySeconds = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 46:
+
+ {
+ if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT; /* T */
+ yyYear = (yyvsp[-6].Number) / 10000;
+ yyMonth = ((yyvsp[-6].Number) % 10000)/100;
+ yyDay = (yyvsp[-6].Number) % 100;
+ yyHour = (yyvsp[-4].Number);
+ yyMinutes = (yyvsp[-2].Number);
+ yySeconds = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 47:
+
+ {
+ yyYear = (yyvsp[-2].Number) / 10000;
+ yyMonth = ((yyvsp[-2].Number) % 10000)/100;
+ yyDay = (yyvsp[-2].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 10000;
+ yyMinutes = ((yyvsp[0].Number) % 10000)/100;
+ yySeconds = (yyvsp[0].Number) % 100;
+ }
+
+ break;
+
+ case 48:
+
+ {
/*
* Offset computed year by -377 so that the returned years will be
* in a range accessible with a 32 bit clock seconds value.
*/
- yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
+ yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
yyDay = 1;
yyMonth = 1;
- yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
- yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
- ;}
+ yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
+ yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
+ }
+
break;
- case 42:
+ case 49:
{
yyRelSeconds *= -1;
yyRelMonth *= -1;
yyRelDay *= -1;
- ;}
+ }
+
break;
- case 44:
+ case 51:
{
- *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
- case 45:
+ case 52:
{
- *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
- case 46:
+ case 53:
{
- *yyRelPointer += (yyvsp[(2) - (2)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
- case 47:
+ case 54:
{
- *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
- ;}
+ *yyRelPointer += (yyvsp[0].Number);
+ }
+
break;
- case 48:
+ case 55:
{
- *yyRelPointer += (yyvsp[(1) - (1)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
- case 49:
+ case 56:
+
+ {
+ *yyRelPointer += (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 57:
{
(yyval.Number) = -1;
- ;}
+ }
+
break;
- case 50:
+ case 58:
{
(yyval.Number) = 1;
- ;}
+ }
+
break;
- case 51:
+ case 59:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelSeconds;
- ;}
+ }
+
break;
- case 52:
+ case 60:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelDay;
- ;}
+ }
+
break;
- case 53:
+ case 61:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelMonth;
- ;}
+ }
+
break;
- case 54:
+ case 62:
+
+ {
+ (yyval.Number) = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 63:
+
+ {
+ (yyval.Number) = (yyvsp[0].Number);
+ }
+
+ break;
+
+ case 64:
{
if (yyHaveTime && yyHaveDate && !yyHaveRel) {
- yyYear = (yyvsp[(1) - (1)].Number);
+ yyYear = (yyvsp[0].Number);
} else {
yyHaveTime++;
if (yyDigitCount <= 2) {
- yyHour = (yyvsp[(1) - (1)].Number);
+ yyHour = (yyvsp[0].Number);
yyMinutes = 0;
} else {
- yyHour = (yyvsp[(1) - (1)].Number) / 100;
- yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 100;
+ yyMinutes = (yyvsp[0].Number) % 100;
}
yySeconds = 0;
yyMeridian = MER24;
}
- ;}
+ }
+
break;
- case 55:
+ case 65:
{
(yyval.Meridian) = MER24;
- ;}
+ }
+
break;
- case 56:
+ case 66:
{
- (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
- ;}
+ (yyval.Meridian) = (yyvsp[0].Meridian);
+ }
+
break;
-/* Line 1267 of yacc.c. */
default: break;
}
+ /* User semantic actions sometimes alter yychar, and that requires
+ that yytoken be updated with the new translation. We take the
+ approach of translating immediately before every use of yytoken.
+ One alternative is translating here after every semantic action,
+ but that translation would be missed if the semantic action invokes
+ YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+ if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an
+ incorrect destructor might then be invoked immediately. In the
+ case of YYERROR or YYBACKUP, subsequent parser actions might lead
+ to an incorrect destructor call or verbose syntax error message
+ before the lookahead is translated. */
YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
YYPOPSTACK (yylen);
@@ -2075,7 +2089,7 @@ yyreduce:
*++yyvsp = yyval;
*++yylsp = yyloc;
- /* Now `shift' the result of the reduction. Determine what state
+ /* Now 'shift' the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
@@ -2090,10 +2104,14 @@ yyreduce:
goto yynewstate;
-/*------------------------------------.
-| yyerrlab -- here on detecting error |
-`------------------------------------*/
+/*--------------------------------------.
+| yyerrlab -- here on detecting error. |
+`--------------------------------------*/
yyerrlab:
+ /* Make sure we have latest lookahead translation. See comments at
+ user semantic actions for why this is necessary. */
+ yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
/* If not already recovering from an error, report this error. */
if (!yyerrstatus)
{
@@ -2101,62 +2119,61 @@ yyerrlab:
#if ! YYERROR_VERBOSE
yyerror (&yylloc, info, YY_("syntax error"));
#else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+ yyssp, yytoken)
{
- YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
- if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
- {
- YYSIZE_T yyalloc = 2 * yysize;
- if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
- yyalloc = YYSTACK_ALLOC_MAXIMUM;
- if (yymsg != yymsgbuf)
- YYSTACK_FREE (yymsg);
- yymsg = (char *) YYSTACK_ALLOC (yyalloc);
- if (yymsg)
- yymsg_alloc = yyalloc;
- else
- {
- yymsg = yymsgbuf;
- yymsg_alloc = sizeof yymsgbuf;
- }
- }
-
- if (0 < yysize && yysize <= yymsg_alloc)
- {
- (void) yysyntax_error (yymsg, yystate, yychar);
- yyerror (&yylloc, info, yymsg);
- }
- else
- {
- yyerror (&yylloc, info, YY_("syntax error"));
- if (yysize != 0)
- goto yyexhaustedlab;
- }
+ char const *yymsgp = YY_("syntax error");
+ int yysyntax_error_status;
+ yysyntax_error_status = YYSYNTAX_ERROR;
+ if (yysyntax_error_status == 0)
+ yymsgp = yymsg;
+ else if (yysyntax_error_status == 1)
+ {
+ if (yymsg != yymsgbuf)
+ YYSTACK_FREE (yymsg);
+ yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+ if (!yymsg)
+ {
+ yymsg = yymsgbuf;
+ yymsg_alloc = sizeof yymsgbuf;
+ yysyntax_error_status = 2;
+ }
+ else
+ {
+ yysyntax_error_status = YYSYNTAX_ERROR;
+ yymsgp = yymsg;
+ }
+ }
+ yyerror (&yylloc, info, yymsgp);
+ if (yysyntax_error_status == 2)
+ goto yyexhaustedlab;
}
+# undef YYSYNTAX_ERROR
#endif
}
- yyerror_range[0] = yylloc;
+ yyerror_range[1] = yylloc;
if (yyerrstatus == 3)
{
- /* If just tried and failed to reuse look-ahead token after an
- error, discard it. */
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
if (yychar <= YYEOF)
- {
- /* Return failure if at end of input. */
- if (yychar == YYEOF)
- YYABORT;
- }
+ {
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ YYABORT;
+ }
else
- {
- yydestruct ("Error: discarding",
- yytoken, &yylval, &yylloc, info);
- yychar = YYEMPTY;
- }
+ {
+ yydestruct ("Error: discarding",
+ yytoken, &yylval, &yylloc, info);
+ yychar = YYEMPTY;
+ }
}
- /* 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;
@@ -2172,8 +2189,7 @@ yyerrorlab:
if (/*CONSTCOND*/ 0)
goto yyerrorlab;
- yyerror_range[0] = yylsp[1-yylen];
- /* Do not reclaim the symbols of the rule which action triggered
+ /* Do not reclaim the symbols of the rule whose action triggered
this YYERROR. */
YYPOPSTACK (yylen);
yylen = 0;
@@ -2186,43 +2202,42 @@ yyerrorlab:
| yyerrlab1 -- common code for both syntax error and YYERROR. |
`-------------------------------------------------------------*/
yyerrlab1:
- yyerrstatus = 3; /* Each real token shifted decrements this. */
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
for (;;)
{
yyn = yypact[yystate];
- if (yyn != YYPACT_NINF)
- {
- yyn += YYTERROR;
- if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
- {
- yyn = yytable[yyn];
- if (0 < yyn)
- break;
- }
- }
+ if (!yypact_value_is_default (yyn))
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
/* Pop the current state because it cannot handle the error token. */
if (yyssp == yyss)
- YYABORT;
+ YYABORT;
- yyerror_range[0] = *yylsp;
+ yyerror_range[1] = *yylsp;
yydestruct ("Error: popping",
- yystos[yystate], yyvsp, yylsp, info);
+ yystos[yystate], yyvsp, yylsp, info);
YYPOPSTACK (1);
yystate = *yyssp;
YY_STACK_PRINT (yyss, yyssp);
}
- if (yyn == YYFINAL)
- YYACCEPT;
-
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
*++yyvsp = yylval;
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
- yyerror_range[1] = yylloc;
+ yyerror_range[2] = yylloc;
/* Using YYLLOC is tempting, but would change the location of
- the look-ahead. YYLOC is available though. */
- YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
+ the lookahead. YYLOC is available though. */
+ YYLLOC_DEFAULT (yyloc, yyerror_range, 2);
*++yylsp = yyloc;
/* Shift the error token. */
@@ -2246,7 +2261,7 @@ yyabortlab:
yyresult = 1;
goto yyreturn;
-#ifndef yyoverflow
+#if !defined yyoverflow || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here. |
`-------------------------------------------------*/
@@ -2257,17 +2272,22 @@ yyexhaustedlab:
#endif
yyreturn:
- if (yychar != YYEOF && yychar != YYEMPTY)
- yydestruct ("Cleanup: discarding lookahead",
- yytoken, &yylval, &yylloc, info);
- /* Do not reclaim the symbols of the rule which action triggered
+ if (yychar != YYEMPTY)
+ {
+ /* Make sure we have latest lookahead translation. See comments at
+ user semantic actions for why this is necessary. */
+ yytoken = YYTRANSLATE (yychar);
+ yydestruct ("Cleanup: discarding lookahead",
+ yytoken, &yylval, &yylloc, info);
+ }
+ /* Do not reclaim the symbols of the rule whose action triggered
this YYABORT or YYACCEPT. */
YYPOPSTACK (yylen);
YY_STACK_PRINT (yyss, yyssp);
while (yyssp != yyss)
{
yydestruct ("Cleanup: popping",
- yystos[*yyssp], yyvsp, yylsp, info);
+ yystos[*yyssp], yyvsp, yylsp, info);
YYPOPSTACK (1);
}
#ifndef yyoverflow
@@ -2278,13 +2298,10 @@ yyreturn:
if (yymsg != yymsgbuf)
YYSTACK_FREE (yymsg);
#endif
- /* Make sure YYID is used. */
- return YYID (yyresult);
+ return yyresult;
}
-
-
/*
* Month and day table.
*/
@@ -2402,6 +2419,8 @@ static const TABLE TimezoneTable[] = {
{ "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
{ "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
{ "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
+ { "akst", tZONE, HOUR( 9) }, /* Alaska Standard */
+ { "akdt", tDAYZONE, HOUR( 9) }, /* Alaska Daylight */
{ "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
{ "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
{ "cat", tZONE, HOUR(10) }, /* Central Alaska */
@@ -2486,6 +2505,18 @@ static const TABLE MilitaryTable[] = {
{ NULL, 0, 0 }
};
+static inline const char *
+bypassSpaces(
+ register const char *s)
+{
+ if (isspace(UCHAR(*s))) {
+ do {
+ s++;
+ } while (isspace(UCHAR(*s)));
+ }
+ return s;
+}
+
/*
* Dump error messages in the bit bucket.
*/
@@ -2513,11 +2544,11 @@ TclDateerror(
infoPtr->separatrix = "\n";
}
-static time_t
+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) {
@@ -2559,11 +2590,11 @@ LookupWord(
Tcl_UtfToLower(buff);
- if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
+ if (*buff == 'a' && (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0)) {
yylvalPtr->Meridian = MERam;
return tMERIDIAN;
}
- if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
+ if (*buff == 'p' && (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0)) {
yylvalPtr->Meridian = MERpm;
return tMERIDIAN;
}
@@ -2680,29 +2711,38 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (TclIsSpaceProc(*yyInput)) {
- yyInput++;
+
+ if (isspace(UCHAR(*yyInput))) {
+ yyInput = bypassSpaces(yyInput);
+ /* ignore space at end of text and before some words */
+ c = *yyInput;
+ if (c != '\0' && !isalpha(UCHAR(c))) {
+ return SP;
+ }
}
if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+
/*
* Convert the string into a number; count the number of digits.
*/
-
- Count = 0;
- for (yylvalPtr->Number = 0;
- isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
- yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
- Count++;
- }
- yyInput--;
- yyDigitCount = Count;
-
+ register int num = c - '0';
+ p = (char *)yyInput;
+ while (isdigit(UCHAR(c = *(++p)))) {
+ num *= 10;
+ num += c - '0';
+ };
+ yylvalPtr->Number = num;
+ yyDigitCount = p - yyInput;
+ yyInput = p;
+
+ /* ignore spaces after digits (optional) */
+ yyInput = bypassSpaces(yyInput);
/*
* A number with 6 or more digits is considered an ISO 8601 base.
*/
- if (Count >= 6) {
+ if (yyDigitCount >= 6) {
location->last_column = yyInput - info->dateStart - 1;
return tISOBASE;
} else {
@@ -2711,6 +2751,7 @@ TclDatelex(
}
}
if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ int ret;
for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
|| c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
@@ -2720,7 +2761,30 @@ TclDatelex(
*p = '\0';
yyInput--;
location->last_column = yyInput - info->dateStart - 1;
- return LookupWord(yylvalPtr, buff);
+ ret = LookupWord(yylvalPtr, buff);
+ /*
+ * lookahead for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day",
+ * bypass spaces after token (but ignore by TZ+OFFS), because should
+ * recognize next SP token, if TZ only.
+ */
+ if (ret == tZONE || ret == tDAYZONE) {
+ c = *yyInput;
+ if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) {
+ if ( !isdigit(UCHAR(*(yyInput+2)))
+ || !isdigit(UCHAR(*(yyInput+3)))) {
+ /* GMT+1, GMT-10, etc. */
+ return tZONEwO2;
+ }
+ if ( isdigit(UCHAR(*(yyInput+4)))
+ && !isdigit(UCHAR(*(yyInput+5)))) {
+ /* GMT+1000, etc. */
+ return tZONEwO4;
+ }
+ }
+ }
+ yyInput = bypassSpaces(yyInput);
+ return ret;
+
}
if (c != '(') {
location->last_column = yyInput - info->dateStart;
@@ -2740,65 +2804,46 @@ 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;
+ #if YYDEBUG
+ /* enable debugging if compiled with YYDEBUG */
+ yydebug = 1;
+ #endif
- 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;
-
- yyHaveZone = 0;
- yyTimezone = 0; yyDSTmode = DSTmaybe;
+ /*
+ * yyInput = stringToParse;
+ *
+ * ClockInitDateInfo(info) should be executed to pre-init info;
+ */
- yyHaveOrdinalMonth = 0;
- yyMonthOrdinal = 0;
+ yyDSTmode = DSTmaybe;
- yyHaveDay = 0;
- yyDayOrdinal = 0; yyDayNumber = 0;
+ info->messages = Tcl_NewObj();
+ info->separatrix = "";
+ Tcl_IncrRefCount(info->messages);
- yyHaveRel = 0;
- yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+ info->dateStart = yyInput;
- dateInfo.messages = Tcl_NewObj();
- dateInfo.separatrix = "";
- Tcl_IncrRefCount(dateInfo.messages);
+ /* ignore spaces at begin */
+ yyInput = bypassSpaces(yyInput);
- status = yyparse(&dateInfo);
+ /* parse */
+ 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 +2851,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,64 +2888,6 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
- result = Tcl_NewObj();
- resultElement = Tcl_NewObj();
- if (yyHaveDate) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyYear));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDay));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- if (yyHaveTime) {
- Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
- ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
- } else {
- Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
- }
-
- resultElement = Tcl_NewObj();
- if (yyHaveZone) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) -yyTimezone));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj(1 - yyDSTmode));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveRel) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelMonth));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelDay));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelSeconds));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveDay && !yyHaveDate) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDayOrdinal));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDayNumber));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveOrdinalMonth) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonthOrdinal));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- Tcl_SetObjResult(interp, result);
return TCL_OK;
}
@@ -2911,4 +2898,3 @@ TclClockOldscanObjCmd(
* fill-column: 78
* End:
*/
-
diff --git a/generic/tclDate.h b/generic/tclDate.h
new file mode 100644
index 0000000..55eb331
--- /dev/null
+++ b/generic/tclDate.h
@@ -0,0 +1,537 @@
+/*
+ * tclDate.h --
+ *
+ * This header file handles common usage of clock primitives
+ * between tclDate.c (yacc), tclClock.c and tclClockFmt.c.
+ *
+ * Copyright (c) 2014 Serg G. Brester (aka sebres)
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLCLOCK_H
+#define _TCLCLOCK_H
+
+/*
+ * Constants
+ */
+
+#define JULIAN_DAY_POSIX_EPOCH 2440588
+#define GREGORIAN_CHANGE_DATE 2361222
+#define SECONDS_PER_DAY 86400
+#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
+ * SECONDS_PER_DAY)
+#define FOUR_CENTURIES 146097 /* days */
+#define JDAY_1_JAN_1_CE_JULIAN 1721424
+#define JDAY_1_JAN_1_CE_GREGORIAN 1721426
+#define ONE_CENTURY_GREGORIAN 36524 /* days */
+#define FOUR_YEARS 1461 /* days */
+#define ONE_YEAR 365 /* days */
+
+#define RODDENBERRY 1946 /* Another epoch (Hi, Jeff!) */
+
+
+#define CLF_OPTIONAL (1 << 0) /* token is non mandatory */
+#define CLF_POSIXSEC (1 << 1)
+#define CLF_LOCALSEC (1 << 2)
+#define CLF_JULIANDAY (1 << 3)
+#define CLF_TIME (1 << 4)
+#define CLF_CENTURY (1 << 6)
+#define CLF_DAYOFMONTH (1 << 7)
+#define CLF_DAYOFYEAR (1 << 8)
+#define CLF_MONTH (1 << 9)
+#define CLF_YEAR (1 << 10)
+#define CLF_DAYOFWEEK (1 << 11)
+#define CLF_ISO8601YEAR (1 << 12)
+#define CLF_ISO8601WEAK (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_DAYOFWEEK | CLF_ISO8601WEAK)
+
+#define TCL_MIN_SECONDS -0x00F0000000000000L
+#define TCL_MAX_SECONDS 0x00F0000000000000L
+#define TCL_INV_SECONDS (TCL_MIN_SECONDS-1)
+
+/*
+ * Enumeration of the string literals used in [clock]
+ */
+
+typedef enum ClockLiteral {
+ LIT__NIL,
+ LIT__DEFAULT_FORMAT,
+ LIT_SYSTEM, LIT_CURRENT, LIT_C,
+ LIT_BCE, LIT_CE,
+ LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR,
+ LIT_ERA, LIT_GMT, LIT_GREGORIAN,
+ LIT_INTEGER_VALUE_TOO_LARGE,
+ LIT_ISO8601WEEK, LIT_ISO8601YEAR,
+ LIT_JULIANDAY, LIT_LOCALSECONDS,
+ LIT_MONTH,
+ LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET,
+ LIT_YEAR,
+ LIT_TZDATA,
+ LIT_GETSYSTEMTIMEZONE,
+ LIT_SETUPTIMEZONE,
+ LIT_MCGET,
+ LIT_GETSYSTEMLOCALE, LIT_GETCURRENTLOCALE,
+ LIT_LOCALIZE_FORMAT,
+ LIT__END
+} ClockLiteral;
+
+#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \
+ "", \
+ "%a %b %d %H:%M:%S %Z %Y", \
+ "system", "current", "C", \
+ "BCE", "CE", \
+ "dayOfMonth", "dayOfWeek", "dayOfYear", \
+ "era", ":GMT", "gregorian", \
+ "integer value too large to represent", \
+ "iso8601Week", "iso8601Year", \
+ "julianDay", "localSeconds", \
+ "month", \
+ "seconds", "tzName", "tzOffset", \
+ "year", \
+ "::tcl::clock::TZData", \
+ "::tcl::clock::GetSystemTimeZone", \
+ "::tcl::clock::SetupTimeZone", \
+ "::tcl::clock::mcget", \
+ "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \
+ "::tcl::clock::LocalizeFormat" \
+}
+
+/*
+ * Enumeration of the msgcat literals used in [clock]
+ */
+
+typedef enum ClockMsgCtLiteral {
+ MCLIT__NIL, /* placeholder */
+ MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, MCLIT_MONTHS_COMB,
+ MCLIT_DAYS_OF_WEEK_FULL, MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_COMB,
+ MCLIT_AM, MCLIT_PM,
+ MCLIT_LOCALE_ERAS,
+ MCLIT_BCE, MCLIT_CE,
+ MCLIT_BCE2, MCLIT_CE2,
+ MCLIT_BCE3, MCLIT_CE3,
+ MCLIT_LOCALE_NUMERALS,
+ MCLIT__END
+} ClockMsgCtLiteral;
+
+#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \
+ pref "", \
+ pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \
+ pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \
+ pref "AM", pref "PM", \
+ pref "LOCALE_ERAS", \
+ pref "BCE", pref "CE", \
+ pref "b.c.e.", pref "c.e.", \
+ pref "b.c.", pref "a.d.", \
+ pref "LOCALE_NUMERALS", \
+}
+
+/*
+ * Structure containing the fields used in [clock format] and [clock scan]
+ */
+
+typedef struct TclDateFields {
+
+ /* Cacheable fields: */
+
+ Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
+ * epoch */
+ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
+ * from the Posix epoch */
+ int tzOffset; /* Time zone offset in seconds east of
+ * Greenwich */
+ Tcl_WideInt 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 hour (in-between time only calculation) */
+ int secondOfMin; /* Seconds of minute (in-between time only calculation) */
+ int secondOfDay; /* Seconds of day (in-between time only calculation) */
+
+ /* Non cacheable fields: */
+
+ Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the
+ * time zone, if set the refCount is incremented */
+} TclDateFields;
+
+#define ClockCacheableDateFieldsSize \
+ TclOffset(TclDateFields, tzName)
+
+/*
+ * Structure contains return parsed fields.
+ */
+
+typedef struct DateInfo {
+ const char *dateStart;
+ const char *dateInput;
+ const char *dateEnd;
+
+ TclDateFields date;
+
+ int flags;
+
+ int dateHaveDate;
+
+ int dateMeridian;
+ int dateHaveTime;
+
+ int dateTimezone;
+ int dateDSTmode;
+ int dateHaveZone;
+
+ int dateRelMonth;
+ int dateRelDay;
+ int dateRelSeconds;
+ int dateHaveRel;
+
+ int dateMonthOrdinalIncr;
+ int dateMonthOrdinal;
+ int dateHaveOrdinalMonth;
+
+ int dateDayOrdinal;
+ int dateHaveDay;
+
+ int *dateRelPointer;
+
+ int dateSpaceCount;
+ int dateDigitCount;
+
+ int dateCentury;
+
+ Tcl_Obj* messages; /* Error messages */
+ const char* separatrix; /* String separating messages */
+} DateInfo;
+
+#define yydate (info->date) /* Date fields used for converting */
+
+#define yyDay (info->date.dayOfMonth)
+#define yyMonth (info->date.month)
+#define yyYear (info->date.year)
+
+#define yyHour (info->date.hour)
+#define yyMinutes (info->date.minutes)
+#define yySeconds (info->date.secondOfMin)
+#define yySecondOfDay (info->date.secondOfDay)
+
+#define yyDSTmode (info->dateDSTmode)
+#define yyDayOrdinal (info->dateDayOrdinal)
+#define yyDayOfWeek (info->date.dayOfWeek)
+#define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr)
+#define yyMonthOrdinal (info->dateMonthOrdinal)
+#define yyHaveDate (info->dateHaveDate)
+#define yyHaveDay (info->dateHaveDay)
+#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
+#define yyHaveRel (info->dateHaveRel)
+#define yyHaveTime (info->dateHaveTime)
+#define yyHaveZone (info->dateHaveZone)
+#define yyTimezone (info->dateTimezone)
+#define yyMeridian (info->dateMeridian)
+#define yyRelMonth (info->dateRelMonth)
+#define yyRelDay (info->dateRelDay)
+#define yyRelSeconds (info->dateRelSeconds)
+#define yyRelPointer (info->dateRelPointer)
+#define yyInput (info->dateInput)
+#define yyDigitCount (info->dateDigitCount)
+#define yySpaceCount (info->dateSpaceCount)
+
+static inline void
+ClockInitDateInfo(DateInfo *info) {
+ memset(info, 0, sizeof(DateInfo));
+}
+
+/*
+ * Structure containing the command arguments supplied to [clock format] and [clock scan]
+ */
+
+#define CLF_VALIDATE (1 << 2)
+#define CLF_EXTENDED (1 << 4)
+#define CLF_STRICT (1 << 8)
+#define CLF_LOCALE_USED (1 << 15)
+
+typedef struct ClockFmtScnCmdArgs {
+ ClientData clientData; /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp; /* Tcl interpreter */
+
+ Tcl_Obj *formatObj; /* Format */
+ Tcl_Obj *localeObj; /* Name of the locale where the time will be expressed. */
+ Tcl_Obj *timezoneObj; /* Default time zone in which the time will be expressed */
+ Tcl_Obj *baseObj; /* Base (scan and add) or clockValue (format) */
+ int flags; /* Flags control scanning */
+
+ Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/
+} ClockFmtScnCmdArgs;
+
+/* Last-period cache for fast UTC to local and backwards conversion */
+typedef struct ClockLastTZOffs {
+ /* keys */
+ Tcl_Obj *timezoneObj;
+ int changeover;
+ Tcl_WideInt localSeconds;
+ Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */
+ /* values */
+ int tzOffset;
+ Tcl_Obj *tzName; /* Name (abbreviation) of this area in TZ */
+} ClockLastTZOffs;
+
+/*
+ * Structure containing the client data for [clock]
+ */
+
+typedef struct ClockClientData {
+ size_t refCount; /* Number of live references. */
+ Tcl_Obj **literals; /* Pool of object literals (common, locale independent). */
+ Tcl_Obj **mcLiterals; /* Msgcat object literals with mc-keys for search with locale. */
+ Tcl_Obj **mcLitIdxs; /* Msgcat object indices prefixed with _IDX_,
+ * used for quick dictionary search */
+
+ Tcl_Obj *mcDicts; /* Msgcat collection, contains weak pointers to locale
+ * catalogs, and owns it references (onetime referenced) */
+
+ /* Cache for current clock parameters, imparted via "configure" */
+ size_t lastTZEpoch;
+ int currentYearCentury;
+ int yearOfCenturySwitch;
+ int validMinYear;
+ int validMaxYear;
+
+ Tcl_Obj *systemTimeZone;
+ Tcl_Obj *systemSetupTZData;
+ Tcl_Obj *gmtSetupTimeZoneUnnorm;
+ Tcl_Obj *gmtSetupTimeZone;
+ Tcl_Obj *gmtSetupTZData;
+ Tcl_Obj *gmtTZName;
+ Tcl_Obj *lastSetupTimeZoneUnnorm;
+ Tcl_Obj *lastSetupTimeZone;
+ Tcl_Obj *lastSetupTZData;
+ Tcl_Obj *prevSetupTimeZoneUnnorm;
+ Tcl_Obj *prevSetupTimeZone;
+ Tcl_Obj *prevSetupTZData;
+
+ Tcl_Obj *defaultLocale;
+ Tcl_Obj *defaultLocaleDict;
+ Tcl_Obj *currentLocale;
+ Tcl_Obj *currentLocaleDict;
+ Tcl_Obj *lastUsedLocaleUnnorm;
+ Tcl_Obj *lastUsedLocale;
+ Tcl_Obj *lastUsedLocaleDict;
+ Tcl_Obj *prevUsedLocaleUnnorm;
+ Tcl_Obj *prevUsedLocale;
+ Tcl_Obj *prevUsedLocaleDict;
+
+ /* Cache for last base (last-second fast convert if base/tz not changed) */
+ struct {
+ Tcl_Obj *timezoneObj;
+ TclDateFields date;
+ } lastBase;
+
+ /* Last-period cache for fast UTC to Local and backwards conversion */
+ ClockLastTZOffs lastTZOffsCache[2];
+
+ int defFlags; /* Default flags (from configure), ATM
+ * only CLF_VALIDATE supported */
+} ClockClientData;
+
+#define ClockDefaultYearCentury 2000
+#define ClockDefaultCenturySwitch 38
+
+/*
+ * Meridian: am, pm, or 24-hour style.
+ */
+
+typedef enum _MERIDIAN {
+ MERam, MERpm, MER24
+} MERIDIAN;
+
+/*
+ * Clock scan and format facilities.
+ */
+
+#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32
+
+#define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2
+
+typedef struct ClockScanToken ClockScanToken;
+
+
+typedef int ClockScanTokenProc(
+ ClockFmtScnCmdArgs *opts,
+ DateInfo *info,
+ ClockScanToken *tok);
+
+
+typedef enum _CLCKTOK_TYPE {
+ CTOKT_INT = 1, CTOKT_WIDE, CTOKT_PARSER, CTOKT_SPACE, CTOKT_WORD, CTOKT_CHAR,
+ CFMTT_PROC
+} CLCKTOK_TYPE;
+
+typedef struct ClockScanTokenMap {
+ unsigned short int type;
+ unsigned short int flags;
+ unsigned short int clearFlags;
+ unsigned short int minSize;
+ unsigned short int maxSize;
+ unsigned short int offs;
+ ClockScanTokenProc *parser;
+ const void *data;
+} ClockScanTokenMap;
+
+struct ClockScanToken {
+ ClockScanTokenMap *map;
+ struct {
+ const char *start;
+ const char *end;
+ } tokWord;
+ unsigned short int endDistance;
+ unsigned short int lookAhMin;
+ unsigned short int lookAhMax;
+ unsigned short int lookAhTok;
+};
+
+
+#define MIN_FMT_RESULT_BLOCK_ALLOC 80
+#define MIN_FMT_RESULT_BLOCK_DELTA 0
+/* Maximal permitted threshold (buffer size > result size) in percent,
+ * to directly return the buffer without reallocate */
+#define MAX_FMT_RESULT_THRESHOLD 2
+
+typedef struct DateFormat {
+ char *resMem;
+ char *resEnd;
+ char *output;
+
+ TclDateFields date;
+
+ Tcl_Obj *localeEra;
+} DateFormat;
+
+#define CLFMT_INCR (1 << 3)
+#define CLFMT_DECR (1 << 4)
+#define CLFMT_CALC (1 << 5)
+#define CLFMT_LOCALE_INDX (1 << 8)
+
+typedef struct ClockFormatToken ClockFormatToken;
+
+typedef int ClockFormatTokenProc(
+ ClockFmtScnCmdArgs *opts,
+ DateFormat *dateFmt,
+ ClockFormatToken *tok,
+ int *val);
+
+typedef struct ClockFormatTokenMap {
+ unsigned short int type;
+ const char *tostr;
+ unsigned short int width;
+ unsigned short int flags;
+ unsigned short int divider;
+ unsigned short int divmod;
+ unsigned short int offs;
+ ClockFormatTokenProc *fmtproc;
+ void *data;
+} ClockFormatTokenMap;
+
+struct ClockFormatToken {
+ ClockFormatTokenMap *map;
+ struct {
+ const char *start;
+ const char *end;
+ } tokWord;
+};
+
+
+typedef struct ClockFmtScnStorage ClockFmtScnStorage;
+
+struct ClockFmtScnStorage {
+ int objRefCount; /* Reference count shared across threads */
+ ClockScanToken *scnTok;
+ unsigned int scnTokC;
+ unsigned int scnSpaceCount; /* Count of mandatory spaces used in format */
+ ClockFormatToken *fmtTok;
+ unsigned int fmtTokC;
+#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
+ ClockFmtScnStorage *nextPtr;
+ ClockFmtScnStorage *prevPtr;
+#endif
+ size_t fmtMinAlloc;
+#if 0
+ +Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry,
+ * stored by offset +sizeof(self) */
+#endif
+};
+
+/*
+ * Prototypes of module functions.
+ */
+
+MODULE_SCOPE int ToSeconds(int Hours, int Minutes,
+ int Seconds, MERIDIAN Meridian);
+MODULE_SCOPE int IsGregorianLeapYear(TclDateFields *);
+MODULE_SCOPE void
+ GetJulianDayFromEraYearWeekDay(
+ TclDateFields *fields, int changeover);
+MODULE_SCOPE void
+ GetJulianDayFromEraYearMonthDay(
+ TclDateFields *fields, int changeover);
+MODULE_SCOPE void
+ GetJulianDayFromEraYearDay(
+ TclDateFields *fields, int changeover);
+MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *,
+ TclDateFields *, Tcl_Obj *timezoneObj, int);
+MODULE_SCOPE Tcl_Obj *
+ LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
+ int, Tcl_Obj *const *, Tcl_WideInt *rangesVal);
+
+MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info);
+
+/* tclClock.c module declarations */
+
+MODULE_SCOPE Tcl_Obj *
+ ClockSetupTimeZone(ClientData clientData,
+ Tcl_Interp *interp, Tcl_Obj *timezoneObj);
+
+MODULE_SCOPE Tcl_Obj *
+ ClockMCDict(ClockFmtScnCmdArgs *opts);
+MODULE_SCOPE Tcl_Obj *
+ ClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey);
+MODULE_SCOPE Tcl_Obj *
+ ClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey);
+MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey,
+ Tcl_Obj *valObj);
+
+/* tclClockFmt.c module declarations */
+
+MODULE_SCOPE Tcl_Obj*
+ ClockFrmObjGetLocFmtKey(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+
+MODULE_SCOPE ClockFmtScnStorage *
+ Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+MODULE_SCOPE Tcl_Obj *
+ ClockLocalizeFormat(ClockFmtScnCmdArgs *opts);
+
+MODULE_SCOPE int ClockScan(register DateInfo *info,
+ Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
+
+MODULE_SCOPE int ClockFormat(register DateFormat *dateFmt,
+ ClockFmtScnCmdArgs *opts);
+
+MODULE_SCOPE void ClockFrmScnClearCaches(void);
+
+#endif /* _TCLCLOCK_H */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 32234a3..26ab9de 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1955,6 +1955,60 @@ 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 *
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DictExistsCmd --
*
* This function implements the "dict exists" Tcl command. See the user
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index dfffe12..1369cba 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -353,6 +353,14 @@ TclNamespaceEnsembleCmd(
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
Tcl_SetEnsembleParameterList(interp, token, paramObj);
+ /*
+ * Ensemble should be compiled if it has map (performance purposes)
+ * Currently only for internal using namespace (like ::tcl::clock).
+ * (An enhancement for completelly compile-feature is in work.)
+ */
+ if (mapObj != NULL && strncmp("::tcl::", nsPtr->fullName, 7) == 0) {
+ Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE);
+ }
/*
* Tricky! Must ensure that the result is not shared (command delete
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 40ced17..9fec06a 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -17,6 +17,11 @@
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
+
+/* MODULE_SCOPE */
+size_t 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
@@ -372,6 +377,7 @@ Tcl_PutEnv(
value[0] = '\0';
TclSetEnv(name, value+1);
}
+ TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
@@ -580,6 +586,7 @@ EnvTraceProc(
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
+ TclEnvEpoch++;
return NULL;
}
@@ -600,6 +607,7 @@ EnvTraceProc(
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
+ TclEnvEpoch++;
}
/*
@@ -623,6 +631,7 @@ EnvTraceProc(
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
+ TclEnvEpoch++;
}
return NULL;
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index da4c3fd..f25f45b 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.
@@ -45,78 +46,20 @@
#pragma warning( disable : 4102 )
#endif /* _MSC_VER */
+#if 0
+#define YYDEBUG 1
+#endif
+
/*
* yyparse will accept a 'struct DateInfo' as its parameter; that's where the
* 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)))
-#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
@@ -150,14 +93,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 +111,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*);
%}
@@ -191,14 +124,16 @@ MODULE_SCOPE int yyparse(DateInfo*);
%token tMONTH_UNIT
%token tSTARDATE
%token tSEC_UNIT
-%token tSNUMBER
%token tUNUMBER
%token tZONE
+%token tZONEwO4
+%token tZONEwO2
%token tEPOCH
%token tDST
%token tISOBASE
%token tDAY_UNIT
%token tNEXT
+%token SP
%type <Number> tDAY
%type <Number> tDAYZONE
@@ -206,9 +141,11 @@ MODULE_SCOPE int yyparse(DateInfo*);
%type <Number> tMONTH_UNIT
%type <Number> tDST
%type <Number> tSEC_UNIT
-%type <Number> tSNUMBER
%type <Number> tUNUMBER
+%type <Number> INTNUM
%type <Number> tZONE
+%type <Number> tZONEwO4
+%type <Number> tZONEwO2
%type <Number> tISOBASE
%type <Number> tDAY_UNIT
%type <Number> unit
@@ -222,6 +159,7 @@ MODULE_SCOPE int yyparse(DateInfo*);
spec : /* NULL */
| spec item
+ | spec SP item
;
item : time {
@@ -266,29 +204,12 @@ time : tUNUMBER tMERIDIAN {
yySeconds = 0;
yyMeridian = $4;
}
- | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($5 % 100 + ($5 / 100) * 60);
- ++yyHaveZone;
- }
| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
yyHour = $1;
yyMinutes = $3;
yySeconds = $5;
yyMeridian = $6;
}
- | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
- yyHour = $1;
- yyMinutes = $3;
- yySeconds = $5;
- yyMeridian = MER24;
- yyDSTmode = DSToff;
- yyTimezone = ($7 % 100 + ($7 / 100) * 60);
- ++yyHaveZone;
- }
;
zone : tZONE tDST {
@@ -303,27 +224,53 @@ zone : tZONE tDST {
yyTimezone = $1;
yyDSTmode = DSTon;
}
+ | tZONEwO4 sign INTNUM { /* GMT+0100, GMT-1000, etc. */
+ yyTimezone = $1 - $2*($3 % 100 + ($3 / 100) * 60);
+ yyDSTmode = DSToff;
+ }
+ | tZONEwO2 sign INTNUM { /* GMT+1, GMT-10, etc. */
+ yyTimezone = $1 - $2*($3 * 60);
+ yyDSTmode = DSToff;
+ }
+ | sign INTNUM { /* +0100, -0100 */
+ yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60);
+ yyDSTmode = DSToff;
+ }
+ ;
+
+comma : ','
+ | ',' SP
;
day : tDAY {
yyDayOrdinal = 1;
- yyDayNumber = $1;
+ yyDayOfWeek = $1;
+ info->flags |= CLF_DAYOFWEEK;
}
- | tDAY ',' {
+ | tDAY comma {
yyDayOrdinal = 1;
- yyDayNumber = $1;
+ yyDayOfWeek = $1;
+ info->flags |= CLF_DAYOFWEEK;
}
| tUNUMBER tDAY {
yyDayOrdinal = $1;
- yyDayNumber = $2;
+ yyDayOfWeek = $2;
+ info->flags |= CLF_DAYOFWEEK;
+ }
+ | sign SP tUNUMBER tDAY {
+ yyDayOrdinal = $1 * $3;
+ yyDayOfWeek = $4;
+ info->flags |= CLF_DAYOFWEEK;
}
| sign tUNUMBER tDAY {
yyDayOrdinal = $1 * $2;
- yyDayNumber = $3;
+ yyDayOfWeek = $3;
+ info->flags |= CLF_DAYOFWEEK;
}
| tNEXT tDAY {
yyDayOrdinal = 2;
- yyDayNumber = $2;
+ yyDayOfWeek = $2;
+ info->flags |= CLF_DAYOFWEEK;
}
;
@@ -355,7 +302,7 @@ date : tUNUMBER '/' tUNUMBER {
yyMonth = $1;
yyDay = $2;
}
- | tMONTH tUNUMBER ',' tUNUMBER {
+ | tMONTH tUNUMBER comma tUNUMBER {
yyMonth = $1;
yyDay = $2;
yyYear = $4;
@@ -377,17 +324,17 @@ 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;
}
;
iso : tISOBASE tZONE tISOBASE {
- if ($2 != HOUR( 7)) YYABORT;
+ if ($2 != HOUR( 7)) YYABORT; /* T */
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
@@ -395,8 +342,24 @@ iso : tISOBASE tZONE tISOBASE {
yyMinutes = ($3 % 10000)/100;
yySeconds = $3 % 100;
}
+ | tISOBASE tISOBASE {
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ yyHour = $2 / 10000;
+ yyMinutes = ($2 % 10000)/100;
+ yySeconds = $2 % 100;
+ }
+ | tISOBASE SP tUNUMBER ':' tUNUMBER ':' tUNUMBER {
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ yyHour = $3;
+ yyMinutes = $5;
+ yySeconds = $7;
+ }
| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
- if ($2 != HOUR( 7)) YYABORT;
+ if ($2 != HOUR( 7)) YYABORT; /* T */
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
@@ -404,17 +367,17 @@ iso : tISOBASE tZONE tISOBASE {
yyMinutes = $5;
yySeconds = $7;
}
- | tISOBASE tISOBASE {
+ | tISOBASE SP tISOBASE {
yyYear = $1 / 10000;
yyMonth = ($1 % 10000)/100;
yyDay = $1 % 100;
- yyHour = $2 / 10000;
- yyMinutes = ($2 % 10000)/100;
- yySeconds = $2 % 100;
+ yyHour = $3 / 10000;
+ yyMinutes = ($3 % 10000)/100;
+ yySeconds = $3 % 100;
}
;
-trek : tSTARDATE tUNUMBER '.' tUNUMBER {
+trek : tSTARDATE INTNUM '.' tUNUMBER {
/*
* Offset computed year by -377 so that the returned years will be
* in a range accessible with a 32 bit clock seconds value.
@@ -436,16 +399,19 @@ relspec : relunits tAGO {
| relunits
;
-relunits : sign tUNUMBER unit {
+relunits : sign SP INTNUM unit {
+ *yyRelPointer += $1 * $3 * $4;
+ }
+ | sign INTNUM unit {
*yyRelPointer += $1 * $2 * $3;
}
- | tUNUMBER unit {
+ | INTNUM unit {
*yyRelPointer += $1 * $2;
}
| tNEXT unit {
*yyRelPointer += $2;
}
- | tNEXT tUNUMBER unit {
+ | tNEXT INTNUM unit {
*yyRelPointer += $2 * $3;
}
| unit {
@@ -475,7 +441,15 @@ unit : tSEC_UNIT {
}
;
-number : tUNUMBER {
+INTNUM : tUNUMBER {
+ $$ = $1;
+ }
+ | tISOBASE {
+ $$ = $1;
+ }
+ ;
+
+number : INTNUM {
if (yyHaveTime && yyHaveDate && !yyHaveRel) {
yyYear = $1;
} else {
@@ -619,6 +593,8 @@ static const TABLE TimezoneTable[] = {
{ "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */
{ "yst", tZONE, HOUR( 9) }, /* Yukon Standard */
{ "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */
+ { "akst", tZONE, HOUR( 9) }, /* Alaska Standard */
+ { "akdt", tDAYZONE, HOUR( 9) }, /* Alaska Daylight */
{ "hst", tZONE, HOUR(10) }, /* Hawaii Standard */
{ "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */
{ "cat", tZONE, HOUR(10) }, /* Central Alaska */
@@ -703,6 +679,18 @@ static const TABLE MilitaryTable[] = {
{ NULL, 0, 0 }
};
+static inline const char *
+bypassSpaces(
+ register const char *s)
+{
+ if (isspace(UCHAR(*s))) {
+ do {
+ s++;
+ } while (isspace(UCHAR(*s)));
+ }
+ return s;
+}
+
/*
* Dump error messages in the bit bucket.
*/
@@ -730,11 +718,11 @@ TclDateerror(
infoPtr->separatrix = "\n";
}
-static time_t
+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) {
@@ -776,11 +764,11 @@ LookupWord(
Tcl_UtfToLower(buff);
- if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
+ if (*buff == 'a' && (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0)) {
yylvalPtr->Meridian = MERam;
return tMERIDIAN;
}
- if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
+ if (*buff == 'p' && (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0)) {
yylvalPtr->Meridian = MERpm;
return tMERIDIAN;
}
@@ -897,29 +885,38 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (isspace(UCHAR(*yyInput))) {
- yyInput++;
+
+ if (isspace(UCHAR(*yyInput))) {
+ yyInput = bypassSpaces(yyInput);
+ /* ignore space at end of text and before some words */
+ c = *yyInput;
+ if (c != '\0' && !isalpha(UCHAR(c))) {
+ return SP;
+ }
}
if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+
/*
* Convert the string into a number; count the number of digits.
*/
-
- Count = 0;
- for (yylvalPtr->Number = 0;
- isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
- yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
- Count++;
- }
- yyInput--;
- yyDigitCount = Count;
-
+ register int num = c - '0';
+ p = (char *)yyInput;
+ while (isdigit(UCHAR(c = *(++p)))) {
+ num *= 10;
+ num += c - '0';
+ };
+ yylvalPtr->Number = num;
+ yyDigitCount = p - yyInput;
+ yyInput = p;
+
+ /* ignore spaces after digits (optional) */
+ yyInput = bypassSpaces(yyInput);
/*
* A number with 6 or more digits is considered an ISO 8601 base.
*/
- if (Count >= 6) {
+ if (yyDigitCount >= 6) {
location->last_column = yyInput - info->dateStart - 1;
return tISOBASE;
} else {
@@ -928,6 +925,7 @@ TclDatelex(
}
}
if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ int ret;
for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
|| c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
@@ -937,7 +935,30 @@ TclDatelex(
*p = '\0';
yyInput--;
location->last_column = yyInput - info->dateStart - 1;
- return LookupWord(yylvalPtr, buff);
+ ret = LookupWord(yylvalPtr, buff);
+ /*
+ * lookahead for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day",
+ * bypass spaces after token (but ignore by TZ+OFFS), because should
+ * recognize next SP token, if TZ only.
+ */
+ if (ret == tZONE || ret == tDAYZONE) {
+ c = *yyInput;
+ if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) {
+ if ( !isdigit(UCHAR(*(yyInput+2)))
+ || !isdigit(UCHAR(*(yyInput+3)))) {
+ /* GMT+1, GMT-10, etc. */
+ return tZONEwO2;
+ }
+ if ( isdigit(UCHAR(*(yyInput+4)))
+ && !isdigit(UCHAR(*(yyInput+5)))) {
+ /* GMT+1000, etc. */
+ return tZONEwO4;
+ }
+ }
+ }
+ yyInput = bypassSpaces(yyInput);
+ return ret;
+
}
if (c != '(') {
location->last_column = yyInput - info->dateStart;
@@ -957,65 +978,46 @@ 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;
-
- 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;
+ #if YYDEBUG
+ /* enable debugging if compiled with YYDEBUG */
+ yydebug = 1;
+ #endif
- yyHaveZone = 0;
- yyTimezone = 0; yyDSTmode = DSTmaybe;
+ /*
+ * yyInput = stringToParse;
+ *
+ * ClockInitDateInfo(info) should be executed to pre-init info;
+ */
- yyHaveOrdinalMonth = 0;
- yyMonthOrdinal = 0;
+ yyDSTmode = DSTmaybe;
- yyHaveDay = 0;
- yyDayOrdinal = 0; yyDayNumber = 0;
+ info->messages = Tcl_NewObj();
+ info->separatrix = "";
+ Tcl_IncrRefCount(info->messages);
- yyHaveRel = 0;
- yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+ info->dateStart = yyInput;
- dateInfo.messages = Tcl_NewObj();
- dateInfo.separatrix = "";
- Tcl_IncrRefCount(dateInfo.messages);
+ /* ignore spaces at begin */
+ yyInput = bypassSpaces(yyInput);
- status = yyparse(&dateInfo);
+ /* parse */
+ 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 +1025,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,64 +1062,6 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
- result = Tcl_NewObj();
- resultElement = Tcl_NewObj();
- if (yyHaveDate) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyYear));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDay));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- if (yyHaveTime) {
- Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
- ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
- } else {
- Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
- }
-
- resultElement = Tcl_NewObj();
- if (yyHaveZone) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) -yyTimezone));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj(1 - yyDSTmode));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveRel) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelMonth));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelDay));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyRelSeconds));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveDay && !yyHaveDate) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDayOrdinal));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyDayNumber));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- resultElement = Tcl_NewObj();
- if (yyHaveOrdinalMonth) {
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonthOrdinal));
- Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
- }
- Tcl_ListObjAppendElement(interp, result, resultElement);
-
- Tcl_SetObjResult(interp, result);
return TCL_OK;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 03cb5ae..bcd3b83 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2911,6 +2911,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,
@@ -3200,10 +3201,22 @@ MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclFinalizeThreadDataThread(void);
MODULE_SCOPE void TclFinalizeThreadStorage(void);
+
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
+MODULE_SCOPE double TclpWideClickInMicrosec(void);
+#else
+# ifdef _WIN32
+# define TCL_WIDE_CLICKS 1
+MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
+MODULE_SCOPE double TclpWideClickInMicrosec(void);
+# define TclpWideClicksToNanoseconds(clicks) \
+ ((double)(clicks) * TclpWideClickInMicrosec() * 1000)
+# endif
#endif
+MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
+
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
@@ -3473,6 +3486,9 @@ MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -4928,6 +4944,13 @@ typedef struct NRE_callback {
#define Tcl_Free(ptr) TclpFree(ptr)
#endif
+/*
+ * Other externals.
+ */
+
+MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
+ * (if changed with tcl-env). */
+
#endif /* _TCLINT */
/*
diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c
new file mode 100644
index 0000000..88a64c6
--- /dev/null
+++ b/generic/tclStrIdxTree.c
@@ -0,0 +1,528 @@
+/*
+ * 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 0 * ...
+ * anuar 1 *
+ * u 0 * a 0
+ * ni 6 * pril 4
+ * li 7 * ugust 8
+ * n 0 * gt 8
+ * r 1 * s 9
+ * i 6 * eptember 9
+ * li 7 * pt 9
+ * f 2 * oktober 10
+ * ebruar 2 * n 11
+ * br 2 * ovember 11
+ * m 0 * vb 11
+ * a 0 * d 12
+ * erz 3 * ezember 12
+ * i 5 * zb 12
+ * rz 3 *
+ * ...
+ *
+ * Thereby value 0 shows pure group items (corresponding ambigous matches).
+ * But the group may have a value if it contains only same values
+ * (see for example group "f" above).
+ *
+ * StrIdxTree's are very fast, so:
+ * build of above-mentioned tree takes about 10 microseconds.
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const char*
+TclStrIdxTreeSearch(
+ TclStrIdxTree **foundParent, /* Return value of found sub tree (used for tree build) */
+ TclStrIdx **foundItem, /* Return value of found item */
+ TclStrIdxTree *tree, /* Index tree will be browsed */
+ const char *start, /* UTF string to find in tree */
+ const char *end) /* End of string */
+{
+ TclStrIdxTree *parent = tree, *prevParent = tree;
+ TclStrIdx *item = tree->firstPtr, *prevItem = NULL;
+ const char *s = start, *f, *cin, *cinf, *prevf = NULL;
+ int offs = 0;
+
+ if (item == NULL) {
+ goto done;
+ }
+
+ /* search in tree */
+ do {
+ cinf = cin = TclGetString(item->key) + offs;
+ f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf);
+ /* if something was found */
+ if (f > s) {
+ /* if whole string was found */
+ if (f >= end) {
+ start = f;
+ goto done;
+ };
+ /* set new offset and shift start string */
+ offs += cinf - cin;
+ s = f;
+ /* if match item, go deeper as long as possible */
+ if (offs >= item->length && item->childTree.firstPtr) {
+ /* save previuosly found item (if not ambigous) for
+ * possible fallback (few greedy match) */
+ if (item->value != NULL) {
+ prevf = f;
+ prevItem = item;
+ prevParent = parent;
+ }
+ parent = &item->childTree;
+ item = item->childTree.firstPtr;
+ continue;
+ }
+ /* no children - return this item and current chars found */
+ start = f;
+ goto done;
+ }
+
+ item = item->nextPtr;
+
+ } while (item != NULL);
+
+ /* fallback (few greedy match) not ambigous (has a value) */
+ if (prevItem != NULL) {
+ item = prevItem;
+ parent = prevParent;
+ start = prevf;
+ }
+
+done:
+
+ if (foundParent)
+ *foundParent = parent;
+ if (foundItem)
+ *foundItem = item;
+ return start;
+}
+
+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
+ */
+static 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;
+}
+
+static 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.
+ * If the values not given the values of built list are indices starts with 1.
+ * Value of 0 is thereby reserved to the ambigous values.
+ *
+ * Important: by multiple lists, optimal tree can be created only if list with
+ * larger strings used firstly.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStrIdxTreeBuildFromList(
+ TclStrIdxTree *idxTree,
+ int lstc,
+ Tcl_Obj **lstv,
+ ClientData *values)
+{
+ Tcl_Obj **lwrv;
+ int i, ret = TCL_ERROR;
+ ClientData val;
+ 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;
+ val = values ? values[i] : INT2PTR(i+1);
+
+ /* ignore empty keys (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 == val
+ && foundItem->length <= lwrv[i]->length
+ && foundItem->length <= (f - s) /* only if found item is covered in full */
+ && 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 == val) ? val : NULL;
+ /* 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 = val;
+ 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 */
+};
+
+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 = &tclEmptyString;
+};
+
+TclStrIdxTree *
+TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) {
+ /* follow links (smart pointers) */
+ if (objPtr->typePtr != &StrIdxTreeObjType) {
+ return NULL;
+ }
+ if ( objPtr->internalRep.twoPtrValue.ptr1 != NULL
+ && objPtr->internalRep.twoPtrValue.ptr2 == NULL
+ ) {
+ objPtr = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr1;
+ }
+ /* return tree root in internal representation */
+ return (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1;
+}
+
+/*
+ * Several debug primitives
+ */
+#if 0
+/* currently unused, debug resp. test purposes only */
+
+void
+TclStrIdxTreePrint(
+ Tcl_Interp *interp,
+ TclStrIdx *tree,
+ int offs)
+{
+ Tcl_Obj *obj[2];
+ const char *s;
+ Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1));
+ while (tree != NULL) {
+ s = TclGetString(tree->key) + offs;
+ Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d",
+ offs, "", tree->length - offs, s, tree->value));
+ Tcl_PutsObjCmd(NULL, interp, 2, obj);
+ Tcl_UnsetObjRef(obj[1]);
+ if (tree->childTree.firstPtr != NULL) {
+ TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length);
+ }
+ tree = tree->nextPtr;
+ }
+ Tcl_UnsetObjRef(obj[0]);
+}
+
+
+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_WrongNumArgs(interp, 1, objv, "");
+ 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_WrongNumArgs(interp, 1, objv, "");
+ 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, NULL);
+ }
+ 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..6ed5170
--- /dev/null
+++ b/generic/tclStrIdxTree.h
@@ -0,0 +1,169 @@
+/*
+ * tclStrIdxTree.h --
+ *
+ * Declarations of string index tries and other primitives currently
+ * back-ported from tclSE.
+ *
+ * Copyright (c) 2016 Serg G. Brester (aka sebres)
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLSTRIDXTREE_H
+#define _TCLSTRIDXTREE_H
+
+
+/*
+ * Main structures declarations of index tree and entry
+ */
+
+typedef struct TclStrIdxTree {
+ struct TclStrIdx *firstPtr;
+ struct TclStrIdx *lastPtr;
+} TclStrIdxTree;
+
+typedef struct TclStrIdx {
+ struct TclStrIdxTree childTree;
+ struct TclStrIdx *nextPtr;
+ struct TclStrIdx *prevPtr;
+ Tcl_Obj *key;
+ int length;
+ ClientData value;
+} TclStrIdx;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUtfFindEqual, TclUtfFindEqualNC --
+ *
+ * Find largest part of string cs in string cin (case sensitive and not).
+ *
+ * Results:
+ * Return position of UTF character in cs after last equal character.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline const char *
+TclUtfFindEqual(
+ register const char *cs, /* UTF string to find in cin. */
+ register const char *cse, /* End of cs */
+ register const char *cin, /* UTF string will be browsed. */
+ register const char *cine) /* End of cin */
+{
+ register const char *ret = cs;
+ Tcl_UniChar ch1, ch2;
+ do {
+ cs += TclUtfToUniChar(cs, &ch1);
+ cin += TclUtfToUniChar(cin, &ch2);
+ if (ch1 != ch2) break;
+ } while ((ret = cs) < cse && cin < cine);
+ return ret;
+}
+
+static inline const char *
+TclUtfFindEqualNC(
+ register const char *cs, /* UTF string to find in cin. */
+ register const char *cse, /* End of cs */
+ register const char *cin, /* UTF string will be browsed. */
+ register const char *cine, /* End of cin */
+ const char **cinfnd) /* Return position in cin */
+{
+ register const char *ret = cs;
+ Tcl_UniChar ch1, ch2;
+ do {
+ cs += TclUtfToUniChar(cs, &ch1);
+ cin += TclUtfToUniChar(cin, &ch2);
+ if (ch1 != ch2) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ ch2 = Tcl_UniCharToLower(ch2);
+ if (ch1 != ch2) break;
+ }
+ *cinfnd = cin;
+ } while ((ret = cs) < cse && cin < cine);
+ return ret;
+}
+
+static inline const char *
+TclUtfFindEqualNCInLwr(
+ register const char *cs, /* UTF string (in anycase) to find in cin. */
+ register const char *cse, /* End of cs */
+ register const char *cin, /* UTF string (in lowercase) will be browsed. */
+ register const char *cine, /* End of cin */
+ const char **cinfnd) /* Return position in cin */
+{
+ register const char *ret = cs;
+ Tcl_UniChar ch1, ch2;
+ do {
+ cs += TclUtfToUniChar(cs, &ch1);
+ cin += TclUtfToUniChar(cin, &ch2);
+ if (ch1 != ch2) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ if (ch1 != ch2) break;
+ }
+ *cinfnd = cin;
+ } while ((ret = cs) < cse && cin < cine);
+ return ret;
+}
+
+static inline const char *
+TclUtfNext(
+ register const char *src) /* The current location in the string. */
+{
+ if (((unsigned char) *(src)) < 0xC0) {
+ return ++src;
+ } else {
+ Tcl_UniChar ch;
+ return src + TclUtfToUniChar(src, &ch);
+ }
+}
+
+
+/*
+ * Primitives to safe set, reset and free references.
+ */
+
+#define Tcl_UnsetObjRef(obj) \
+ if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; }
+#define Tcl_InitObjRef(obj, val) \
+ obj = val; if (obj) { Tcl_IncrRefCount(obj); }
+#define Tcl_SetObjRef(obj, val) \
+if (1) { \
+ Tcl_Obj *nval = val; \
+ if (obj != nval) { \
+ Tcl_Obj *prev = obj; \
+ Tcl_InitObjRef(obj, nval); \
+ if (prev != NULL) { Tcl_DecrRefCount(prev); }; \
+ } \
+}
+
+/*
+ * Prototypes of module functions.
+ */
+
+MODULE_SCOPE const char*
+ TclStrIdxTreeSearch(TclStrIdxTree **foundParent,
+ TclStrIdx **foundItem, TclStrIdxTree *tree,
+ const char *start, const char *end);
+
+MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree,
+ int lstc, Tcl_Obj **lstv, ClientData *values);
+
+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/library/clock.tcl b/library/clock.tcl
index 8e4b657..330c185 100644
--- 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.
#
@@ -22,7 +23,15 @@ uplevel \#0 {
package require msgcat 1.6
if { $::tcl_platform(platform) eq {windows} } {
if { [catch { package require registry 1.1 }] } {
- namespace eval ::tcl::clock [list variable NoRegistry {}]
+ # try to load registry directly from root (if uninstalled / development env):
+ if {![regexp {[/\\]library$} [info library]] || [catch {
+ load [lindex \
+ [glob -tails -directory [file dirname [info nameofexecutable]] \
+ tclreg*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \
+ ] registry
+ }]} {
+ namespace eval ::tcl::clock [list variable NoRegistry {}]
+ }
}
}
}
@@ -31,7 +40,7 @@ uplevel \#0 {
# library code can find message catalogs and time zone definition files.
namespace eval ::tcl::clock \
- [list variable LibDir [file dirname [info script]]]
+ [list variable LibDir [info library]]
#----------------------------------------------------------------------
#
@@ -58,9 +67,7 @@ namespace eval ::tcl::clock {
# Import the message catalog commands that we use.
- namespace import ::msgcat::mcload
namespace import ::msgcat::mclocale
- namespace import ::msgcat::mc
namespace import ::msgcat::mcpackagelocale
}
@@ -287,6 +294,13 @@ proc ::tcl::clock::Initialize {} {
variable FEB_28 58
+ # Default configuration
+
+ configure -current-locale [mclocale]
+ #configure -default-locale C
+ #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
# to specify $::env(TCL_TZ) rather than simply depending on the system
@@ -383,152 +397,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 \
@@ -554,6 +422,8 @@ proc ::tcl::clock::Initialize {} {
pdt -0700 \
yst -0900 \
ydt -0800 \
+ akst -0900 \
+ akdt -0800 \
hst -1000 \
hdt -0900 \
cat -1000 \
@@ -623,17 +493,10 @@ proc ::tcl::clock::Initialize {} {
# Caches
- variable LocaleNumeralCache {}; # 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 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
+ variable LocaleFormats \
+ [dict create]; # Dictionary with localized formats
+
+ 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.
@@ -642,1647 +505,142 @@ 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
+
+ variable mcLocales [dict create]; # Dictionary with loaded locales
+ variable mcMergedCat [dict create]; # Dictionary with merged locale catalogs
}
::tcl::clock::Initialize
#----------------------------------------------------------------------
-#
-# 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::format { args } {
-
- variable FormatProc
- variable TZData
-
- lassign [ParseFormatArgs {*}$args] format locale timezone
- set locale [string tolower $locale]
- set clockval [lindex $args 0]
-
- # Get the data for time changes in the given zone
-
- if {$timezone eq ""} {
- set timezone [GetSystemTimeZone]
- }
- if {![info exists TZData($timezone)]} {
- if {[catch {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.
-
- 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]
-
-}
-
-#----------------------------------------------------------------------
+# mcget --
#
-# ParseClockFormatFormat --
+# Return the merged translation catalog for the ::tcl::clock namespace
+# Searching of catalog is similar to "msgcat::mc".
#
-# Builds and caches a procedure that formats a time value.
+# Contrary to "msgcat::mc" may additionally load a package catalog
+# on demand.
#
-# Parameters:
-# format -- Format string to use
-# locale -- Locale in which the format string is to be interpreted
+# Arguments:
+# loc The locale used for translation.
#
# Results:
-# Returns the name of the newly-built procedure.
+# Returns the dictionary object as whole catalog of the package/locale.
#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
-
- if {[namespace which $procName] ne {}} {
- return $procName
+proc ::tcl::clock::mcget {loc} {
+ variable mcMergedCat
+ switch -- $loc system {
+ set loc [GetSystemLocale]
+ } current {
+ set loc [mclocale]
}
-
- # Map away the locale-dependent composite format groups
-
- 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 \
- $TZData($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
- }
- }
- }
- }
+ if {$loc ne {}} {
+ set loc [string tolower $loc]
}
- # Clean up any improperly terminated groups
-
- switch -exact -- $state {
- percent {
- append formatString %%
- }
- percentE {
- append retval %%E
- }
- percentO {
- append retval %%O
- }
+ # try to retrieve now if already available:
+ if {[dict exists $mcMergedCat $loc]} {
+ return [dict get $mcMergedCat $loc]
}
- 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::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
- 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
- }
-
- 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
-
- 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
- }
+ # get locales list for given locale (de_de -> {de_de de {}})
+ variable mcLocales
+ if {[dict exists $mcLocales $loc]} {
+ set loclist [dict get $mcLocales $loc]
+ } else {
+ # save current locale:
+ set prevloc [mclocale]
+ # lazy load catalog on demand (set it will load the catalog)
+ mcpackagelocale set $loc
+ set loclist [msgcat::GetPreferences $loc]
+ dict set $mcLocales $loc $loclist
+ # restore:
+ if {$prevloc ne $loc} {
+ mcpackagelocale set $prevloc
+ }
+ }
+ # get whole catalog:
+ mcMerge $loclist
}
-#----------------------------------------------------------------------
-#
-# FreeScan --
+# mcMerge --
#
-# Scans a time in free format
+# Merge message catalog dictionaries to one dictionary.
#
-# 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.
+# Arguments:
+# locales List of locales to merge.
#
# Results:
-# Returns the date and time extracted from the string in seconds from
-# the epoch
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::FreeScan { string base timezone locale } {
-
- variable TZData
-
- # Get the data for time changes in the given zone
-
- 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 } {
- if { $y >= 39 } {
- 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
+# Returns the (weak pointer) to merged dictionary of message catalog.
+#
+proc ::tcl::clock::mcMerge {locales} {
+ variable mcMergedCat
+ if {[dict exists $mcMergedCat [set loc [lindex $locales 0]]]} {
+ return [dict get $mcMergedCat $loc]
+ }
+ # package msgcat currently does not provide possibility to get whole catalog:
+ upvar ::msgcat::Msgs Msgs
+ set ns ::tcl::clock
+ # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
+ if {[llength $locales] > 1} {
+ set mrgcat [mcMerge [lrange $locales 1 end]]
+ if {[dict exists $Msgs $ns $loc]} {
+ set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
}
- }
-
- # 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 {
+ if {[dict exists $Msgs $ns $loc]} {
+ set mrgcat [dict get $Msgs $ns $loc]
} 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]
-#
-# Parameters:
-# formatString - The format being parsed
-# locale - The current locale
-#
-# 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]
-#
-# 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.
-#
-#----------------------------------------------------------------------
-
-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 {
- ::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
-
- append procBody {
- set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
- $TZData($timeZone) $changeover]
- }
- }
-
- # 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
-}
-
-#----------------------------------------------------------------------
-#
-# 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.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::LocaleNumeralMatcher {l} {
- variable LocaleNumeralCache
-
- 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
+ set mrgcat [dict create]
}
- append re \)
- dict set LocaleNumeralCache $l [list $re $d]
}
- return [dict get $LocaleNumeralCache $l]
+ dict set mcMergedCat $loc $mrgcat
+ # return smart reference (shared dict as object with exact one ref-counter)
+ return $mrgcat
}
-
-
#----------------------------------------------------------------------
#
-# UniquePrefixRegexp --
+# GetSystemLocale --
#
-# Composes a regexp that performs unique-prefix matching. The RE
-# matches one of a supplied set of strings, or any unique prefix
-# thereof.
+# Determines the system locale, which corresponds to "system"
+# keyword for locale parameter of 'clock' command.
#
# 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'.
+# Returns the system locale.
#
# Side effects:
-# None.
+# 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.
+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
- set re {}
- if {
- [dict exists $uniquePrefixMapping $prefixString]
- || [llength $schars] > 1
- } then {
- append re "(?:"
+ return [mclocale]
}
- # Generate a regexp that matches the successors.
+ # 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
- set sep ""
- foreach { c } $schars {
- set nextPrefix $prefixString$c
- regsub -all {[^[:alnum:]]} $c \\\\& rechar
- append re $sep $rechar \
- [MakeUniquePrefixRegexp \
- $successors $uniquePrefixMapping $nextPrefix]
- set sep |
- }
+ mcpackagelocale set [mclocale]
- # 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.
+ # Make a new locale string for the system locale, and get the
+ # Control Panel information
- if { [dict exists $uniquePrefixMapping $prefixString] } {
- append re ")?"
- } elseif { [llength $schars] > 1 } {
- append re ")"
+ set locale [mclocale]_windows
+ if { ! [mcpackagelocale present $locale] } {
+ LoadWindowsDateTimeFormats $locale
}
- 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
+ return $locale
}
#----------------------------------------------------------------------
@@ -2303,34 +661,14 @@ 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
+ return $locale
}
#----------------------------------------------------------------------
@@ -2480,485 +818,64 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::LocalizeFormat { locale format } {
-
- # message catalog key to cache this format
- set key FORMAT_$format
-
- 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}
- }
- 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
-}
-
-#----------------------------------------------------------------------
-#
-# 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
+proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
+ variable LocaleFormats
- # Build a tentative date from year and fraction.
+ if { $fmtkey eq {} } { set fmtkey FMT_$format }
+ if { [catch {
+ set locfmt [dict get $LocaleFormats $locale $fmtkey]
+ }] } {
- set date [dict create \
- gregorian 1 \
- era CE \
- year [expr { $year + $Roddenberry }] \
- dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
- set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
+ # get map list cached or build it:
+ if { [catch {
+ set mlst [dict get $LocaleFormats $locale MLST]
+ }] } {
- # Determine whether the given year is a leap year
+ # message catalog dictionary:
+ set mcd [mcget $locale]
- set lp [IsGregorianLeapYear $date]
+ # 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.
- # Reconvert the fractional year according to whether the given year is a
- # leap year
+ 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]]
- 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
- }]
-}
+ dict set LocaleFormats $locale MLST $mlst
+ }
-#----------------------------------------------------------------------
-#
-# 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.
-#
-#----------------------------------------------------------------------
+ # 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]]
-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"
+ # cache it:
+ dict set LocaleFormats $locale $fmtkey $locfmt
}
- 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 <= 37 } {
- dict set date $fourDigitField [expr { $yr + 2000 }]
- } else {
- dict set date $fourDigitField [expr { $yr + 1900 }]
+ # 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 $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 $TZData($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 $TZData($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 $TZData($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 $TZData($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
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseJulianDay --
-#
-# Determines the base day for a time-of-day conversion.
-#
-# 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.
-#
-# Results:
-# Returns the given dictionary augmented with a 'julianDay' field
-# that contains the base day.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
- variable TZData
-
- # Find the Julian Day Number corresponding to the base time
-
- set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
- dict set date julianDay [dict get $date2 julianDay]
-
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# InterpretHMSP --
-#
-# Interprets a time in the form "hh:mm:ss am".
-#
-# Parameters:
-# date -- Dictionary containing "hourAMPM", "minute", "second"
-# and "amPmIndicator" fields.
-#
-# Results:
-# Returns the number of seconds from local midnight.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::InterpretHMSP { date } {
- set hr [dict get $date hourAMPM]
- if { $hr == 12 } {
- set hr 0
- }
- if { [dict get $date amPmIndicator] } {
- incr hr 12
- }
- dict set date hour $hr
- return [InterpretHMS $date[set date {}]]
-}
-
-#----------------------------------------------------------------------
-#
-# InterpretHMS --
-#
-# Interprets a 24-hour time "hh:mm:ss"
-#
-# Parameters:
-# date -- Dictionary containing the "hour", "minute" and "second"
-# fields.
-#
-# Results:
-# Returns the given dictionary augmented with a "secondOfDay"
-# field containing the number of seconds from local midnight.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-proc ::tcl::clock::InterpretHMS { date } {
- return [expr {
- ( [dict get $date hour] * 60
- + [dict get $date minute] ) * 60
- + [dict get $date second]
- }]
+ return $locfmt
}
#----------------------------------------------------------------------
@@ -2975,13 +892,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 {}} {
@@ -2990,61 +906,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}]
- }
- if { [dict get $TimeZoneBad $timezone] } {
- return :localtime
- } else {
- return $timezone
+ catch {set timezone [SetupTimeZone $timezone]}
}
-}
-#----------------------------------------------------------------------
-#
-# 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?
-#
-#----------------------------------------------------------------------
+ if { [dict exists $TimeZoneBad $timezone] } {
+ set timezone :localtime
+ }
-proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
- variable LegacyTimeZone
+ # tell backend - current system timezone:
+ configure -system-tz $timezone
- 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]
+ return $timezone
}
#----------------------------------------------------------------------
@@ -3064,10 +952,17 @@ proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::SetupTimeZone { timezone } {
+proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
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
@@ -3105,6 +1000,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"
@@ -3116,25 +1012,43 @@ 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
}
} else {
+
+ variable LegacyTimeZone
+
# 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"
}
set TZData($timezone) $TZData(:$timezone)
}
}
- return
+ # tell backend - timezone is initialized and return shared timezone object:
+ configure -setup-tz $timezone
}
#----------------------------------------------------------------------
@@ -3205,12 +1119,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 {set tzname [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 \
@@ -3881,14 +1795,14 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
# Determine the start or end day of DST
- set date [dict create era CE year $y]
+ set date [dict create era CE year $y gregorian 1]
set doy [dict get $z ${bound}DayOfYear]
if { $doy ne {} } {
# Time was specified as a day of the year
if { [dict get $z ${bound}J] ne {}
- && [IsGregorianLeapYear $y]
+ && [IsGregorianLeapYear $date]
&& ( $doy > $FEB_28 ) } {
incr doy
}
@@ -3937,43 +1851,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
@@ -4151,331 +2028,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.
-#
-# 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 $result
- }
-
- set offsets {}
- set gmt 0
- set locale c
- 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 { [catch { expr { wide($clockval) } } result] } {
- return -code error "expected integer but got \"$clockval\""
- }
- 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 {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]
- }
-
- 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 $TZData($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 {}] $TZData($timezone) \
- $changeover]
-
- return [dict get $date seconds]
-
-}
-
-#----------------------------------------------------------------------
-#
-# 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 $TZData($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 {}] $TZData($timezone) \
- $changeover]
-
- return [dict get $date seconds]
-
-}
-
-#----------------------------------------------------------------------
-#
# ChangeCurrentLocale --
#
# The global locale was changed within msgcat.
@@ -4493,20 +2045,8 @@ 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 {}
- }
- foreach p [info procs [namespace current]::formatproc'*'current] {
- rename $p {}
- }
-
- catch {array unset FormatProc *'current}
- set LocaleNumeralCache {}
+ configure -current-locale [lindex $args 0]
}
#----------------------------------------------------------------------
@@ -4527,21 +2067,17 @@ proc ::tcl::clock::ChangeCurrentLocale {args} {
#----------------------------------------------------------------------
proc ::tcl::clock::ClearCaches {} {
- variable FormatProc
- variable LocaleNumeralCache
- variable CachedSystemTimeZone
+ variable LocaleFormats
+ variable mcMergedCat
variable TimeZoneBad
- foreach p [info procs [namespace current]::scanproc'*] {
- rename $p {}
- }
- foreach p [info procs [namespace current]::formatproc'*] {
- rename $p {}
- }
+ # tell backend - should invalidate:
+ configure -clear
+
+ # clear msgcat cache:
+ set mcMergedCat [dict create]
- catch {unset FormatProc}
- set LocaleNumeralCache {}
- catch {unset CachedSystemTimeZone}
+ set LocaleFormats {}
set TimeZoneBad {}
InitTZData
}
diff --git a/library/init.tcl b/library/init.tcl
index 8952172..51acbf1 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -45,6 +45,7 @@ if {![info exists auto_path]} {
set auto_path ""
}
}
+
namespace eval tcl {
variable Dir
foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
@@ -66,12 +67,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
@@ -155,6 +156,17 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
if {[interp issafe]} {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
+ # Default known auto_index (avoid loading auto index implicit after interp create):
+
+ array set ::auto_index {
+ ::tcl::tm::UnknownHandler {source [info library]/tm.tcl}
+ ::tclPkgUnknown {source [info library]/package.tcl}
+ ::history {source [info library]/history.tcl}
+ }
+
+ # The newest possibility to load whole namespace:
+ array set ::auto_index_ns {}
+
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
if {$tcl_platform(os) eq "Darwin"
@@ -167,22 +179,21 @@ if {[interp issafe]} {
# Set up the 'clock' ensemble
- namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]
-
- proc ::tcl::initClock {} {
- # Auto-loading stubs for 'clock.tcl'
-
- foreach cmd {add format scan} {
- proc ::tcl::clock::$cmd args {
- variable TclLibDir
- source -encoding utf-8 [file join $TclLibDir clock.tcl]
- return [uplevel 1 [info level 0]]
- }
+ proc clock args {
+ set cmdmap [dict create]
+ foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
+ dict set cmdmap $cmd ::tcl::clock::$cmd
}
+ namespace inscope ::tcl::clock [list namespace ensemble create -command \
+ [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \
+ -map $cmdmap]
- rename ::tcl::initClock {}
+ uplevel 1 [info level 0]
}
- ::tcl::initClock
+ # Auto-loading stubs for 'clock.tcl'
+ set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock {
+ ::source -encoding utf-8 [::file join [info library] clock.tcl]
+ }}
}
# Conditionalize for presence of exec.
@@ -416,18 +427,22 @@ proc unknown args {
# for instance. If not given, namespace current is used.
proc auto_load {cmd {namespace {}}} {
- global auto_index auto_path
+ global auto_index auto_index_ns auto_path
+ # qualify names:
if {$namespace eq ""} {
set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
# workaround non canonical auto_index entries that might be around
# from older auto_mkindex versions
- lappend nameList $cmd
- foreach name $nameList {
+ if {$cmd ni $nameList} {lappend nameList $cmd}
+
+ # try to load (and create sub-cmd handler "_sub_load_cmd" for further usage):
+ foreach name $nameList [set _sub_load_cmd {
+ # via auto_index:
if {[info exists auto_index($name)]} {
- namespace eval :: $auto_index($name)
+ namespace inscope :: $auto_index($name)
# There's a couple of ways to look for a command of a given
# name. One is to use
# info commands $name
@@ -439,22 +454,31 @@ proc auto_load {cmd {namespace {}}} {
return 1
}
}
- }
+ # via auto_index_ns - resolver for the whole namespace loaders
+ if {[set ns [::namespace qualifiers $name]] ni {"" "::"} &&
+ [info exists auto_index_ns($ns)]
+ } {
+ # remove handler before loading (prevents several self-recursion cases):
+ set ldr $auto_index_ns($ns); unset auto_index_ns($ns)
+ namespace inscope :: $ldr
+ # if got it:
+ if {[namespace which -command $name] ne ""} {
+ return 1
+ }
+ }
+ }]
+
+ # load auto_index if possible:
if {![info exists auto_path]} {
return 0
}
-
if {![auto_load_index]} {
return 0
}
- foreach name $nameList {
- if {[info exists auto_index($name)]} {
- namespace eval :: $auto_index($name)
- if {[namespace which -command $name] ne ""} {
- return 1
- }
- }
- }
+
+ # try again (something new could be loaded):
+ foreach name $nameList $_sub_load_cmd
+
return 0
}
@@ -601,12 +625,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 inscope :: $auto_index($name)
+ }
+ }
}
}
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index d67a900..e4a47d4 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -2614,6 +2614,18 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
return
}
+proc tcltest::__SortFiles {lst} {
+ set slst {}
+ foreach f $lst {
+ lappend slst [list [file rootname $f] $f]
+ }
+ set lst {}
+ foreach f [lsort -dictionary -index 0 $slst] {
+ lappend lst [lindex $f 1]
+ }
+ return $lst
+}
+
#####################################################################
# Procs that determine which tests/test files to run
@@ -2678,6 +2690,7 @@ proc tcltest::GetMatchingFiles { args } {
PrintError "No test files remain after applying your match and\
skip patterns!"
}
+
return $matchingFiles
}
@@ -2802,7 +2815,7 @@ proc tcltest::runAllTests { {shell ""} } {
puts [outputChannel] "Tests began at [eval $timeCmd]"
# Run each of the specified tests
- foreach file [lsort [GetMatchingFiles]] {
+ foreach file [__SortFiles [GetMatchingFiles]] {
set tail [file tail $file]
puts [outputChannel] $tail
flush [outputChannel]
diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl
new file mode 100644
index 0000000..d574c2c
--- /dev/null
+++ b/tests-perf/clock.perf.tcl
@@ -0,0 +1,411 @@
+#!/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.
+#
+
+array set in {-time 500}
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+ array set in $argv
+}
+
+## common test performance framework:
+if {![namespace exists ::tclTestPerf]} {
+ source [file join [file dirname [info script]] test-performance.tcl]
+}
+
+namespace eval ::tclTestPerf-TclClock {
+
+namespace path {::tclTestPerf}
+
+## set testing defaults:
+set ::env(TCL_TZ) :CET
+
+# warm-up interpeter compiler env, clock platform-related features:
+
+## warm-up test-related features (load clock.tcl, system zones, locales, etc.):
+clock scan "" -gmt 1
+clock scan ""
+clock scan "" -timezone :CET
+clock scan "" -format "" -locale en
+clock scan "" -format "" -locale de
+
+## ------------------------------------------
+
+proc test-format {{reptime 1000}} {
+ _test_run $reptime {
+ # Format : short, week only (in gmt)
+ {clock format 1482525936 -format "%u" -gmt 1}
+ # Format : short, week only (system zone)
+ {clock format 1482525936 -format "%u"}
+ # Format : short, week only (CEST)
+ {clock format 1482525936 -format "%u" -timezone :CET}
+ # Format : date only (in gmt)
+ {clock format 1482525936 -format "%Y-%m-%d" -gmt 1}
+ # Format : date only (system zone)
+ {clock format 1482525936 -format "%Y-%m-%d"}
+ # Format : date only (CEST)
+ {clock format 1482525936 -format "%Y-%m-%d" -timezone :CET}
+ # Format : time only (in gmt)
+ {clock format 1482525936 -format "%H:%M" -gmt 1}
+ # Format : time only (system zone)
+ {clock format 1482525936 -format "%H:%M"}
+ # Format : time only (CEST)
+ {clock format 1482525936 -format "%H:%M" -timezone :CET}
+ # Format : time only (in gmt)
+ {clock format 1482525936 -format "%H:%M:%S" -gmt 1}
+ # Format : time only (system zone)
+ {clock format 1482525936 -format "%H:%M:%S"}
+ # Format : time only (CEST)
+ {clock format 1482525936 -format "%H:%M:%S" -timezone :CET}
+ # Format : default (in gmt)
+ {clock format 1482525936 -gmt 1 -locale en}
+ # Format : default (system zone)
+ {clock format 1482525936 -locale en}
+ # Format : default (CEST)
+ {clock format 1482525936 -timezone :CET -locale en}
+ # Format : ISO date-time (in gmt, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -gmt 1}
+ # Format : ISO date-time (system zone, CEST, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z"}
+ # Format : ISO date-time (CEST, numeric zone)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %z" -timezone :CET}
+ # Format : ISO date-time (system zone, CEST)
+ {clock format 1246379400 -format "%Y-%m-%dT%H:%M:%S %Z"}
+ # Format : julian day with time (in gmt):
+ {clock format 1246379415 -format "%J %H:%M:%S" -gmt 1}
+ # Format : julian day with time (system zone):
+ {clock format 1246379415 -format "%J %H:%M:%S"}
+
+ # Format : locale date-time (en):
+ {clock format 1246379415 -format "%x %X" -locale en}
+ # Format : locale date-time (de):
+ {clock format 1246379415 -format "%x %X" -locale de}
+
+ # Format : locale lookup table month:
+ {clock format 1246379400 -format "%b" -locale en -gmt 1}
+ # Format : locale lookup 2 tables - month and day:
+ {clock format 1246379400 -format "%b %Od" -locale en -gmt 1}
+ # Format : locale lookup 3 tables - week, month and day:
+ {clock format 1246379400 -format "%a %b %Od" -locale en -gmt 1}
+ # Format : locale lookup 4 tables - week, month, day and year:
+ {clock format 1246379400 -format "%a %b %Od %Oy" -locale en -gmt 1}
+
+ # Format : dynamic clock value (without converter caches):
+ setup {set i 0}
+ {clock format [incr i] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
+ cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
+ # Format : dynamic clock value (without any converter caches, zone range overflow):
+ setup {set i 0}
+ {clock format [incr i 86400] -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET}
+ cleanup {puts [clock format $i -format "%Y-%m-%dT%H:%M:%S" -locale en -timezone :CET]}
+
+ # Format : dynamic format (cacheable)
+ {clock format 1246379415 -format [string trim "%d.%m.%Y %H:%M:%S "] -gmt 1}
+
+ # Format : all (in gmt, locale en)
+ {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -gmt 1 -locale en}
+ # Format : all (in CET, locale de)
+ {clock format 1482525936 -format "%%a = %a | %%A = %A | %%b = %b | %%h = %h | %%B = %B | %%C = %C | %%d = %d | %%e = %e | %%g = %g | %%G = %G | %%H = %H | %%I = %I | %%j = %j | %%J = %J | %%k = %k | %%l = %l | %%m = %m | %%M = %M | %%N = %N | %%p = %p | %%P = %P | %%Q = %Q | %%s = %s | %%S = %S | %%t = %t | %%u = %u | %%U = %U | %%V = %V | %%w = %w | %%W = %W | %%y = %y | %%Y = %Y | %%z = %z | %%Z = %Z | %%n = %n | %%EE = %EE | %%EC = %EC | %%Ey = %Ey | %%n = %n | %%Od = %Od | %%Oe = %Oe | %%OH = %OH | %%Ok = %Ok | %%OI = %OI | %%Ol = %Ol | %%Om = %Om | %%OM = %OM | %%OS = %OS | %%Ou = %Ou | %%Ow = %Ow | %%Oy = %Oy" -timezone :CET -locale de}
+ }
+}
+
+proc test-scan {{reptime 1000}} {
+ _test_run $reptime {
+ # Scan : date (in gmt)
+ {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0 -gmt 1}
+ # Scan : date (system time zone, with base)
+ {clock scan "25.11.2015" -format "%d.%m.%Y" -base 0}
+ # Scan : date (system time zone, without base)
+ {clock scan "25.11.2015" -format "%d.%m.%Y"}
+ # Scan : greedy match
+ {clock scan "111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "11111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "111111" -format "%d%m%y" -base 0 -gmt 1}
+ # Scan : greedy match (space separated)
+ {clock scan "1 1 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "111 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 111" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 11 1" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "1 11 11" -format "%d%m%y" -base 0 -gmt 1}
+ {clock scan "11 11 11" -format "%d%m%y" -base 0 -gmt 1}
+
+ # Scan : time (in gmt)
+ {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000 -gmt 1}
+ # Scan : time (system time zone, with base)
+ {clock scan "10:35:55" -format "%H:%M:%S" -base 1000000000}
+ # Scan : time (gmt, without base)
+ {clock scan "10:35:55" -format "%H:%M:%S" -gmt 1}
+ # Scan : time (system time zone, without base)
+ {clock scan "10:35:55" -format "%H:%M:%S"}
+
+ # Scan : date-time (in gmt)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0 -gmt 1}
+ # Scan : date-time (system time zone with base)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S" -base 0}
+ # Scan : date-time (system time zone without base)
+ {clock scan "25.11.2015 10:35:55" -format "%d.%m.%Y %H:%M:%S"}
+
+ # Scan : julian day in gmt
+ {clock scan 2451545 -format %J -gmt 1}
+ # Scan : julian day in system TZ
+ {clock scan 2451545 -format %J}
+ # Scan : julian day in other TZ
+ {clock scan 2451545 -format %J -timezone +0200}
+ # Scan : julian day with time:
+ {clock scan "2451545 10:20:30" -format "%J %H:%M:%S"}
+ # Scan : julian day with time (greedy match):
+ {clock scan "2451545 102030" -format "%J%H%M%S"}
+
+ # Scan : century, lookup table month
+ {clock scan {1970 Jan 2} -format {%C%y %b %d} -locale en -gmt 1}
+ # Scan : century, lookup table month and day (both entries are first)
+ {clock scan {1970 Jan 01} -format {%C%y %b %Od} -locale en -gmt 1}
+ # Scan : century, lookup table month and day (list scan: entries with position 12 / 31)
+ {clock scan {2016 Dec 31} -format {%C%y %b %Od} -locale en -gmt 1}
+
+ # Scan : ISO date-time (CEST)
+ {clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z"}
+ {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
+ # Scan : ISO date-time (UTC)
+ {clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z"}
+ {clock scan "2009-06-30T18:30:00 UTC" -format "%Y-%m-%dT%H:%M:%S %z"}
+
+ # Scan : locale date-time (en):
+ {clock scan "06/30/2009 18:30:15" -format "%x %X" -gmt 1 -locale en}
+ # Scan : locale date-time (de):
+ {clock scan "30.06.2009 18:30:15" -format "%x %X" -gmt 1 -locale de}
+
+ # Scan : dynamic format (cacheable)
+ {clock scan "25.11.2015 10:35:55" -format [string trim "%d.%m.%Y %H:%M:%S "] -base 0 -gmt 1}
+
+ break
+ # # Scan : long format test (allock chain)
+ # {clock scan "25.11.2015" -format "%d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y %d.%m.%Y" -base 0 -gmt 1}
+ # # Scan : dynamic, very long format test (create obj representation, allock chain, GC, etc):
+ # {clock scan "25.11.2015" -format [string repeat "[incr i] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
+ # # Scan : again:
+ # {clock scan "25.11.2015" -format [string repeat "[incr i -1] %d.%m.%Y %d.%m.%Y" 10] -base 0 -gmt 1}
+ } {puts [clock format $_(r) -locale en]}
+}
+
+proc test-freescan {{reptime 1000}} {
+ _test_run $reptime {
+ # FreeScan : relative date
+ {clock scan "5 years 18 months 385 days" -base 0 -gmt 1}
+ # FreeScan : relative date with relative weekday
+ {clock scan "5 years 18 months 385 days Fri" -base 0 -gmt 1}
+ # FreeScan : relative date with ordinal month
+ {clock scan "5 years 18 months 385 days next 1 January" -base 0 -gmt 1}
+ # FreeScan : relative date with ordinal month and relative weekday
+ {clock scan "5 years 18 months 385 days next January Fri" -base 0 -gmt 1}
+ # FreeScan : ordinal month
+ {clock scan "next January" -base 0 -gmt 1}
+ # FreeScan : relative week
+ {clock scan "next Fri" -base 0 -gmt 1}
+ # FreeScan : relative weekday and week offset
+ {clock scan "next January + 2 week" -base 0 -gmt 1}
+ # FreeScan : time only with base
+ {clock scan "19:18:30" -base 148863600 -gmt 1}
+ # FreeScan : time only without base, gmt
+ {clock scan "19:18:30" -gmt 1}
+ # FreeScan : time only without base, system
+ {clock scan "19:18:30"}
+ # FreeScan : date, system time zone
+ {clock scan "05/08/2016 20:18:30"}
+ # FreeScan : date, supplied time zone
+ {clock scan "05/08/2016 20:18:30" -timezone :CET}
+ # FreeScan : date, supplied gmt (equivalent -timezone :GMT)
+ {clock scan "05/08/2016 20:18:30" -gmt 1}
+ # FreeScan : date, supplied time zone gmt
+ {clock scan "05/08/2016 20:18:30" -timezone :GMT}
+ # FreeScan : time only, numeric zone in string, base time gmt (exchange zones between gmt / -0500)
+ {clock scan "20:18:30 -0500" -base 148863600 -gmt 1}
+ # FreeScan : time only, zone in string (exchange zones between system / gmt)
+ {clock scan "19:18:30 GMT" -base 148863600}
+ # FreeScan : fast switch of zones in cycle - GMT, MST, CET (system) and EST
+ {clock scan "19:18:30 MST" -base 148863600 -gmt 1
+ clock scan "19:18:30 EST" -base 148863600
+ }
+ } {puts [clock format $_(r) -locale en]}
+}
+
+proc test-add {{reptime 1000}} {
+ set tests {
+ # 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}
+
+ }
+ # if does not support add of weekdays:
+ if {[catch {clock add 0 3 weekdays -gmt 1}]} {
+ regsub -all {\mweekdays\M} $tests "days" tests
+ }
+ _test_run $reptime $tests {puts [clock format $_(r) -locale en]}
+}
+
+proc test-convert {{reptime 1000}} {
+ _test_run $reptime {
+ # Convert locale (en -> de):
+ {clock format [clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en] -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Convert locale (de -> en):
+ {clock format [clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de] -format "%a %b %d %Y" -gmt 1 -locale en}
+
+ # Convert TZ: direct
+ {clock format [clock scan "19:18:30" -base 148863600 -timezone EST] -timezone MST}
+ {clock format [clock scan "19:18:30" -base 148863600 -timezone MST] -timezone EST}
+ # Convert TZ: included in scan string & format
+ {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone MST}
+ {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST}
+
+ # Format locale 1x: comparison values
+ {clock format 0 -gmt 1 -locale en}
+ {clock format 0 -gmt 1 -locale de}
+ {clock format 0 -gmt 1 -locale fr}
+ # Format locale 2x: without switching locale (en, en)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
+ # Format locale 2x: with switching locale (en, de)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de}
+ # Format locale 3x: without switching locale (en, en, en)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale en}
+ # Format locale 3x: with switching locale (en, de, fr)
+ {clock format 0 -gmt 1 -locale en; clock format 0 -gmt 1 -locale de; clock format 0 -gmt 1 -locale fr}
+
+ # Scan locale 2x: without switching locale (en, en) + (de, de)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en}
+ {clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Scan locale 2x: with switching locale (en, de)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de}
+ # Scan locale 3x: with switching locale (en, de, fr)
+ {clock scan "Tue May 30 2017" -format "%a %b %d %Y" -gmt 1 -locale en; clock scan "Di Mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale de; clock scan "mar. mai 30 2017" -format "%a %b %d %Y" -gmt 1 -locale fr}
+
+ # Format TZ 2x: comparison values
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
+ {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 2x: without switching
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"}
+ {clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 2x: with switching
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 3x: with switching (CET, EST, MST)
+ {clock format 0 -timezone CET -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
+ # Format TZ 3x: with switching (GMT, EST, MST)
+ {clock format 0 -gmt 1 -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone EST -format "%Y-%m-%d %H:%M:%S %z"; clock format 0 -timezone MST -format "%Y-%m-%d %H:%M:%S %z"}
+
+ # FreeScan TZ 2x (+1 system-default): without switching TZ
+ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 MST" -base 148863600}
+ {clock scan "19:18:30 EST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
+ # FreeScan TZ 2x (+1 system-default): with switching TZ
+ {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600}
+ # FreeScan TZ 2x (+1 gmt, +1 system-default)
+ {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600}
+
+ # Scan TZ: comparison included in scan string vs. given
+ {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"}
+ {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"}
+ {clock scan "2009-06-30T18:30:00" -timezone CET -format "%Y-%m-%dT%H:%M:%S"}
+ }
+}
+
+proc test-other {{reptime 1000}} {
+ _test_run $reptime {
+ # Bad zone
+ {catch {clock scan "1 day" -timezone BAD_ZONE -locale en}}
+
+ # Scan : julian day (overflow)
+ {catch {clock scan 5373485 -format %J}}
+
+ # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference)
+ {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
+ # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference)
+ {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50}
+ }
+}
+
+proc test-ensemble-perf {{reptime 1000}} {
+ _test_run $reptime {
+ # Clock clicks (ensemble)
+ {clock clicks}
+ # Clock clicks (direct)
+ {::tcl::clock::clicks}
+ # Clock seconds (ensemble)
+ {clock seconds}
+ # Clock seconds (direct)
+ {::tcl::clock::seconds}
+ # Clock microseconds (ensemble)
+ {clock microseconds}
+ # Clock microseconds (direct)
+ {::tcl::clock::microseconds}
+ # Clock scan (ensemble)
+ {clock scan ""}
+ # Clock scan (direct)
+ {::tcl::clock::scan ""}
+ # Clock format (ensemble)
+ {clock format 0 -f %s}
+ # Clock format (direct)
+ {::tcl::clock::format 0 -f %s}
+ }
+}
+
+proc test {{reptime 1000}} {
+ puts ""
+ test-ensemble-perf [expr {$reptime / 2}]; #fast enough
+ test-format $reptime
+ test-scan $reptime
+ test-freescan $reptime
+ test-add $reptime
+ test-convert [expr {$reptime / 2}]; #fast enough
+ test-other $reptime
+
+ puts \n**OK**
+}
+
+}; # end of ::tclTestPerf-TclClock
+
+# ------------------------------------------------------------------------
+
+# if calling direct:
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+ ::tclTestPerf-TclClock::test $in(-time)
+}
diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl
new file mode 100644
index 0000000..b0cbb17
--- /dev/null
+++ b/tests-perf/test-performance.tcl
@@ -0,0 +1,121 @@
+# ------------------------------------------------------------------------
+#
+# test-performance.tcl --
+#
+# This file provides common performance tests for comparison of tcl-speed
+# degradation or regression by switching between branches.
+#
+# To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl".
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2014 Serg G. Brester (aka sebres)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+
+namespace eval ::tclTestPerf {
+# warm-up interpeter compiler env, calibrate timerate measurement functionality:
+
+# if no timerate here - import from unsupported:
+if {[namespace which -command timerate] eq {}} {
+ namespace inscope ::tcl::unsupported {namespace export timerate}
+ namespace import ::tcl::unsupported::timerate
+}
+
+# if not yet calibrated:
+if {[lindex [timerate {} 10] 6] >= (10-1)} {
+ puts -nonewline "Calibration ... "; flush stdout
+ puts "done: [lrange \
+ [timerate -calibrate {}] \
+ 0 1]"
+}
+
+proc {**STOP**} {args} {
+ return -code error -level 4 "**STOP** in [info level [expr {[info level]-2}]] [join $args { }]"
+}
+
+proc _test_get_commands {lst} {
+ regsub -all {(?:^|\n)[ \t]*(\#[^\n]*|\msetup\M[^\n]*|\mcleanup\M[^\n]*)(?=\n\s*(?:[\{\#]|setup|cleanup|$))} $lst "\n{\\1}"
+}
+
+proc _test_out_total {} {
+ upvar _ _
+
+ set tcnt [llength $_(itm)]
+ if {!$tcnt} {
+ puts ""
+ return
+ }
+
+ set mintm 0x7fffffff
+ set maxtm 0
+ set nett 0
+ set wtm 0
+ set wcnt 0
+ set i 0
+ foreach tm $_(itm) {
+ if {[llength $tm] > 6} {
+ set nett [expr {$nett + [lindex $tm 6]}]
+ }
+ set wtm [expr {$wtm + [lindex $tm 0]}]
+ set wcnt [expr {$wcnt + [lindex $tm 2]}]
+ set tm [lindex $tm 0]
+ if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
+ if {$tm < $mintm} {set mintm $tm; set mini $i}
+ incr i
+ }
+
+ puts [string repeat ** 40]
+ set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]]
+ if {$nett > 0} {
+ append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]]
+ }
+ puts "Total $s:"
+ lset _(m) 0 [format %.6f $wtm]
+ lset _(m) 2 $wcnt
+ lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]]
+ if {[llength $_(m)] > 6} {
+ lset _(m) 6 [format %.3f $nett]
+ }
+ puts $_(m)
+ puts "Average:"
+ lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
+ lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
+ if {[llength $_(m)] > 6} {
+ lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]
+ lset _(m) 4 [format %.0f [expr {[lindex $_(m) 2] / [lindex $_(m) 6] * 1000}]]
+ }
+ puts $_(m)
+ puts "Min:"
+ puts [lindex $_(itm) $mini]
+ puts "Max:"
+ puts [lindex $_(itm) $maxi]
+ puts [string repeat ** 40]
+ puts ""
+}
+
+proc _test_run {reptime lst {outcmd {puts $_(r)}}} {
+ upvar _ _
+ array set _ [list itm {} reptime $reptime starttime [clock milliseconds]]
+
+ foreach _(c) [_test_get_commands $lst] {
+ puts "% [regsub -all {\n[ \t]*} $_(c) {; }]"
+ if {[regexp {^\s*\#} $_(c)]} continue
+ if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
+ puts [if 1 [lindex $_(c) 1]]
+ continue
+ }
+ if {$reptime > 1} {; #if not once:
+ set _(r) [if 1 $_(c)]
+ if {$outcmd ne {}} $outcmd
+ }
+ puts [set _(m) [timerate $_(c) $reptime]]
+ lappend _(itm) $_(m)
+ puts ""
+ }
+ _test_out_total
+}
+
+}; # end of namespace ::tclTestPerf
diff --git a/tests/clock-ivm.test b/tests/clock-ivm.test
new file mode 100644
index 0000000..13de0b3
--- /dev/null
+++ b/tests/clock-ivm.test
@@ -0,0 +1,8 @@
+# clock-ivm.test --
+#
+# This test file covers the 'clock' command using inverted validity mode.
+#
+# See the file "clock.test" for more information.
+
+clock configure -valid [expr {![clock configure -valid]}]
+source [file join [file dirname [info script]] clock.test] \ No newline at end of file
diff --git a/tests/clock.test b/tests/clock.test
index b17c543..0e143ec 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.
@@ -19,9 +20,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
if {[testConstraint win]} {
if {[catch {
::tcltest::loadTestedCommands
- package require registry
}]} {
- namespace eval ::tcl::clock {variable NoRegistry {}}
+ # nothing to be done (registry loaded on demand)
}
}
@@ -31,9 +31,29 @@ testConstraint detroit \
[expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
[expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
+testConstraint no_tclclockmod \
+ [expr {[namespace which -command ::tcl::clock::configure] eq {}}]
+
+# Test with both validity modes - validate on / off:
+
+set valid_mode [clock configure -valid]
+
+# Wrapper to show validity mode in the test-case name (for possible errors):
+rename test __test
+proc test {args} {
+ variable valid_mode
+ lset args 0 [lindex $args 0].vm:$valid_mode
+ uplevel [linsert $args [set args 0] __test]
+}
+
+puts [outputChannel] " Validity default mode: [expr {$valid_mode ? "on": "off"}]"
+testConstraint valid_off [expr {![clock configure -valid]}]
# TEST PLAN
+# clock-0:
+# several base test-cases
+#
# clock-1:
# [clock format] - tests of bad and empty arguments
#
@@ -262,11 +282,34 @@ proc timeWithinDuration {duration start end} {
}
+# Base test cases:
+
+test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod {
+ set i [interp create]; # because clock can be used somewhere, test it in new interp:
+
+ set ret [$i eval {
+
+ lappend ret ens:[namespace ensemble exists ::clock]
+ clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded)
+ lappend ret ens:[namespace ensemble exists ::clock]
+ lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
+ clock format -now; # clock.tcl stubs expected
+ lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
+ }]
+ interp delete $i
+ set ret
+} {ens:0 ens:1 stubs:0 stubs:1}
+
# Test some of the basics of [clock format]
+set syntax "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"
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}}
+} [subst {1 {wrong # args: should be "$syntax"} {CLOCK wrongNumArgs}}]
+
+test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" {
+ list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode
+} [subst {1 {wrong # args: should be "$syntax"} {CLOCK wrongNumArgs}}]
test clock-1.1 "clock format - bad time" {
list [catch {clock format foo} msg] $msg
@@ -280,13 +323,14 @@ test clock-1.3 "clock format - empty val" {
clock format 0 -gmt 1 -format ""
} {}
-test clock-1.4 "clock format - bad flag" {*}{
- -body {
+test clock-1.4 "clock format - bad flag" {
+ # range error message for possible extensions:
list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
- }
- -match glob
- -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
-}
+} [subst {1 {bad option "-oops": should be "$syntax"} {CLOCK badOption -oops}}]
+test clock-1.4.1 "clock format - unexpected option for this sub-command" {
+ # range error message for possible extensions:
+ list [catch {clock format 0 -base 0} msg] $msg $::errorCode
+} [subst {1 {bad option "-base": should be "$syntax"} {CLOCK badOption -base}}]
test clock-1.5 "clock format - bad timezone" {
list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
@@ -300,6 +344,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
@@ -18544,17 +18598,177 @@ 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
} 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-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-6.19 {no token parsing} {
+ list [catch { clock scan "%E%O%" -format "%E%O%" }] \
+ [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!
+proc _testStarDates {s {days {366*2}} {step {86400}}} {
+ set step [expr {int($step * 86400)}]
+ # reconvert - arrange in order of stardate:
+ set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]]
+ # test:
+ set wrong {}
+ while {$i < $s + $days*86400} {
+ set d [clock format $i -f "%Q" -g 1]
+ if {![regexp {^Stardate \d+\.\d$} $d]} {
+ lappend wrong "wrong: $d -- ($i) -- [clock format $i -g 1]"
+ }
+ if {[catch {
+ set i2 [clock scan $d -f "%Q" -g 1]
+ } msg]} {
+ lappend wrong "$d -- ($i) -- [clock format $i -g 1]: $msg"
+ }
+ if {$i != $i2} {
+ lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]"
+ }
+ incr i $step
+ }
+ join $wrong \n
+}
+test clock-6.21.0 {Stardate 0 day} {
+ list [set d [clock format -757382400 -format "%Q" -gmt 1]] \
+ [clock scan $d -format "%Q" -gmt 1]
+} [list "Stardate 00000.0" -757382400]
+test clock-6.21.0.1 {Stardate 0.1 - 1.9 (test negative clock value -> positive Stardate)} {
+ _testStarDates -757382400 2 0.1
+} {}
+test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)} {
+ _testStarDates [clock scan "Stardate 10000.1" -f %Q -g 1] 3 0.1
+} {}
+test clock-6.21.0.2 {Stardate 80000.1 - 80002.9 (test positive clock value)} {
+ _testStarDates [clock scan "Stardate 80001.1" -f %Q -g 1] 3 0.1
+} {}
+test clock-6.21.1 {Stardate} {
+ list [set d [clock format 1482857280 -format "%Q" -gmt 1]] \
+ [clock scan $d -format "%Q" -gmt 1]
+} [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)} {
+ _testStarDates [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1] [expr {366*2}] 1
+} {}
+rename _testStarDates {}
+
+test clock-6.22.1 {Greedy match} {
+ clock format [clock scan "111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {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-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} {
clock scan 0 -format %J -gmt true
} -210866803200
@@ -21061,80 +21275,87 @@ 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} {
+if {!$valid_mode} {
+ set res {-result 0}
+} else {
+ set res {-returnCodes error -result "unable to convert input string: ambiguous day"}
+}
+test clock-11.1 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700101002 -format %Y%m%d%j -gmt 1
-} 86400
-test clock-11.2 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.2 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01197001002 -format %m%Y%d%j -gmt 1
-} 86400
-test clock-11.3 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.3 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01197001002 -format %d%Y%m%j -gmt 1
-} 86400
-test clock-11.4 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.4 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00219700101 -format %j%Y%m%d -gmt 1
-} 0
-test clock-11.5 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.5 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700100201 -format %Y%m%j%d -gmt 1
-} 0
-test clock-11.6 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.6 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01197000201 -format %m%Y%j%d -gmt 1
-} 0
-test clock-11.7 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.7 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01197000201 -format %d%Y%j%m -gmt 1
-} 0
-test clock-11.8 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.8 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00219700101 -format %j%Y%d%m -gmt 1
-} 0
-test clock-11.9 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.9 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700101002 -format %Y%d%m%j -gmt 1
-} 86400
-test clock-11.10 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.10 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01011970002 -format %m%d%Y%j -gmt 1
-} 86400
-test clock-11.11 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.11 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01011970002 -format %d%m%Y%j -gmt 1
-} 86400
-test clock-11.12 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.12 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00201197001 -format %j%m%Y%d -gmt 1
-} 0
-test clock-11.13 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.13 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700100201 -format %Y%d%j%m -gmt 1
-} 0
-test clock-11.14 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.14 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01010021970 -format %m%d%j%Y -gmt 1
-} 86400
-test clock-11.15 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.15 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01010021970 -format %d%m%j%Y -gmt 1
-} 86400
-test clock-11.16 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.16 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00201011970 -format %j%m%d%Y -gmt 1
-} 0
-test clock-11.17 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.17 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700020101 -format %Y%j%m%d -gmt 1
-} 0
-test clock-11.18 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.18 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01002197001 -format %m%j%Y%d -gmt 1
-} 0
-test clock-11.19 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.19 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01002197001 -format %d%j%Y%m -gmt 1
-} 0
-test clock-11.20 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.20 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00201197001 -format %j%d%Y%m -gmt 1
-} 0
-test clock-11.21 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.21 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 19700020101 -format %Y%j%d%m -gmt 1
-} 0
-test clock-11.22 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.22 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01002011970 -format %m%j%d%Y -gmt 1
-} 0
-test clock-11.23 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.23 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 01002011970 -format %d%j%m%Y -gmt 1
-} 0
-test clock-11.24 {precedence of ccyyddd and ccyymmdd} {
+} {*}$res
+test clock-11.24 {precedence of ccyymmdd over ccyyddd} -body {
clock scan 00201011970 -format %j%d%m%Y -gmt 1
-} 0
+} {*}$res
+
+unset -nocomplain res
# END testcases11
# BEGIN testcases12
@@ -21431,11 +21652,11 @@ test clock-12.96 {parse ccyyWwwd} {
} 1009756800
# END testcases12
-test clock-13.1 {test that %s takes precedence over ccyyWwwd} {
+test clock-13.1 {test that %s takes precedence over ccyyWwwd} valid_off {
list [clock scan {0 2000W011} -format {%s %GW%V%u} -gmt true] \
[clock scan {2000W011 0} -format {%GW%V%u %s} -gmt true]
} {0 0}
-test clock-13.2 {test that %J takes precedence over ccyyWwwd} {
+test clock-13.2 {test that %J takes precedence over ccyyWwwd} valid_off {
list [clock scan {2440588 2000W011} -format {%J %GW%V%u} -gmt true] \
[clock scan {2000W011 2440588} -format {%GW%V%u %J} -gmt true]
} {0 0}
@@ -23771,7 +23992,7 @@ test clock-15.2 {yymmdd precedence below julian day} {
[clock scan {000101 2440588} -format {%y%m%d %J} -gmt true]
} {0 0}
-test clock-15.3 {yymmdd precedence below yyyyWwwd} {
+test clock-15.3 {yymmdd precedence below yyyyWwwd} valid_off {
list [clock scan {1970W014000101} -format {%GW%V%u%y%m%d} -gmt true] \
[clock scan {0001011970W014} -format {%y%m%d%GW%V%u} -gmt true]
} {0 0}
@@ -23811,7 +24032,7 @@ test clock-16.10 {julian day takes precedence over yyddd} {
list [clock scan {2440588 00001} -format {%J %y%j} -gmt true] \
[clock scan {00001 2440588} -format {%Y%j %J} -gmt true]
} {0 0}
-test clock-16.11 {yyddd precedence below yyyyWwwd} {
+test clock-16.11 {yyddd precedence below yyyyWwwd} valid_off {
list [clock scan {1970W01400001} -format {%GW%V%u%y%j} -gmt true] \
[clock scan {000011970W014} -format {%y%j%GW%V%u} -gmt true]
} {0 0}
@@ -24112,7 +24333,7 @@ test clock-17.96 {parse yyWwwd} {
# Test precedence of yyWwwd
-test clock-18.1 {seconds take precedence over yyWwwd} {
+test clock-18.1 {seconds take precedence over yyWwwd} valid_off {
list [clock scan {0 00W014} -format {%s %gW%V%u} -gmt true] \
[clock scan {00W014 0} -format {%gW%V%u %s} -gmt true]
} {0 0}
@@ -24120,11 +24341,11 @@ test clock-18.2 {julian day takes precedence over yyddd} {
list [clock scan {2440588 00W014} -format {%J %gW%V%u} -gmt true] \
[clock scan {00W014 2440588} -format {%gW%V%u %J} -gmt true]
} {0 0}
-test clock-18.3 {yyWwwd precedence below yyyymmdd} {
+test clock-18.3 {yyWwwd precedence below yyyymmdd} valid_off {
list [clock scan {19700101 00W014} -format {%Y%m%d %gW%V%u} -gmt true] \
[clock scan {00W014 19700101} -format {%gW%V%u %Y%m%d} -gmt true]
} {0 0}
-test clock-18.4 {yyWwwd precedence below yyyyddd} {
+test clock-18.4 {yyWwwd precedence below yyyyddd} valid_off {
list [clock scan {1970001 00W014} -format {%Y%j %gW%V%u} -gmt true] \
[clock scan {00W014 1970001} -format {%gW%V%u %Y%j} -gmt true]
} {0 0}
@@ -25936,42 +26157,48 @@ test clock-26.48 {parse naked day of week} {
} 1009670400
# END testcases26
-test clock-27.1 {seconds take precedence over naked weekday} {
+if {!$valid_mode} {
+ set res {-result {0 0}}
+} else {
+ set res {-returnCodes error -result "unable to convert input string: invalid day of week"}
+}
+test clock-27.1 {seconds take precedence over naked weekday} -body {
list [clock scan {0 1} -format {%s %u} -gmt true -base 0] \
[clock scan {1 0} -format {%u %s} -gmt true -base 0]
-} {0 0}
-test clock-27.2 {julian day takes precedence over naked weekday} {
+} {*}$res
+test clock-27.2 {julian day takes precedence over naked weekday} -body {
list [clock scan {2440588 1} -format {%J %u} -gmt true -base 0] \
[clock scan {1 2440588} -format {%u %J} -gmt true -base 0]
-} {0 0}
-test clock-27.3 {yyyymmdd over naked weekday} {
+} {*}$res
+test clock-27.3 {yyyymmdd over naked weekday} -body {
list [clock scan {19700101 1} -format {%Y%m%d %u} -gmt true -base 0] \
[clock scan {1 19700101} -format {%u %Y%m%d} -gmt true -base 0]
-} {0 0}
-test clock-27.4 {yyyyddd over naked weekday} {
+} {*}$res
+test clock-27.4 {yyyyddd over naked weekday} -body {
list [clock scan {1970001 1} -format {%Y%j %u} -gmt true -base 0] \
[clock scan {1 1970001} -format {%u %Y%j} -gmt true -base 0]
-} {0 0}
-test clock-27.5 {yymmdd over naked weekday} {
+} {*}$res
+test clock-27.5 {yymmdd over naked weekday} -body {
list [clock scan {700101 1} -format {%y%m%d %u} -gmt true -base 0] \
[clock scan {1 700101} -format {%u %y%m%d} -gmt true -base 0]
-} {0 0}
-test clock-27.6 {yyddd over naked weekday} {
+} {*}$res
+test clock-27.6 {yyddd over naked weekday} -body {
list [clock scan {70001 1} -format {%y%j %u} -gmt true -base 0] \
[clock scan {1 70001} -format {%u %y%j} -gmt true -base 0]
-} {0 0}
-test clock-27.7 {mmdd over naked weekday} {
+} {*}$res
+test clock-27.7 {mmdd over naked weekday} -body {
list [clock scan {0101 1} -format {%m%d %u} -gmt true -base 0] \
[clock scan {1 0101} -format {%u %m%d} -gmt true -base 0]
-} {0 0}
-test clock-27.8 {ddd over naked weekday} {
+} {*}$res
+test clock-27.8 {ddd over naked weekday} -body {
list [clock scan {001 1} -format {%j %u} -gmt true -base 0] \
[clock scan {1 001} -format {%u %j} -gmt true -base 0]
-} {0 0}
-test clock-27.9 {naked day of month over naked weekday} {
+} {*}$res
+test clock-27.9 {naked day of month over naked weekday} -body {
list [clock scan {01 1} -format {%d %u} -gmt true -base 0] \
[clock scan {1 01} -format {%u %d} -gmt true -base 0]
-} {0 0}
+} {*}$res
+unset -nocomplain res
test clock-28.1 {base date} {
clock scan {} -format {} -gmt true -base 1234567890
@@ -34981,8 +35208,35 @@ test clock-29.1800 {time parsing} {
-gmt true -locale en_US_roman \
-format {%J %Ol:%OM:%OS %P}
} 86399
+
+test clock-29.1811 {parsing of several localized formats} {
+ set res {}
+ foreach loc {en de fr} {
+ foreach fmt {"%x %X" "%X %x"} {
+ lappend res [clock scan \
+ [clock format 0 -format $fmt -locale $loc -gmt 1] \
+ -format $fmt -locale $loc -gmt 1]
+ }
+ }
+ set res
+} [lrepeat 6 0]
+test clock-29.1812 {parsing of several localized formats} {
+ set res {}
+ foreach loc {en de fr} {
+ foreach fmt {"%a %d-%m-%Y" "%a %b %x-%X" "%a, %x %X" "%b, %x %X"} {
+ lappend res [clock scan \
+ [clock format 0 -format $fmt -locale $loc -gmt 1] \
+ -format $fmt -locale $loc -gmt 1]
+ }
+ }
+ set res
+} [lrepeat 12 0]
# END testcases29
+
+# BEGIN testcases30
+
+# Test [clock add]
test clock-30.1 {clock add years} {
set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC]
set f [clock add $t 1 year -timezone :UTC]
@@ -35209,6 +35463,57 @@ test clock-30.25 {clock add seconds at DST conversion} {
set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
+test clock-30.26 {clock add weekdays} {
+ set t [clock scan {2013-11-20}] ;# Wednesday
+ set f1 [clock add $t 3 weekdays]
+ set x1 [clock format $f1 -format {%Y-%m-%d}]
+} {2013-11-25}
+test clock-30.27 {clock add weekdays starting on Saturday} {
+ set t [clock scan {2013-11-23}] ;# Saturday
+ set f1 [clock add $t 1 weekday]
+ set x1 [clock format $f1 -format {%Y-%m-%d}]
+} {2013-11-25}
+test clock-30.28 {clock add weekdays starting on Sunday} {
+ set t [clock scan {2013-11-24}] ;# Sunday
+ set f1 [clock add $t 1 weekday]
+ set x1 [clock format $f1 -format {%Y-%m-%d}]
+} {2013-11-25}
+test clock-30.29 {clock add 0 weekdays starting on a weekend} {
+ set t [clock scan {2016-02-27}] ;# Saturday
+ set f1 [clock add $t 0 weekdays]
+ set x1 [clock format $f1 -format {%Y-%m-%d}]
+} {2016-02-27}
+test clock-30.30 {clock add weekdays and back} -body {
+ set n [clock seconds]
+ # we start on each day of the week
+ for {set i 0} {$i < 7} {incr i} {
+ set start [clock add $n $i days]
+ set startu [clock format $start -format %u]
+ # add 0 - 100 weekdays
+ for {set j 0} {$j < 100} {incr j} {
+ set forth [clock add $start $j weekdays]
+ set back [clock add $forth -$j weekdays]
+ # If $s was a weekday or $j was 0, $b must be the same day.
+ # Otherwise, $b must be the immediately preceeding Friday
+ set fail 0
+ if {$j == 0 || $startu < 6} {
+ if {$start != $back} { set fail 1}
+ } else {
+ set friday [clock add $start -[expr {$startu % 5}] days]
+ if {$friday != $back} { set fail 1 }
+ }
+ if {$fail} {
+ set sdate [clock format $start -format {%Y-%m-%d}]
+ set bdate [clock format $back -format {%Y-%m-%d}]
+ return "$sdate + $j - $j := $bdate"
+ }
+ }
+ }
+ return "OK"
+} -result {OK}
+
+# END testcases30
+
test clock-31.1 {system locale} \
-constraints win \
@@ -35558,9 +35863,10 @@ test clock-33.11a {clock test, millis align with micros} {
} {1}
# clock scan
+set syntax "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE? ?-validate boolean?"
test clock-34.1 {clock scan tests} {
list [catch {clock scan} msg] $msg
-} {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
+} [subst {1 {wrong # args: should be "$syntax"}}]
test clock-34.2 {clock scan tests} {*}{
-body {clock scan "bad-string"}
-returnCodes error
@@ -35594,7 +35900,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}}
+} [subst {1 {bad option "-bad": should be "$syntax"}}]
# 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]
@@ -35604,7 +35910,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}
@@ -35633,6 +35947,100 @@ test clock-34.18 {clock scan, ISO 8601 point in time format} {
set time [clock scan "19921023T000000"]
clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 00:00:00"
+test clock-34.20.1 {clock scan tests (-TZ)} {
+ set time [clock scan "31 Jan 14 23:59:59 -0100"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Feb 01,2014 00:59:59 GMT}
+test clock-34.20.2 {clock scan tests (+TZ)} {
+ set time [clock scan "31 Jan 14 23:59:59 +0100"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 31,2014 22:59:59 GMT}
+test clock-34.20.3 {clock scan tests (-TZ)} {
+ set time [clock scan "23:59:59 -0100" -base 0]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 02,1970 00:59:59 GMT}
+test clock-34.20.4 {clock scan tests (+TZ)} {
+ set time [clock scan "23:59:59 +0100" -base 0]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 01,1970 22:59:59 GMT}
+test clock-34.20.5 {clock scan tests (TZ)} {
+ set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jun 30,2014 21:59:59 GMT}
+test clock-34.20.6 {clock scan tests (TZ)} {
+ set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET"]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 31,2014 22:59:59 GMT}
+test clock-34.20.7 {clock scan tests (relspec, day unit not TZ)} {
+ set time [clock scan "23:59:59 +15 day" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Feb 08,1970 23:59:59 GMT}
+test clock-34.20.8 {clock scan tests (relspec, day unit not TZ)} {
+ set time [clock scan "23:59:59 -15 day" -base 2000000 -gmt true]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 09,1970 23:59:59 GMT}
+test clock-34.20.9 {clock scan tests (merid and TZ)} {
+ set time [clock scan "10:59 pm CET" -base 2000000]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 24,1970 21:59:00 GMT}
+test clock-34.20.10 {clock scan tests (merid and TZ)} {
+ set time [clock scan "10:59 pm +0100" -base 2000000]
+ clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
+} {Jan 24,1970 21:59:00 GMT}
+test clock-34.20.11 {clock scan tests (complex TZ)} {
+ list [clock scan "GMT+1000" -base 100000000 -gmt 1] \
+ [clock scan "GMT+10" -base 100000000 -gmt 1] \
+ [clock scan "+1000" -base 100000000 -gmt 1]
+} [lrepeat 3 99964000]
+test clock-34.20.12 {clock scan tests (complex TZ)} {
+ list [clock scan "GMT-1000" -base 100000000 -gmt 1] \
+ [clock scan "GMT-10" -base 100000000 -gmt 1] \
+ [clock scan "-1000" -base 100000000 -gmt 1]
+} [lrepeat 3 100036000]
+test clock-34.20.13 {clock scan tests (complex TZ)} {
+ list [clock scan "GMT-0000" -base 100000000 -gmt 1] \
+ [clock scan "GMT+0000" -base 100000000 -gmt 1] \
+ [clock scan "GMT" -base 100000000 -gmt 1]
+} [lrepeat 3 100000000]
+test clock-34.20.14 {clock scan tests (complex TZ)} {
+ list [clock scan "CET+1000" -base 100000000 -gmt 1] \
+ [clock scan "CET-1000" -base 100000000 -gmt 1]
+} {99960400 100032400}
+test clock-34.20.15 {clock scan tests (complex TZ)} {
+ list [clock scan "CET-0000" -base 100000000 -gmt 1] \
+ [clock scan "CET+0000" -base 100000000 -gmt 1] \
+ [clock scan "CET" -base 100000000 -gmt 1]
+} [lrepeat 3 99996400]
+test clock-34.20.16 {clock scan tests (complex TZ)} {
+ list [clock format [clock scan "00:00 GMT+1000" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00 GMT+10" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00 +1000" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00" -base 100000000 -timezone +1000] -gmt 1]
+} [lrepeat 4 "Fri Mar 02 14:00:00 GMT 1973"]
+test clock-34.20.17 {clock scan tests (complex TZ)} {
+ list [clock format [clock scan "00:00 GMT+0100" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00 GMT+01" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00 GMT+1" -base 100000000 -gmt 1] -gmt 1] \
+ [clock format [clock scan "00:00" -base 100000000 -timezone +0100] -gmt 1]
+} [lrepeat 4 "Fri Mar 02 23:00:00 GMT 1973"]
+test clock-34.20.18 {clock scan tests (no TZ)} {
+ list [clock scan "1000days" -base 100000000 -gmt 1] \
+ [clock scan "1000 days" -base 100000000 -gmt 1] \
+ [clock scan "+1000days" -base 100000000 -gmt 1] \
+ [clock scan "+1000 days" -base 100000000 -gmt 1] \
+ [clock scan "GMT +1000 days" -base 100000000 -gmt 1] \
+ [clock scan "00:00 GMT +1000 days" -base 100000000 -gmt 1]
+} [lrepeat 6 186364800]
+test clock-34.20.19 {clock scan tests (no TZ)} {
+ list [clock scan "-1000days" -base 100000000 -gmt 1] \
+ [clock scan "-1000 days" -base 100000000 -gmt 1] \
+ [clock scan "GMT -1000days" -base 100000000 -gmt 1] \
+ [clock scan "00:00 GMT -1000 days" -base 100000000 -gmt 1] \
+} [lrepeat 4 13564800]
+test clock-34.20.20 {clock scan tests (TZ, TZ + 1day)} {
+ clock scan "00:00 GMT+1000 day" -base 100000000 -gmt 1
+} 100015200
+
# CLOCK SCAN REAL TESTS
# We use 5am PST, 31-12-1999 as the base for these scans because irrespective
@@ -35727,6 +36135,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} {
@@ -35820,7 +36249,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} {
@@ -35852,13 +36368,33 @@ test clock-36.3 {clock scan next monthname} {
} "05.2001"
test clock-37.1 {%s gmt testing} {
- set s [clock seconds]
+ set s [clock scan "2017-05-10 09:00:00" -gmt 1]
set a [clock format $s -format %s -gmt 0]
set b [clock format $s -format %s -gmt 1]
+ set c [clock scan $s -format %s -gmt 0]
+ 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 CET} {
+ set s [clock scan "2017-01-10 09:00:00" -gmt 1]
+ set a [clock format $s -format %Es -timezone CET]
+ set b [clock format $s -format %Es -gmt 1]
+ set c [clock scan $s -format %Es -timezone CET]
+ 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-37.3 {%Es gmt testing CEST} {
+ set s [clock scan "2017-05-10 09:00:00" -gmt 1]
+ set a [clock format $s -format %Es -timezone CET]
+ set b [clock format $s -format %Es -gmt 1]
+ set c [clock scan $s -format %Es -timezone CET]
+ set d [clock scan $s -format %Es -gmt 1]
+ # %Es depend on the time zone (local seconds instead of posix seconds).
+ list [expr {$b-$a}] [expr {$d-$c}]
+} {-7200 7200}
test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \
-setup {
@@ -35983,30 +36519,288 @@ test clock-44.1 {regression test - time zone name containing hyphen } \
}
} \
-result {12:34:56-0500}
-
-test clock-45.1 {regression test - time zone containing only two digits} \
+test clock-44.2 {regression test - time zone containing only two digits} \
-body {
clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
} \
-result 482134530
-test clock-46.1 {regression test - month zero} \
+test clock-45.1 {compat: scan regression on spaces (multiple spaces in format)} \
+ -body {
+ list \
+ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \
+ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \
+ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \
+ [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \
+ [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \
+ [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \
+ [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1] \
+ [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1] \
+ [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1]
+ } -result [lrepeat 9 1541657520]
+
+test clock-45.2 {compat: scan regression on spaces (multiple leading/trailing spaces in input)} \
+ -body {
+ set sp [string repeat " " 20]
+ list \
+ [clock scan "NOV 7${sp}" -format "%b %d" -base 0 -gmt 1 -locale en] \
+ [clock scan "${sp}NOV 7" -format "%b %d" -base 0 -gmt 1 -locale en] \
+ [clock scan "${sp}NOV 7${sp}" -format "%b %d" -base 0 -gmt 1 -locale en] \
+ [clock scan "1970 NOV 7${sp}" -format "%Y %b %d" -gmt 1 -locale en] \
+ [clock scan "${sp}1970 NOV 7" -format "%Y %b %d" -gmt 1 -locale en] \
+ [clock scan "${sp}1970 NOV 7${sp}" -format "%Y %b %d" -gmt 1 -locale en]
+ } -result [lrepeat 6 26784000]
+test clock-45.3 {compat: scan regression on spaces (shortest match)} \
+ -body {
+ list \
+ [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] \
+ [clock scan "11 1 120 " -format "%y%m%d %H%M%S" -gmt 1] \
+ [clock scan " 11 1 120" -format "%y%m%d %H%M%S" -gmt 1] \
+ [clock scan "11 1 120 " -format "%y%m%d %H%M%S " -gmt 1] \
+ [clock scan " 11 1 120" -format " %y%m%d %H%M%S" -gmt 1]
+ } -result [lrepeat 5 978310920]
+test clock-45.4 {compat: scan regression on spaces (mandatory leading/trailing spaces in format)} \
+ -body {
+ list \
+ [catch {clock scan "11 1 120" -format "%y%m%d %H%M%S " -gmt 1} ret] $ret \
+ [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S" -gmt 1} ret] $ret \
+ [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S " -gmt 1} ret] $ret
+ } -result [lrepeat 3 1 "input string does not match supplied format"]
+
+test clock-46.1 {regression test - month zero} -constraints valid_off \
-body {
clock scan 2004-00-00 -format %Y-%m-%d
} -result [clock scan 2003-11-30 -format %Y-%m-%d]
-test clock-46.2 {regression test - month zero} \
+test clock-46.2 {regression test - month zero} -constraints valid_off \
-body {
clock scan 20040000
} -result [clock scan 2003-11-30 -format %Y-%m-%d]
-test clock-46.3 {regression test - month thirteen} \
+test clock-46.3 {regression test - month thirteen} -constraints valid_off \
-body {
clock scan 2004-13-01 -format %Y-%m-%d
} -result [clock scan 2005-01-01 -format %Y-%m-%d]
-test clock-46.4 {regression test - month thirteen} \
+test clock-46.4 {regression test - month thirteen} -constraints valid_off \
-body {
clock scan 20041301
} -result [clock scan 2005-01-01 -format %Y-%m-%d]
+test clock-46.5 {regression test - good time} \
+ -body {
+ # 12:01 apm are valid input strings...
+ list [clock scan "12:01 am" -base 0 -gmt 1] \
+ [clock scan "12:01 pm" -base 0 -gmt 1]
+ } -result {60 43260}
+test clock-46.6 {freescan: regression test - bad time} -constraints valid_off \
+ -body {
+ # 13:00 am/pm are invalid input strings...
+ list [clock scan "13:00 am" -base 0 -gmt 1] \
+ [clock scan "13:00 pm" -base 0 -gmt 1]
+ } -result {-1 -1}
+
+# test without and with relative offsets:
+foreach {idx relstr} {"" "" "+rel" "+ 15 month + 40 days + 30 hours + 80 minutes +9999 seconds"} {
+test clock-46.10$idx {freescan: validation rules: invalid time} \
+ -body {
+ # 13:00 am/pm are invalid input strings...
+ list [catch {clock scan "13:00 am$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "13:00 pm$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time (hour)} 1 {unable to convert input string: invalid time (hour)}}
+test clock-46.11$idx {freescan: validation rules: invalid time} \
+ -body {
+ # invalid minutes in input strings...
+ list [catch {clock scan "23:70$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "11:80 pm$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time (minutes)} 1 {unable to convert input string: invalid time (minutes)}}
+test clock-46.12$idx {freescan: validation rules: invalid time} \
+ -body {
+ # invalid seconds in input strings...
+ list [catch {clock scan "23:00:70$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "11:00:80 pm$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time} 1 {unable to convert input string: invalid time}}
+test clock-46.13$idx {freescan: validation rules: invalid day} \
+ -body {
+ list [catch {clock scan "29 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "30 Feb 2016$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}}
+test clock-46.14$idx {freescan: validation rules: invalid day} \
+ -body {
+ list [catch {clock scan "0 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "00 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}}
+test clock-46.15$idx {freescan: validation rules: invalid month} \
+ -body {
+ list [catch {clock scan "13/13/2017$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "00/00/2017$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid month} 1 {unable to convert input string: invalid month}}
+test clock-46.16$idx {freescan: validation rules: invalid day of week} \
+ -body {
+ list [catch {clock scan "Sat Jan 01 00:00:00 1970$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "Thu Jan 03 00:00:00 1970$relstr" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day of week} 1 {unable to convert input string: invalid day of week}}
+test clock-46.17$idx {scan: validation rules: invalid year} -setup {
+ set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \
+ -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]]
+ clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
+ } -body {
+ list [catch {clock scan "70-01-01$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "1870-01-01$relstr" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "9570-01-01$relstr" -valid 1 -gmt 1} msg] $msg \
+ } -result [lrepeat 3 1 {unable to convert input string: invalid year}] -cleanup {
+ clock configure {*}$orgcfg
+ unset -nocomplain orgcfg
+ }
+
+}; # foreach
+unset -nocomplain idx relstr
+
+set dst_hole_check {
+ {":Europe/Berlin"
+ "2017-03-26 01:59:59" "2017-03-26 02:00:00" "2017-03-26 02:59:59" "2017-03-26 03:00:00"
+ "2017-10-29 01:59:59" "2017-10-29 02:00:00"}
+ {":Europe/Berlin"
+ "2018-03-25 01:59:59" "2018-03-25 02:00:00" "2018-03-25 02:59:59" "2018-03-25 03:00:00"
+ "2018-10-28 01:59:59" "2018-10-28 02:00:00"}
+ {":America/New_York"
+ "2017-03-12 01:59:59" "2017-03-12 02:00:00" "2017-03-12 02:59:59" "2017-03-12 03:00:00"
+ "2017-11-05 01:59:59" "2017-11-05 02:00:00"}
+ {":America/New_York"
+ "2018-03-11 01:59:59" "2018-03-11 02:00:00" "2018-03-11 02:59:59" "2018-03-11 03:00:00"
+ "2018-11-04 01:59:59" "2018-11-04 02:00:00"}
+}
+test clock-46.19-1 {free-scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \
+ -body {
+ set res {}
+ foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
+ lappend res [set v [catch {clock scan $dt -timezone $tz -valid 1} msg]]
+ if {$v} { lappend res $msg }
+ }}
+ set res
+ } -cleanup {
+ unset -nocomplain res v dt tz
+ } -result [lrepeat 4 \
+ {*}[list 0 {*}[lrepeat 2 1 {unable to convert input string: invalid time (does not exist in this time-zone)}] 0 0 0]]
+test clock-46.19-2 {free-scan: validation rules regression: all scans successful, if -valid 0} \
+ -body {
+ set res {}
+ set res {}
+ foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
+ lappend res [set v [catch {clock scan $dt -timezone $tz} msg]]
+ }}
+ set res
+ } -cleanup {
+ unset -nocomplain res v dt tz
+ } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]]
+test clock-46.19-3 {scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \
+ -body {
+ set res {}
+ foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
+ lappend res [set v [catch {clock scan $dt -timezone $tz -format "%Y-%m-%d %H:%M:%S" -valid 1} msg]]
+ if {$v} { lappend res $msg }
+ }}
+ set res
+ } -cleanup {
+ unset -nocomplain res v dt tz
+ } -result [lrepeat 4 \
+ {*}[list 0 {*}[lrepeat 2 1 {unable to convert input string: invalid time (does not exist in this time-zone)}] 0 0 0]]
+test clock-46.19-4 {scan: validation rules regression: all scans successful, if -valid 0} \
+ -body {
+ set res {}
+ set res {}
+ foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt {
+ lappend res [set v [catch {clock scan $dt -timezone $tz -format "%Y-%m-%d %H:%M:%S"} msg]]
+ }}
+ set res
+ } -cleanup {
+ unset -nocomplain res v dt tz
+ } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]]
+unset -nocomplain dst_hole_check
+
+test clock-46.20 {scan: validation rules: invalid time} \
+ -body {
+ # 13:00 am/pm are invalid input strings...
+ list [catch {clock scan "13:00 am" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "13:00 pm" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time (hour)} 1 {unable to convert input string: invalid time (hour)}}
+test clock-46.21 {scan: validation rules: invalid time} \
+ -body {
+ # invalid minutes in input strings...
+ list [catch {clock scan "23:70" -format "%H:%M" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "11:80 pm" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time (minutes)} 1 {unable to convert input string: invalid time (minutes)}}
+test clock-46.22 {scan: validation rules: invalid time} \
+ -body {
+ # invalid seconds in input strings...
+ list [catch {clock scan "23:00:70" -format "%H:%M:%S" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "11:00:80 pm" -format "%H:%M:%S %p" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid time} 1 {unable to convert input string: invalid time}}
+test clock-46.23 {scan: validation rules: invalid day} \
+ -body {
+ list [catch {clock scan "29 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "30 Feb 2016" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}}
+test clock-46.24 {scan: validation rules: invalid day} \
+ -body {
+ list [catch {clock scan "0 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "00 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}}
+test clock-46.25 {scan: validation rules: invalid month} \
+ -body {
+ list [catch {clock scan "13/13/2017" -format "%m/%d/%Y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "00/00/2017" -format "%m/%d/%Y" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid month} 1 {unable to convert input string: invalid month}}
+test clock-46.26 {scan: validation rules: ambiguous day} \
+ -body {
+ list [catch {clock scan "1970-01-01--002" -format "%Y-%m-%d--%j" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "70-01-01--002" -format "%y-%m-%d--%j" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: ambiguous day} 1 {unable to convert input string: ambiguous day}}
+test clock-46.27 {scan: validation rules: ambiguous year} \
+ -body {
+ list [catch {clock scan "19700101 00W014" -format "%Y%m%d %gW%V%u" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "1970001 00W014" -format "%Y%j %gW%V%u" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: ambiguous year} 1 {unable to convert input string: ambiguous year}}
+test clock-46.28 {scan: validation rules: invalid day of week} \
+ -body {
+ list [catch {clock scan "Sat Jan 01 00:00:00 1970" -format "%a %b %d %H:%M:%S %Y" -valid 1 -gmt 1} msg] $msg
+ } -result {1 {unable to convert input string: invalid day of week}}
+test clock-46.29-1 {scan: validation rules: invalid day of year} \
+ -body {
+ list [catch {clock scan "000-2017" -format "%j-%Y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "366-2017" -format "%j-%Y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "000-2017" -format "%j-%G" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "366-2017" -format "%j-%G" -valid 1 -gmt 1} msg] $msg
+ } -result [lrepeat 4 1 {unable to convert input string: invalid day of year}]
+test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \
+ -body {
+ list [clock format [clock scan "366-2016" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y"] \
+ [clock format [clock scan "365-2017" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y"] \
+ [clock format [clock scan "366-2016" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"] \
+ [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"]
+ } -result {31-12-2016 31-12-2017 31-12-2016 31-12-2017}
+test clock-46.30 {scan: validation rules: invalid year} -setup {
+ set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \
+ -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]]
+ clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
+ } -body {
+ list [catch {clock scan "01-01-70" -format "%d-%m-%y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "01-01-1870" -format "%d-%m-%C%y" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "01-01-1970" -format "%d-%m-%Y" -valid 1 -gmt 1} msg] $msg \
+ } -result [lrepeat 3 1 {unable to convert input string: invalid year}] -cleanup {
+ clock configure {*}$orgcfg
+ unset -nocomplain orgcfg
+ }
+test clock-46.31 {scan: validation rules: invalid iso year} -setup {
+ set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \
+ -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]]
+ clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38
+ } -body {
+ list [catch {clock scan "01-01-70" -format "%d-%m-%g" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "01-01-9870" -format "%d-%m-%C%g" -valid 1 -gmt 1} msg] $msg \
+ [catch {clock scan "01-01-9870" -format "%d-%m-%G" -valid 1 -gmt 1} msg] $msg \
+ } -result [lrepeat 3 1 {unable to convert input string: invalid iso year}] -cleanup {
+ clock configure {*}$orgcfg
+ unset -nocomplain orgcfg
+ }
+
test clock-47.1 {regression test - four-digit time} {
clock scan 0012
} [clock scan 0012 -format %H%M]
@@ -36845,12 +37639,19 @@ test clock-61.2 {overflow of a wide integer on output} {*}{
-result {integer value too large to represent}
-returnCodes error
}
-test clock-61.3 {near-miss overflow of a wide integer on output} {
- clock format 0x7fffffffffffffff -format %s -gmt true
-} [expr 0x7fffffffffffffff]
-test clock-61.4 {near-miss overflow of a wide integer on output} {
- clock format -0x8000000000000000 -format %s -gmt true
-} [expr -0x8000000000000000]
+test clock-61.3 {near-miss overflow of a wide integer on output, very large datetime (upper range)} {
+ clock format 0x00F0000000000000 -format "%s %Y %EE" -gmt true
+} [list [expr 0x00F0000000000000] 2140702833 C.E.]
+test clock-61.4 {near-miss overflow of a wide integer on output, very small datetime (lower range)} {
+ clock format -0x00F0000000000000 -format "%s %Y %EE" -gmt true
+} [list [expr -0x00F0000000000000] 2140654939 B.C.E.]
+
+test clock-61.5 {overflow of possible date-time (upper range)} -body {
+ clock format 0x00F0000000000001 -gmt true
+} -returnCodes error -result {integer value too large to represent}
+test clock-61.6 {overflow of possible date-time (lower range)} -body {
+ clock format -0x00F0000000000001 -gmt true
+} -returnCodes error -result {integer value too large to represent}
test clock-62.1 {Bug 1902423} {*}{
-setup {::tcl::clock::ClearCaches}
@@ -36951,9 +37752,12 @@ test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]}
# cleanup
-namespace delete ::testClock
::tcl::clock::ClearCaches
+rename test {}
+rename __test test
::tcltest::cleanupTests
+namespace delete ::testClock
+
return
# Local Variables:
diff --git a/unix/Makefile.in b/unix/Makefile.in
index aaff7ae..c5849ef 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -294,7 +294,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 \
@@ -306,7 +306,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 \
@@ -398,6 +398,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 \
@@ -452,6 +453,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 \
@@ -1035,6 +1037,7 @@ MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h
TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h
+TCLDATEHDR=$(GENERIC_DIR)/tclDate.h $(GENERIC_DIR)/tclStrIdxTree.h
regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1071,9 +1074,12 @@ tclBinary.o: $(GENERIC_DIR)/tclBinary.c
tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c
-tclClock.o: $(GENERIC_DIR)/tclClock.c
+tclClock.o: $(GENERIC_DIR)/tclClock.c $(TCLDATEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c
+tclClockFmt.o: $(GENERIC_DIR)/tclClockFmt.c $(TCLDATEHDR)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClockFmt.c
+
tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c
@@ -1083,7 +1089,7 @@ tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS)
tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c
-tclDate.o: $(GENERIC_DIR)/tclDate.c
+tclDate.o: $(GENERIC_DIR)/tclDate.c $(TCLDATEHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c
tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR)
@@ -1302,6 +1308,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 $(GENERIC_DIR)/tclStrIdxTree.h $(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/unix/config.status.lineno b/unix/config.status.lineno
deleted file mode 100755
index 12d4f40..0000000
--- a/unix/config.status.lineno
+++ /dev/null
@@ -1,920 +0,0 @@
-#! /bin/bash
-# Generated by configure.
-# Run this file to recreate the current configuration.
-# Compiler output produced by configure, useful for debugging
-# configure, is in config.log if it exists.
-
-debug=false
-ac_cs_recheck=false
-ac_cs_silent=false
-SHELL=${CONFIG_SHELL-/bin/bash}
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
- emulate sh
- NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
-fi
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
-fi
-
-
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
-PS1='$ '
-PS2='> '
-PS4='+ '
-
-# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
- fi
-done
-
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
- as_basename=basename
-else
- as_basename=false
-fi
-
-
-# Name of the executable.
-as_me=`$as_basename "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
-
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=103
- as_lineno_2=104
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:128: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=143
- as_lineno_2=144
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with 160
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that 165 is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:179: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
-esac
-
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
- as_ln_s='ln -s'
- fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
-else
- as_ln_s='cp -p'
-fi
-rm -f conf$$ conf$$.exe conf$$.file
-
-if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
-else
- test -d ./-p && rmdir ./-p
- as_mkdir_p=false
-fi
-
-as_executable_p="test -f"
-
-# Sed expression to map a string onto a valid CPP name.
-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
-
-# Sed expression to map a string onto a valid variable name.
-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-
-
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
-exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
-# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
-This file was extended by tcl $as_me 8.6, which was
-generated by GNU Autoconf 2.59. Invocation command line was
-
- CONFIG_FILES = $CONFIG_FILES
- CONFIG_HEADERS = $CONFIG_HEADERS
- CONFIG_LINKS = $CONFIG_LINKS
- CONFIG_COMMANDS = $CONFIG_COMMANDS
- $ $0 $@
-
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
-config_files=" Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
-
-ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
-
-Usage: $0 [OPTIONS] [FILE]...
-
- -h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
- -d, --debug don't remove temporary files
- --recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
-
-Configuration files:
-$config_files
-
-Configuration commands:
-$config_commands
-
-Report bugs to <bug-autoconf@gnu.org>."
-ac_cs_version="\
-tcl config.status 8.6
-configured by ./configure, generated by GNU Autoconf 2.59,
- with options \"'--prefix=/home/jima/space/ins/lin64/dynamic/main'\"
-
-Copyright (C) 2003 Free Software Foundation, Inc.
-This config.status script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it."
-srcdir=/home/jima/space/bui/lin64/dynamic/main/tcl/unix
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
-ac_need_defaults=:
-while test $# != 0
-do
- case $1 in
- --*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
- ac_shift=:
- ;;
- -*)
- ac_option=$1
- ac_optarg=$2
- ac_shift=shift
- ;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
- esac
-
- case $ac_option in
- # Handling of the options.
- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
- ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:336: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
- debug=: ;;
- --file | --fil | --fi | --f )
- $ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
- ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
- ac_need_defaults=false;;
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil | --si | --s)
- ac_cs_silent=: ;;
-
- # This is an error.
- -*) { { echo "$as_me:358: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; } ;;
-
- *) ac_config_targets="$ac_config_targets $1" ;;
-
- esac
- shift
-done
-
-ac_configure_extra_args=
-
-if $ac_cs_silent; then
- exec 6>/dev/null
- ac_configure_extra_args="$ac_configure_extra_args --silent"
-fi
-
-if $ac_cs_recheck; then
- echo "running /bin/bash ./configure " '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args " --no-create --no-recursion" >&6
- exec /bin/bash ./configure '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args --no-create --no-recursion
-fi
-
-#
-# INIT-COMMANDS section.
-#
-
-VERSION=8.6
-
-for ac_config_target in $ac_config_targets
-do
- case "$ac_config_target" in
- # Handling of arguments.
- "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;;
- "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;;
- "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
- "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
- "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
- "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
- "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
- *) { { echo "$as_me:399: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
- esac
-done
-
-# If the user did not use the arguments to specify the items to instantiate,
-# then the envvar interface is used. Set only those that are not.
-# We use the long form for the default assignment because of an extremely
-# bizarre bug on SunOS 4.1.3.
-if $ac_need_defaults; then
- test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
- test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
-fi
-
-# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
-# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
-$debug ||
-{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
-}
-
-# Create a (secure) tmp directory for tmp files.
-
-{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
- test -n "$tmp" && test -d "$tmp"
-} ||
-{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
-} ||
-{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
-}
-
-
-#
-# CONFIG_FILES section.
-#
-
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t$/@;t t/; /@;t t$/s/[\\&,]/\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t$/,;t t/' >$tmp/subs.sed <<\CEOF
-s,@SHELL@,/bin/bash,;t t
-s,@PATH_SEPARATOR@,:,;t t
-s,@PACKAGE_NAME@,tcl,;t t
-s,@PACKAGE_TARNAME@,tcl,;t t
-s,@PACKAGE_VERSION@,8.6,;t t
-s,@PACKAGE_STRING@,tcl 8.6,;t t
-s,@PACKAGE_BUGREPORT@,,;t t
-s,@exec_prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t
-s,@prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t
-s,@program_transform_name@,s,x,x,,;t t
-s,@bindir@,${exec_prefix}/bin,;t t
-s,@sbindir@,${exec_prefix}/sbin,;t t
-s,@libexecdir@,${exec_prefix}/libexec,;t t
-s,@datadir@,${prefix}/share,;t t
-s,@sysconfdir@,${prefix}/etc,;t t
-s,@sharedstatedir@,${prefix}/com,;t t
-s,@localstatedir@,${prefix}/var,;t t
-s,@libdir@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t
-s,@includedir@,${prefix}/include,;t t
-s,@oldincludedir@,/usr/include,;t t
-s,@infodir@,${prefix}/info,;t t
-s,@mandir@,${prefix}/man,;t t
-s,@build_alias@,,;t t
-s,@host_alias@,,;t t
-s,@target_alias@,,;t t
-s,@DEFS@,-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_HIDDEN=1 -DHAVE_CAST_TO_UNION=1 -DTCL_SHLIB_EXT=\".so\" -DNDEBUG=1 -DTCL_CFG_OPTIMIZED=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_IS_LONG=1 -DHAVE_GETCWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_WAITPID=1 -DHAVE_GETNAMEINFO=1 -DHAVE_GETADDRINFO=1 -DHAVE_FREEADDRINFO=1 -DHAVE_GAI_STRERROR=1 -DHAVE_STRUCT_ADDRINFO=1 -DHAVE_STRUCT_IN6_ADDR=1 -DHAVE_STRUCT_SOCKADDR_IN6=1 -DHAVE_STRUCT_SOCKADDR_STORAGE=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_GETHOSTBYNAME_R_6=1 -DHAVE_GETHOSTBYNAME_R=1 -DHAVE_GETHOSTBYADDR_R_8=1 -DHAVE_GETHOSTBYADDR_R=1 -DHAVE_TERMIOS_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DTCL_UNLOAD_DLLS=1 -DHAVE_CPUID=1 ,;t t
-s,@ECHO_C@,,;t t
-s,@ECHO_N@,-n,;t t
-s,@ECHO_T@,,;t t
-s,@LIBS@,-lz -lpthread,;t t
-s,@MAN_FLAGS@,,;t t
-s,@CC@,gcc,;t t
-s,@CFLAGS@, -pipe ,;t t
-s,@LDFLAGS@, -Wl,--export-dynamic ,;t t
-s,@CPPFLAGS@,,;t t
-s,@ac_ct_CC@,gcc,;t t
-s,@EXEEXT@,,;t t
-s,@OBJEXT@,o,;t t
-s,@CPP@,gcc -E,;t t
-s,@EGREP@,grep -E,;t t
-s,@TCL_THREADS@,1,;t t
-s,@TCLSH_PROG@,/home/jima/space/ins/lin64/dynamic/main/bin/tclsh8.6,;t t
-s,@ZLIB_OBJS@,,;t t
-s,@ZLIB_SRCS@,,;t t
-s,@ZLIB_INCLUDE@,,;t t
-s,@RANLIB@,ranlib,;t t
-s,@ac_ct_RANLIB@,ranlib,;t t
-s,@AR@,ar,;t t
-s,@ac_ct_AR@,ar,;t t
-s,@LIBOBJS@,,;t t
-s,@TCL_LIBS@,-ldl -lz -lpthread -lieee -lm,;t t
-s,@DL_LIBS@,-ldl,;t t
-s,@DL_OBJS@,tclLoadDl.o,;t t
-s,@PLAT_OBJS@,,;t t
-s,@PLAT_SRCS@,,;t t
-s,@LDAIX_SRC@,,;t t
-s,@CFLAGS_DEBUG@,-g,;t t
-s,@CFLAGS_OPTIMIZE@,-O2,;t t
-s,@CFLAGS_WARNING@,-Wall,;t t
-s,@LDFLAGS_DEBUG@,,;t t
-s,@LDFLAGS_OPTIMIZE@,,;t t
-s,@CC_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t
-s,@LD_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t
-s,@STLIB_LD@,${AR} cr,;t t
-s,@SHLIB_LD@,${CC} ${CFLAGS} ${LDFLAGS} -shared,;t t
-s,@TCL_SHLIB_LD_EXTRAS@,,;t t
-s,@TK_SHLIB_LD_EXTRAS@,,;t t
-s,@SHLIB_LD_LIBS@,${LIBS},;t t
-s,@SHLIB_CFLAGS@,-fPIC,;t t
-s,@SHLIB_SUFFIX@,.so,;t t
-s,@MAKE_LIB@,${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS},;t t
-s,@MAKE_STUB_LIB@,${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@,;t t
-s,@INSTALL_LIB@,$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)",;t t
-s,@DLL_INSTALL_DIR@,$(LIB_INSTALL_DIR),;t t
-s,@INSTALL_STUB_LIB@,$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)",;t t
-s,@CFLAGS_DEFAULT@,$(CFLAGS_OPTIMIZE),;t t
-s,@LDFLAGS_DEFAULT@,$(LDFLAGS_OPTIMIZE),;t t
-s,@DTRACE@,,;t t
-s,@TCL_VERSION@,8.6,;t t
-s,@TCL_MAJOR_VERSION@,8,;t t
-s,@TCL_MINOR_VERSION@,6,;t t
-s,@TCL_PATCH_LEVEL@,.8,;t t
-s,@TCL_YEAR@,,;t t
-s,@PKG_CFG_ARGS@,'--prefix=/home/jima/space/ins/lin64/dynamic/main' ,;t t
-s,@TCL_LIB_FILE@,libtcl8.6.so,;t t
-s,@TCL_LIB_FLAG@,-ltcl8.6,;t t
-s,@TCL_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltcl8.6,;t t
-s,@TCL_STUB_LIB_FILE@,libtclstub8.6.a,;t t
-s,@TCL_STUB_LIB_FLAG@,-ltclstub8.6,;t t
-s,@TCL_STUB_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltclstub8.6,;t t
-s,@TCL_STUB_LIB_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib/libtclstub8.6.a,;t t
-s,@TCL_INCLUDE_SPEC@,-I/home/jima/space/ins/lin64/dynamic/main/include,;t t
-s,@TCL_BUILD_STUB_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltclstub8.6,;t t
-s,@TCL_BUILD_STUB_LIB_PATH@,/home/jima/space/bui/lin64/dynamic/main/tcl/unix/libtclstub8.6.a,;t t
-s,@TCL_SRC_DIR@,/home/jima/space/bui/lin64/dynamic/main/tcl,;t t
-s,@CFG_TCL_SHARED_LIB_SUFFIX@,${VERSION}.so,;t t
-s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t
-s,@TCL_SHARED_BUILD@,1,;t t
-s,@LD_LIBRARY_PATH_VAR@,LD_LIBRARY_PATH,;t t
-s,@TCL_BUILD_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltcl8.6,;t t
-s,@TCL_LIB_VERSIONS_OK@,ok,;t t
-s,@TCL_SHARED_LIB_SUFFIX@,${VERSION}${SHLIB_SUFFIX},;t t
-s,@TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t
-s,@TCL_HAS_LONGLONG@,,;t t
-s,@INSTALL_TZDATA@,,;t t
-s,@DTRACE_SRC@,,;t t
-s,@DTRACE_HDR@,,;t t
-s,@DTRACE_OBJ@,,;t t
-s,@MAKEFILE_SHELL@,/bin/sh,;t t
-s,@BUILD_DLTEST@,$(DLTEST_TARGETS),;t t
-s,@TCL_PACKAGE_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib ,;t t
-s,@TCL_MODULE_PATH@,,;t t
-s,@TCL_LIBRARY@,$(prefix)/lib/tcl$(VERSION),;t t
-s,@PRIVATE_INCLUDE_DIR@,$(includedir),;t t
-s,@HTML_DIR@,$(DISTDIR)/html,;t t
-s,@PACKAGE_DIR@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t
-s,@EXTRA_CC_SWITCHES@,,;t t
-s,@EXTRA_APP_CC_SWITCHES@,,;t t
-s,@EXTRA_INSTALL@,,;t t
-s,@EXTRA_INSTALL_BINARIES@,@:,;t t
-s,@EXTRA_BUILD_HTML@,@:,;t t
-s,@EXTRA_TCLSH_LIBS@,,;t t
-s,@DLTEST_LD@,${SHLIB_LD},;t t
-s,@DLTEST_SUFFIX@,,;t t
-CEOF
-
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
- fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
- fi
-fi # test -n "$CONFIG_FILES"
-
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
- esac
-
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_file" : 'X\(//\)[^/]' \| \
- X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:660: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
- ac_builddir=.
-
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
- .) # No --srcdir option. We are building in place.
- ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
-
-
- if test x"$ac_file" != x-; then
- { echo "$as_me:732: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:755: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:768: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
- sed "
-
-:t
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
-
-done
-
-#
-# CONFIG_COMMANDS section.
-#
-for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue
- ac_dest=`echo "$ac_file" | sed 's,:.*,,'`
- ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_dir=`(dirname "$ac_dest") 2>/dev/null ||
-$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_dest" : 'X\(//\)[^/]' \| \
- X"$ac_dest" : 'X\(//\)$' \| \
- X"$ac_dest" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_dest" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:837: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
- ac_builddir=.
-
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
- .) # No --srcdir option. We are building in place.
- ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
-
- { echo "$as_me:907: executing $ac_dest commands" >&5
-echo "$as_me: executing $ac_dest commands" >&6;}
- case $ac_dest in
- Tcl.framework ) n=Tcl &&
- f=$n.framework && v=Versions/$VERSION &&
- rm -rf $f && mkdir -p $f/$v/Resources &&
- ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v &&
- ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist &&
- unset n f v
- ;;
- esac
-done
-
-{ (exit 0); exit 0; }
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 6a3766d..2a30386 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -84,6 +84,32 @@ TclpGetSeconds(void)
/*
*----------------------------------------------------------------------
*
+ * TclpGetMicroseconds --
+ *
+ * This procedure returns the number of microseconds from the epoch.
+ * On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ * Number of microseconds from the epoch.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetMicroseconds(void)
+{
+ Tcl_Time time;
+
+ tclGetTimeProcPtr(&time, tclTimeClientData);
+ return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpGetClicks --
*
* This procedure returns a value that represents the highest resolution
@@ -216,6 +242,51 @@ TclpWideClicksToNanoseconds(
return nsec;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpWideClickInMicrosec --
+ *
+ * This procedure return scale to convert click values from the
+ * TclpGetWideClicks native resolution to microsecond resolution
+ * and back.
+ *
+ * Results:
+ * 1 click in microseconds as double.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclpWideClickInMicrosec(void)
+{
+ if (tclGetTimeProcPtr != NativeGetTime) {
+ return 1.0;
+ } else {
+#ifdef MAC_OSX_TCL
+ static int initialized = 0;
+ static double scale = 0.0;
+
+ if (initialized) {
+ return scale;
+ } else {
+ mach_timebase_info_data_t tb;
+
+ mach_timebase_info(&tb);
+ /* value of tb.numer / tb.denom = 1 click in nanoseconds */
+ scale = ((double)tb.numer) / tb.denom / 1000;
+ initialized = 1;
+ return scale;
+ }
+#else
+#error Wide high-resolution clicks not implemented on this platform
+#endif
+ }
+}
#endif /* TCL_WIDE_CLICKS */
/*
diff --git a/win/Makefile.in b/win/Makefile.in
index 9d955cd..720b0b8 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) \
@@ -290,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 0e1e1fd..307f0d3 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -161,6 +161,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 \
@@ -223,6 +224,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 \
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 7f4f7e5..9d723c9 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -110,6 +110,17 @@ static TimeInfo timeInfo = {
};
/*
+ * Scale to convert wide click values from the TclpGetWideClicks native
+ * resolution to microsecond resolution and back.
+ */
+static struct {
+ int initialized; /* 1 if initialized, 0 otherwise */
+ int perfCounter; /* 1 if performance counter usable for wide clicks */
+ double microsecsScale; /* Denominator scale between clock / microsecs */
+} wideClick = {0, 0.0};
+
+
+/*
* Declarations for functions defined later in this file.
*/
@@ -123,6 +134,7 @@ static Tcl_WideInt AccumulateSample(Tcl_WideInt perfCounter,
Tcl_WideUInt fileTime);
static void NativeScaleTime(Tcl_Time* timebuf,
ClientData clientData);
+static Tcl_WideInt NativeGetMicroseconds(void);
static void NativeGetTime(Tcl_Time* timebuf,
ClientData clientData);
@@ -154,10 +166,19 @@ ClientData tclTimeClientData = NULL;
unsigned long
TclpGetSeconds(void)
{
- Tcl_Time t;
+ Tcl_WideInt usecSincePosixEpoch;
- tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
- return t.sec;
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return usecSincePosixEpoch / 1000000;
+ } else {
+ Tcl_Time t;
+
+ tclGetTimeProcPtr(&t, tclTimeClientData); /* Tcl_GetTime inlined. */
+ return t.sec;
+ }
}
/*
@@ -182,19 +203,147 @@ TclpGetSeconds(void)
unsigned long
TclpGetClicks(void)
{
- /*
- * Use the Tcl_GetTime abstraction to get the time in microseconds, as
- * nearly as we can, and return it.
- */
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return (unsigned long)usecSincePosixEpoch;
+ } else {
+ /*
+ * Use the Tcl_GetTime abstraction to get the time in microseconds, as
+ * nearly as we can, and return it.
+ */
- Tcl_Time now; /* Current Tcl time */
- unsigned long retval; /* Value to return */
+ Tcl_Time now; /* Current Tcl time */
+
+ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ return (unsigned long)(now.sec * 1000000) + now.usec;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetWideClicks --
+ *
+ * This procedure returns a WideInt value that represents the highest
+ * resolution clock in microseconds available on the system.
+ *
+ * Results:
+ * Number of microseconds (from some start time).
+ *
+ * Side effects:
+ * This should be used for time-delta resp. for measurement purposes
+ * only, because on some platforms can return microseconds from some
+ * start time (not from the epoch).
+ *
+ *----------------------------------------------------------------------
+ */
- tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+Tcl_WideInt
+TclpGetWideClicks(void)
+{
+ LARGE_INTEGER curCounter;
- retval = (now.sec * 1000000) + now.usec;
- return retval;
+ if (!wideClick.initialized) {
+ LARGE_INTEGER perfCounterFreq;
+ /*
+ * The frequency of the performance counter is fixed at system boot and
+ * is consistent across all processors. Therefore, the frequency need
+ * only be queried upon application initialization.
+ */
+ if (QueryPerformanceFrequency(&perfCounterFreq)) {
+ wideClick.perfCounter = 1;
+ wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
+ } else {
+ /* fallback using microseconds */
+ wideClick.perfCounter = 0;
+ wideClick.microsecsScale = 1;
+ }
+
+ wideClick.initialized = 1;
+ }
+ if (wideClick.perfCounter) {
+ if (QueryPerformanceCounter(&curCounter)) {
+ return (Tcl_WideInt)curCounter.QuadPart;
+ }
+ /* fallback using microseconds */
+ wideClick.perfCounter = 0;
+ wideClick.microsecsScale = 1;
+ return TclpGetMicroseconds();
+ } else {
+ return TclpGetMicroseconds();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpWideClickInMicrosec --
+ *
+ * This procedure return scale to convert wide click values from the
+ * TclpGetWideClicks native resolution to microsecond resolution
+ * and back.
+ *
+ * Results:
+ * 1 click in microseconds as double.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+TclpWideClickInMicrosec(void)
+{
+ if (!wideClick.initialized) {
+ (void)TclpGetWideClicks(); /* initialize */
+ }
+ return wideClick.microsecsScale;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetMicroseconds --
+ *
+ * This procedure returns a WideInt value that represents the highest
+ * resolution clock in microseconds available on the system.
+ *
+ * Results:
+ * Number of microseconds (from the epoch).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_WideInt
+TclpGetMicroseconds(void)
+{
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ return usecSincePosixEpoch;
+ } else {
+ /*
+ * Use the Tcl_GetTime abstraction to get the time in microseconds, as
+ * nearly as we can, and return it.
+ */
+
+ Tcl_Time now;
+
+ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */
+ return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
+ }
}
/*
@@ -223,7 +372,17 @@ void
Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
- tclGetTimeProcPtr(timePtr, tclTimeClientData);
+ Tcl_WideInt usecSincePosixEpoch;
+
+ /* Try to use high resolution timer */
+ if ( tclGetTimeProcPtr == NativeGetTime
+ && (usecSincePosixEpoch = NativeGetMicroseconds())
+ ) {
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ } else {
+ tclGetTimeProcPtr(timePtr, tclTimeClientData);
+ }
}
/*
@@ -256,13 +415,14 @@ NativeScaleTime(
/*
*----------------------------------------------------------------------
*
- * NativeGetTime --
+ * NativeGetMicroseconds --
*
- * TIP #233: Gets the current system time in seconds and microseconds
- * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ * Gets the current system time in microseconds since the beginning
+ * of the epoch: 00:00 UCT, January 1, 1970.
*
* Results:
- * Returns the current time in timePtr.
+ * Returns the wide integer with number of microseconds from the epoch, or
+ * 0 if high resolution timer is not available.
*
* Side effects:
* On the first call, initializes a set of static variables to keep track
@@ -275,13 +435,12 @@ NativeScaleTime(
*----------------------------------------------------------------------
*/
-static void
-NativeGetTime(
- Tcl_Time *timePtr,
- ClientData clientData)
+static Tcl_WideInt
+NativeGetMicroseconds(void)
{
- struct _timeb t;
-
+ static LARGE_INTEGER posixEpoch;
+ /* Posix epoch expressed as 100-ns ticks since
+ * the windows epoch. */
/*
* Initialize static storage on the first trip through.
*
@@ -292,6 +451,10 @@ NativeGetTime(
if (!timeInfo.initialized) {
TclpInitLock();
if (!timeInfo.initialized) {
+
+ posixEpoch.LowPart = 0xD53E8000;
+ posixEpoch.HighPart = 0x019DB1DE;
+
timeInfo.perfCounterAvailable =
QueryPerformanceFrequency(&timeInfo.nominalFreq);
@@ -404,15 +567,9 @@ NativeGetTime(
/* Current performance counter. */
Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
* ticks since the Windows epoch. */
- static LARGE_INTEGER posixEpoch;
- /* Posix epoch expressed as 100-ns ticks since
- * the windows epoch. */
Tcl_WideInt usecSincePosixEpoch;
/* Current microseconds since Posix epoch. */
- posixEpoch.LowPart = 0xD53E8000;
- posixEpoch.HighPart = 0x019DB1DE;
-
QueryPerformanceCounter(&curCounter);
/*
@@ -432,9 +589,7 @@ NativeGetTime(
if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) {
usecSincePosixEpoch =
(fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
+ return usecSincePosixEpoch;
}
/*
@@ -455,19 +610,57 @@ NativeGetTime(
* 10000000 / curCounterFreq.QuadPart);
usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
- timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
- timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
- return;
+ return usecSincePosixEpoch;
}
}
/*
- * High resolution timer is not available. Just use ftime.
+ * High resolution timer is not available.
*/
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeGetTime --
+ *
+ * TIP #233: Gets the current system time in seconds and microseconds
+ * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ * Returns the current time in timePtr.
+ *
+ * Side effects:
+ * See NativeGetMicroseconds for more information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NativeGetTime(
+ Tcl_Time *timePtr,
+ ClientData clientData)
+{
+ Tcl_WideInt usecSincePosixEpoch;
- _ftime(&t);
- timePtr->sec = (long)t.time;
- timePtr->usec = t.millitm * 1000;
+ /*
+ * Try to use high resolution timer.
+ */
+ if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
+ timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
+ timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+ } else {
+ /*
+ * High resolution timer is not available. Just use ftime.
+ */
+
+ struct _timeb t;
+
+ _ftime(&t);
+ timePtr->sec = (long)t.time;
+ timePtr->usec = t.millitm * 1000;
+ }
}
/*
generated by cgit v0.12 at 2024-10-28 01:13:25 (GMT)