diff options
| author | Kevin B Kenny <kennykb@acm.org> | 2005-04-25 21:37:17 (GMT) |
|---|---|---|
| committer | Kevin B Kenny <kennykb@acm.org> | 2005-04-25 21:37:17 (GMT) |
| commit | fee601196f3a3d37e48ca7a5ea763cd132e49cd6 (patch) | |
| tree | 132b0442d0fa8a33d0b625e1de318963e109bb78 | |
| parent | 6cf83d45073c586faca9948b305311770bcc49ca (diff) | |
| download | tcl-fee601196f3a3d37e48ca7a5ea763cd132e49cd6.zip tcl-fee601196f3a3d37e48ca7a5ea763cd132e49cd6.tar.gz tcl-fee601196f3a3d37e48ca7a5ea763cd132e49cd6.tar.bz2 | |
Merged with HEAD.
65 files changed, 1612 insertions, 2496 deletions
@@ -1,9 +1,110 @@ -2005-04-25 Kevin B. Kenny <kennykb@acm.org> - - [tcl-numerics-branch] +2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net> + + [tcl-numerics-branch] Merged with HEAD. * doc/CrtMathFunc.n: Revised documentation for TIP 232 +2005-04-25 Kevin B. Kenny <kennykb@users.sourceforge.net> + + * library/tzdata/America/Boise: + * library/tzdata/America/Chicago: + * library/tzdata/America/Denver + * library/tzdata/America/Indianapolis: + * library/tzdata/America/Los_Angeles: + * library/tzdata/America/Louisville: + * library/tzdata/America/Managua: + * library/tzdata/America/New_York: + * library/tzdata/America/Phoenix: + * library/tzdata/America/Port-au-Prince: + * library/tzdata/America/Indiana/Knox: + * library/tzdata/America/Indiana/Marengo: + * library/tzdata/America/Indiana/Vevay: + * library/tzdata/America/Kentucky/Monticello: + * library/tzdata/America/North_Dakota/Center: + * library/tzdata/Asia/Tehran: + Olson's tzdata2005i. Corrects exact time at which Standard Time + was adopted in the US (generally, noon, Standard Time, rather than + noon, Local Mean Time). Adopts new civil rules for Nicaragua + and Iran. + +2005-04-25 Don Porter <dgp@users.sourceforge.net> + + * library/init.tcl: Use "ni" and "in" operators. + +2005-04-25 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: fix for [Bug 1189274]. + +2005-04-24 Don Porter <dgp@users.sourceforge.net> + + * generic/tclLiteral.c: Silence compiler warnings. + * generic/tclObj.c: [Bug 1188863]. + +2005-04-22 Don Porter <dgp@users.sourceforge.net> + + The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring + it into agreement with its docs. Further investigation reveals it + was the docs that were incorrect. + + * doc/BoolObj.3: Corrections to the documentation of + Tcl_GetBooleanFromObj to bring it into agreement with what this + public interface has always done, including noting the difference + in function between Tcl_GetBooleanFromObj and Tcl_GetBoolean. + + * generic/tclGet.c: Revised Tcl_GetBoolean to no longer be a + wrapper around Tcl_GetBooleanFromObj (different function!). + + * generic/tclObj.c: Removed TclGetTruthValueFromObj routine + that was added yesterday. Revisions so that only + Tcl_GetBoolean-approved values get the "boolean" Tcl_ObjType. + This retains the fix for [Bug 1187123]. + * tests/string.test: Test string-23.0 for Bug 1187123. + + * generic/tclInt.h: Revert most recent change. + * generic/tclBasic.c: + * generic/tclCompCmds.c: + * generic/tclDictObj.c: + * generic/tclExecute.c: + * tests/obj.test: + +2005-04-21 Don Porter <dgp@users.sourceforge.net> + + * doc/GetInt.3: Convert argument "string" to "str" to agree with code. + Also clarified a few details on int and double formats. + * generic/tclGet.c: Radical code simplification. Converted + Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj(). + Reduces code duplication, and the resulting potential for inconsistency. + + * generic/tclObj.c: Several changes: + + - Re-ordered error detection code so all values with trailing + garbage receive a "not an integer" message instead of an + "integer too large" message. + - Removed inactive code meant to deal with strtoul* routines that + fail to parse leading signs. All of them do, and if any are + detected that do not, the correct fix is replacement with + compat/strtoul*.c, not a lot of special care by the callers. + - Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep. + - Fixed Tcl_GetBooleanFromObj to agree with its documentation and + with Tcl_GetBoolean, accepting only "0" and "1" and not other + numeric strings. [Bug 1187123] + - Added new private routine TclGetTruthValueFromObj to perform + the more permissive conversion of numeric values to boolean + that is needed by the [expr] machinery. + + * generic/tclInt.h (TclGetTruthValueFromObj): New routine. + * generic/tclExecute.c: Updated callers to call new routine. + * generic/tclBasic.c: Updated callers to call new routine. + * generic/tclCompCmds.c: Updated callers to call new routine. + * generic/tclDictObj.c: Updated callers to call new routine. + * tests/obj.test: Corrected bad tests that actually expected + values like "47" and "0xac" to be accepted as booleans. + + * generic/tclLiteral.c: Disabled the code that forces some literals + into the "int" Tcl_ObjType during registration. We can re-enable it + if this change causes trouble, but it seems more sensible to let + Tcl's "on-demand" shimmering rule, and not try to pre-guess things. + 2005-04-20 Kevin B. Kenny <kennykb@acm.org> [tcl-numerics-branch] @@ -11,6 +112,159 @@ * doc/expr.n: * doc/mathfunc.n (new file): Revised documentation for TIP 232 +2005-04-20 Don Porter <dgp@users.sourceforge.net> + + * generic/tclGet.c (Tcl_GetInt): Corrected error that did not + * generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be + recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869]. + +2005-04-20 Kevin B. Kenny <kennykb@acm.org> + + * generic/tclFileName.c: Silenced a compiler warning about + '/*' within a comment. + +2005-04-19 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Added unsupported command + * generic/tclCmdAH.c: [::tcl::unsupported::EncodingDirs] to permit + * generic/tclInt.h: query/set of the encoding search path at + * generic/tclInterp.c: the script level. Updated init.tcl to make + * library/init.tcl: use of the new command. Also updated several + coding practices in init.tcl ("eq" for [string equal], etc.) + +2005-04-19 Kevin B. Kenny <kennykb@acm.org> + + * library/clock.tcl (Initialize): Put initialization code into a + proc to avoid inadvertently clobbering global variables. + [Bug 1185933] + * tests/clock.test (clock-48.1): Added regression test for the + above bug. + Thanks to Ulrich Ring for reporting this bug. + +2005-04-16 Miguel Sofer <msofer@users.sf.net> + + * generic/Var.c (Tcl_ArrayObjCmd - ARRAY_NAMES): fix Tcl_Obj leak + [Bug 1084111] + +2005-04-16 Zoran Vasiljevic <vasiljevic@users.sf.net> + + * generic/tclIOUtil.c: force clenaup of the interp result + in TclLoadFile(). Some implementations of TclpFindSymbol() + will seed the interp result with error message when unable + to find the requested symbol (this is not considered to + be an error). + + Set of changes correcting huge memory waste (not a leak) + when a thread exits. This has been introduced in 8.4.7 + within an attempt to correctly cleanup after ourselves when + Tcl library is being unloaded with the Tcl_Finalize() call. + + This fixes the Tcl Bug #1178445. + + * generic/tclInt.h: added prototypes for TclpFreeAllocCache() + and TclFreeAllocCache() + + * generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() + to explicitly call TclpFreeAllocCache with the NULL-ptr as + argument signalling cleanup of private tsd key used only by + the threading allocator. + + * unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize + when being called with NULL argument. This is a signal for it + to clean up the tsd key associated with the threading allocator. + + * win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache + and fixed to recognize when being called with NULL argument. + This is a signal for it to clean up the tsd key associated with the + threading allocator. + +2005-04-13 Don Porter <dgp@users.sourceforge.net> + + * tests/unixInit.test: Disabled obsolete tests and removed code + * tests/encoding.test: that supported them. + * generic/tclInterp.c: + + * library/init.tcl: Use auto-loading to bring in Tcl Module + * library/tclIndex: support as needed. This reduces startup + * library/tm.tcl: time by delaying this initialization to + a later time. + +2005-04-15 Miguel Sofer <msofer@users.sf.net> + + * generic/tclExecute.c: missing semicolons caused failure to + compile with TCL_COMPILE_DEBUG. + +2005-04-13 David Gravereaux <davygrvy@pobox.com> + + * generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit + * tests/io.test: changed from ten bytes to one byte. Need + * tests/iogt.test: for this change was proven by + Ross Cartlidge <rossc@cisco.com> where [read stdin 1] was grabbing + 10 bytes followed by starting a child process that was intended to + continue reading from stdin. Even with -buffersize set to one, + nine chars were getting lost by the buffersize over reading for + the native read() caused by [read]. + +2005-04-13 Don Porter <dgp@users.sourceforge.net> + + * unix/tclUnixInit.c (TclpGetEncodingNameFromEnvironment): Reversed + order of verifying candidate [encoding system] value, checking against + a table in memory first before calling Tcl_GetEncoding and potentially + scanning through the filesystem. Also ordered the table so that a + binary search could be used within it. Improves startup time a bit + more on some systems. + +2004-04-13 Kevin B. Kenny <kennykb@acm.org> + + * library/clock.n: Added a missing '--' on several [switch] + commands to improve performance of [clock format] and related + operations. [Feature Request 1182459] + +2005-04-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * doc/fcopy.n: Improved documentation on copying binary files, + added an example and mentioned the use of [file copy]. + * doc/fconfigure.n: Improved documentation of -encoding binary + option. + This is all following comments from Steve Manning <steve@manning.net> + on comp.lang.tcl that the current documentation was not clear. + +2005-04-13 Miguel Sofer <msofer@users.sf.net> + + * generic/tclCompile.c:Commented out the functions + TclPrintInstruction(), TclPrintObject() and TclPrintSource() when + not debugging the compiler, as they are never called in that case. + +2005-04-12 Don Porter <dgp@users.sourceforge.net> + + * generic/tclInterp.c: Corrected bad syntax of Tcl_Panic() call. + + * generic/tclUtil.c (TclGetProcessGlobalValue): More robust handling + of bad TclInitProcessGlobalValueProc behavior; an immediate panic + rather than a mysterious crash later. + + * generic/tclEncoding.c: Several changes to the way the + encodingFileMap cache is maintained. Previously, it was attempted + to keep the file map filled and up to date with changes in the + encoding search path. This contributed to slow startup times since + it required an expensive "glob" operation to fill the cache. Now the + validity of items in the cache are checked at the time they are + used, so the cache is permitted to fall out of sync with the + encoding search path. Only [encoding names] and Tcl_GetEncodingNames() + now pay the full expense. [Bug 1177363] + +2005-04-12 Kevin B. Kenny <kennykb@acm.org> + + * compat/strstr.c: Added default definition of NULL to + accommodate building on systems with badly broken headers. + [Bug #1175161] + +2005-04-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * tools/tclZIC.tcl: Rewrote to take advantage of more features of + Tcl 8.5 (on which it was dependent anyway). Also added a [package + require] line to formalize the relationship. + 2005-04-11 Kevin Kenny <kennykb@users.sf.net> [tcl_numerics-branch] Merged with HEAD. Updated to libtommath 0.35. @@ -20,6 +274,23 @@ with (possibly) a few more uses of his new object creation macros. Also plugged a memory leak in TclObjInvoke. [Bug 1180368] +2005-04-10 Kevin Kenny <kennykb@acm.org> + + * library/tzdata/America/Montevideo: + * library/tzdata/Asia/Almaty: + * library/tzdata/Asia/Aqtau: + * library/tzdata/Asia/Aqtobe: + * library/tzdata/Asia/Baku: + * library/tzdata/Asia/Jerusalem: + * library/tzdata/Asia/Oral: + * library/tzdata/Asia/Qyzylorda: + * library/tzdata/Indian/Chagos: + * library/tzdata/Indian/Cocos: Olson's tzdata2005h + +2005-04-10 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c (TclObjInvoke): Plug memory leak. [Bug 1180368] + 2005-04-09 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c: fix possible leak of expansion Tcl_Objs diff --git a/compat/strstr.c b/compat/strstr.c index d1f8516..977ac28 100644 --- a/compat/strstr.c +++ b/compat/strstr.c @@ -9,10 +9,13 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: strstr.c,v 1.4 2004/04/06 22:25:48 dgp Exp $ + * RCS: @(#) $Id: strstr.c,v 1.4.2.1 2005/04/25 21:37:18 kennykb Exp $ */ #include "tcl.h" +#ifndef NULL +#define NULL 0 +#endif /* *---------------------------------------------------------------------- diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 41c0a73..3b05a9e 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: BoolObj.3,v 1.5 2004/10/07 15:37:43 dkf Exp $ +'\" RCS: @(#) $Id: BoolObj.3,v 1.5.2.1 2005/04/25 21:37:18 kennykb Exp $ '\" .so man.macros .TH Tcl_BooleanObj 3 8.0 Tcl "Tcl Library Procedures" @@ -65,25 +65,35 @@ and, if the object is not already a boolean object, frees any old internal representation. .PP \fBTcl_GetBooleanFromObj\fR attempts to return a boolean value -from the Tcl object \fIobjPtr\fR. -If the object is not already a boolean object, -it will attempt to convert it to one. -If an error occurs during conversion, it returns \fBTCL_ERROR\fR -and leaves an error message in the interpreter's result object -unless \fIinterp\fR is NULL. -Otherwise, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR -and stores the boolean value in the address given by \fIboolPtr\fR. -If the object is not already a boolean object, -the conversion will free any old internal representation. -Objects having a string representation equal to any of \fB0\fR, -\fBfalse\fR, \fBno\fR, or \fBoff\fR have a boolean value 0; if the -string representation is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or -\fBon\fR the boolean value is 1. -Any of these string values may be abbreviated, and upper-case spellings -are also acceptable. +corresponding to the value of the Tcl object \fIobjPtr\fR. +If \fIobjPtr\fR is of the boolean type, its boolean value +is written at the address given by \fIboolPtr\fR. +If \fIobjPtr\fR has a string representation recognized by +\fBTcl_GetBoolean\fR, then \fIobjPtr\fR is converted to boolean +type and its boolean value is written at the address given +by \fIboolPtr\fR. If \fIobjPtr\fR holds any value recognized as +a number by Tcl, then if that value is zero a 0 is written at +the address given by \fIboolPtr\fR and if that +value is non-zero a 1 is written at the address given by \fIboolPtr\fR. +In all cases where a value is written at the address given +by \fIboolPtr\fR, \fBTCL_OK\fR is returned. +If the value of \fIobjPtr\fR does not meet any of the conditions +above, then \fBTCL_ERROR\fR is returned and error message is +left in the interpreter's result unless \fIinterp\fR is NULL. +.PP +Note that the routines \fBTcl_GetBooleanFromObj\fR and +\fBTcl_GetBoolean\fR are not functional equivalents. +The set of values for which \fBTcl_GetBooleanFromObj\fR +will return \fBTCL_OK\fR is strictly larger than +the set of values for which \fBTcl_GetBoolean\fR will do the same. +For example, the value "5" passed to \fBTcl_GetBooleanFromObj\fR +will lead to a \fBTCL_OK\fR return (and the boolean value 1), +while the same value passed to \fBTcl_GetBoolean\fR will lead to +a \fBTCL_ERROR\fR return. .SH "SEE ALSO" -Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult +Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult, +Tcl_GetBoolean .SH KEYWORDS boolean, boolean object, boolean type, internal representation, object, object type, string representation diff --git a/doc/GetInt.3 b/doc/GetInt.3 index bd1475e..515dd91 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetInt.3,v 1.7 2004/10/07 15:15:38 dkf Exp $ +'\" RCS: @(#) $Id: GetInt.3,v 1.7.2.1 2005/04/25 21:37:18 kennykb Exp $ '\" .so man.macros .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures" @@ -17,62 +17,64 @@ Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, dou \fB#include <tcl.h>\fR .sp int -\fBTcl_GetInt\fR(\fIinterp, string, intPtr\fR) +\fBTcl_GetInt\fR(\fIinterp, str, intPtr\fR) .sp int -\fBTcl_GetDouble\fR(\fIinterp, string, doublePtr\fR) +\fBTcl_GetDouble\fR(\fIinterp, str, doublePtr\fR) .sp int -\fBTcl_GetBoolean\fR(\fIinterp, string, boolPtr\fR) +\fBTcl_GetBoolean\fR(\fIinterp, str, boolPtr\fR) .SH ARGUMENTS .AS Tcl_Interp *doublePtr out .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP "const char" *string in +.AP "const char" *str in Textual value to be converted. .AP int *intPtr out -Points to place to store integer value converted from \fIstring\fR. +Points to place to store integer value converted from \fIstr\fR. .AP double *doublePtr out Points to place to store double-precision floating-point -value converted from \fIstring\fR. +value converted from \fIstr\fR. .AP int *boolPtr out -Points to place to store boolean value (0 or 1) converted from \fIstring\fR. +Points to place to store boolean value (0 or 1) converted from \fIstr\fR. .BE .SH DESCRIPTION .PP These procedures convert from strings to integers or double-precision floating-point values or booleans (represented as 0- or 1-valued -integers). Each of the procedures takes a \fIstring\fR argument, +integers). Each of the procedures takes a \fIstr\fR argument, converts it to an internal form of a particular type, and stores the converted value at the location indicated by the procedure's third argument. If all goes well, each of the procedures returns -\fBTCL_OK\fR. If \fIstring\fR doesn't have the proper syntax for the +\fBTCL_OK\fR. If \fIstr\fR doesn't have the proper syntax for the desired type then \fBTCL_ERROR\fR is returned, an error message is left in the interpreter's result, and nothing is stored at *\fIintPtr\fR or *\fIdoublePtr\fR or *\fIboolPtr\fR. .PP -\fBTcl_GetInt\fR expects \fIstring\fR to consist of a collection +\fBTcl_GetInt\fR expects \fIstr\fR to consist of a collection of integer digits, optionally signed and optionally preceded by -white space. If the first two characters of \fIstring\fR are ``0x'' -then \fIstring\fR is expected to be in hexadecimal form; otherwise, -if the first character of \fIstring\fR is ``0'' then \fIstring\fR -is expected to be in octal form; otherwise, \fIstring\fR is +white space. If the first two characters of \fIstr\fR +after the optional white space and sign are ``0x'' +then \fIstr\fR is expected to be in hexadecimal form; otherwise, +if the first such character is ``0'' then \fIstr\fR +is expected to be in octal form; otherwise, \fIstr\fR is expected to be in decimal form. .PP -\fBTcl_GetDouble\fR expects \fIstring\fR to consist of a floating-point +\fBTcl_GetDouble\fR expects \fIstr\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a -decimal point; a sequence of digits; the letter ``e''; and a -signed decimal exponent. Any of the fields may be omitted, except that +decimal point; a sequence of digits; the letter ``e''; a +signed decimal exponent ; and more white space. +Any of the fields may be omitted, except that the digits either before or after the decimal point must be present and if the ``e'' is present then it must be followed by the exponent number. .PP -\fBTcl_GetBoolean\fR expects \fIstring\fR to specify a boolean -value. If \fIstring\fR is any of \fB0\fR, \fBfalse\fR, +\fBTcl_GetBoolean\fR expects \fIstr\fR to specify a boolean +value. If \fIstr\fR is any of \fB0\fR, \fBfalse\fR, \fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero value at \fI*boolPtr\fR. -If \fIstring\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, +If \fIstr\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, then 1 is stored at \fI*boolPtr\fR. Any of these values may be abbreviated, and upper-case spellings are also acceptable. diff --git a/doc/fconfigure.n b/doc/fconfigure.n index 807ce90..56cbf8a 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: fconfigure.n,v 1.11 2004/10/27 12:53:22 dkf Exp $ +'\" RCS: @(#) $Id: fconfigure.n,v 1.11.2.1 2005/04/25 21:37:18 kennykb Exp $ '\" .so man.macros .TH fconfigure n 8.3 Tcl "Tcl Built-In Commands" @@ -91,11 +91,14 @@ If a file contains pure binary data (for instance, a JPEG image), the encoding for the channel should be configured to be \fBbinary\fR. Tcl will then assign no interpretation to the data in the file and simply read or write raw bytes. The Tcl \fBbinary\fR command can be used to manipulate this -byte-oriented data. +byte-oriented data. It is usually better to set the +\fB\-translation\fR option to \fBbinary\fR when you want to transfer +binary data, as this turns off the other automatic interpretations of +the bytes in the stream as well. .PP The default encoding for newly opened channels is the same platform- and locale-dependent system encoding used for interfacing with the operating -system. +system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR diff --git a/doc/fcopy.n b/doc/fcopy.n index a90cc7b..11f0689 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: fcopy.n,v 1.4 2004/09/06 09:44:56 dkf Exp $ +'\" RCS: @(#) $Id: fcopy.n,v 1.4.2.1 2005/04/25 21:37:19 kennykb Exp $ '\" .so man.macros .TH fcopy n 8.0 Tcl "Tcl Built-In Commands" @@ -72,12 +72,15 @@ Only the number of bytes written to \fIoutchan\fR is reported, either as the return value of a synchronous \fBfcopy\fP or as the argument to the callback for an asynchronous \fBfcopy\fP. .PP -\fBFcopy\fR obeys the encodings configured for the channels. This +\fBFcopy\fR obeys the encodings and character translations configured +for the channels. This means that the incoming characters are converted internally first UTF-8 and then into the encoding of the channel \fBfcopy\fR writes to. See the manual entry for \fBfconfigure\fR for details on the -\fB\-encoding\fR option. No conversion is done if both channels are -set to encoding "binary". If only the output channel is set to +\fB\-encoding\fR and \fB\-translation\fR options. No conversion is +done if both channels are +set to encoding "binary" and have matching translations. If only the +output channel is set to encoding "binary" the system will write the internal UTF-8 representation of the incoming characters. If only the input channel is set to encoding "binary" the system will assume that the incoming @@ -85,9 +88,19 @@ bytes are valid UTF-8 characters and convert them according to the output encoding. The behaviour of the system for bytes which are not valid UTF-8 characters is undefined in this case. -.SH EXAMPLE +.SH EXAMPLES .PP -This first example shows how the callback gets +The first example transfers the contents of one channel exactly to +another. Note that when copying one file to another, it is better to +use \fBfile copy\fR which also copies file metadata (e.g. the file +access permissions) where possible. +.DS +fconfigure $in -translation binary +fconfigure $out -translation binary +\fBfcopy\fR $in $out +.DE +.PP +This second example shows how the callback gets passed the number of bytes transferred. It also uses vwait to put the application into the event loop. Of course, this simplified example could be done without the command @@ -104,12 +117,11 @@ proc Cleanup {in out bytes {error {}}} { } set in [open $file1] set out [socket $server $port] -fcopy $in $out -command [list Cleanup $in $out] +\fBfcopy\fR $in $out -command [list Cleanup $in $out] vwait total - .DE .PP -The second example copies in chunks and tests for end of file +The third example copies in chunks and tests for end of file in the command callback .DS proc CopyMore {in out chunk bytes {error {}}} { @@ -120,7 +132,7 @@ proc CopyMore {in out chunk bytes {error {}}} { close $in close $out } else { - fcopy $in $out -command [list CopyMore $in $out $chunk] \\ + \fBfcopy\fR $in $out -command [list CopyMore $in $out $chunk] \\ -size $chunk } } @@ -128,13 +140,12 @@ set in [open $file1] set out [socket $server $port] set chunk 1024 set total 0 -fcopy $in $out -command [list CopyMore $in $out $chunk] -size $chunk +\fBfcopy\fR $in $out -command [list CopyMore $in $out $chunk] -size $chunk vwait done - .DE .SH "SEE ALSO" -eof(n), fblocked(n), fconfigure(n) +eof(n), fblocked(n), fconfigure(n), file(n) .SH KEYWORDS blocking, channel, end of line, end of file, nonblocking, read, translation diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 66631a1..b7c1a1b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.136.2.6 2005/04/10 23:14:45 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.7 2005/04/25 21:37:19 kennykb Exp $ */ #include "tclInt.h" @@ -573,6 +573,10 @@ Tcl_CreateInterp() TclDefaultBgErrorHandlerObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL ); + /* Register the unsupported encoding search path command */ + Tcl_CreateObjCommand (interp, "::tcl::unsupported::EncodingDirs", + TclEncodingDirsObjCmd, NULL, NULL); + /* * Register the builtin math functions. */ @@ -4348,20 +4352,7 @@ Tcl_ExprBoolean(interp, string, ptr) /* * Store a boolean based on the expression result. */ - - if (resultPtr->typePtr == &tclIntType) { - *ptr = (resultPtr->internalRep.longValue != 0); - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = (resultPtr->internalRep.doubleValue != 0.0); - } else if (resultPtr->typePtr == &tclWideIntType) { -#ifndef TCL_WIDE_INT_IS_LONG - *ptr = (resultPtr->internalRep.wideValue != 0); -#else - *ptr = (resultPtr->internalRep.longValue != 0); -#endif - } else { - result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); - } + result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); Tcl_DecrRefCount(resultPtr); /* discard the result object */ } if (result != TCL_OK) { @@ -4471,13 +4462,7 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr) result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result == TCL_OK) { - if (resultPtr->typePtr == &tclIntType) { - *ptr = (resultPtr->internalRep.longValue != 0); - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = (resultPtr->internalRep.doubleValue != 0.0); - } else { - result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); - } + result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr); Tcl_DecrRefCount(resultPtr); /* discard the result object */ } return result; @@ -4620,7 +4605,7 @@ TclObjInvoke(interp, objc, objv, flags) Tcl_IncrRefCount( command ); cmdString = Tcl_GetStringFromObj(command, &length); Tcl_LogCommandInfo(interp, cmdString, cmdString, length); - Tcl_DecrRefCount( command ); + Tcl_DecrRefCount(command); iPtr->flags &= ~ERR_ALREADY_LOGGED; } return result; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 60893fd..b75272a 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.2 2005/04/10 23:14:45 kennykb Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.3 2005/04/25 21:37:19 kennykb Exp $ */ #include "tclInt.h" @@ -530,6 +530,45 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv) /* *---------------------------------------------------------------------- * + * TclEncodingDirsObjCmd -- + * + * This command manipulates the encoding search path. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Can set the encoding search path. + * + *---------------------------------------------------------------------- + */ + +int +TclEncodingDirsObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?dirList?"); + } + if (objc == 1) { + Tcl_SetObjResult(interp, TclGetEncodingSearchPath()); + return TCL_OK; + } + if (TclSetEncodingSearchPath(objv[1]) == TCL_ERROR) { + Tcl_AppendResult(interp, "expected directory list but got \"", + Tcl_GetString(objv[1]), "\"", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, objv[1]); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ErrorObjCmd -- * * This procedure is invoked to process the "error" Tcl command. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ccec254..f539bf2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.78.2.3 2005/03/15 20:23:39 kennykb Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.78.2.4 2005/04/25 21:37:19 kennykb Exp $ */ #include "tclInt.h" @@ -3108,6 +3108,7 @@ TclPrintByteCodeObj(interp, objPtr) } #endif /* TCL_COMPILE_DEBUG */ +#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -3238,7 +3239,9 @@ TclPrintInstruction(codePtr, pc) fprintf(stdout, "\n"); return numBytes; } +#endif /* TCL_COMPILE_DEBUG */ +#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -3269,7 +3272,9 @@ TclPrintObject(outFile, objPtr, maxChars) bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } +#endif /* TCL_COMPILE_DEBUG */ +#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -3331,6 +3336,7 @@ TclPrintSource(outFile, stringPtr, maxChars) } fprintf(outFile, "\""); } +#endif /* TCL_COMPILE_DEBUG */ #ifdef TCL_COMPILE_STATS /* diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 6b32340..fb1f100 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEncoding.c,v 1.29.2.3 2005/04/10 23:14:48 kennykb Exp $ + * RCS: @(#) $Id: tclEncoding.c,v 1.29.2.4 2005/04/25 21:37:19 kennykb Exp $ */ #include "tclInt.h" @@ -150,9 +150,8 @@ static ProcessGlobalValue encodingSearchPath = * threads. Access to the shared string is governed by a mutex lock. */ -static TclInitProcessGlobalValueProc InitializeEncodingFileMap; static ProcessGlobalValue encodingFileMap = - {0, 0, NULL, NULL, InitializeEncodingFileMap, NULL, NULL}; + {0, 0, NULL, NULL, NULL, NULL, NULL}; /* * A list of directories making up the "library path". Historically @@ -224,7 +223,8 @@ static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((CONST char *name, int type, Tcl_Channel chan)); static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name, Tcl_Channel chan)); -static Tcl_Obj * MakeFileMap (); +static Tcl_Channel OpenEncodingFileChannel _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *name)); static void TableFreeProc _ANSI_ARGS_((ClientData clientData)); static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData, CONST char *src, int srcLen, int flags, @@ -388,7 +388,6 @@ TclSetEncodingSearchPath(searchPath) return TCL_ERROR; } TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); - FillEncodingFileMap(); return TCL_OK; } @@ -441,7 +440,10 @@ TclSetLibraryPath(path) /* *--------------------------------------------------------------------------- * - * MakeFileMap -- + * FillEncodingFileMap -- + * + * Called to bring the encoding file map in sync with the current + * value of the encoding search path. * * Scan the directories on the encoding search path, find the * *.enc files, and store the found pathnames in a map associated @@ -462,8 +464,8 @@ TclSetLibraryPath(path) *--------------------------------------------------------------------------- */ -static Tcl_Obj * -MakeFileMap() +void +FillEncodingFileMap() { int i, numDirs = 0; Tcl_Obj *map, *searchPath; @@ -505,33 +507,6 @@ MakeFileMap() Tcl_DecrRefCount(directory); } Tcl_DecrRefCount(searchPath); - return map; -} - -/* - *--------------------------------------------------------------------------- - * - * FillEncodingFileMap -- - * - * Called to bring the encoding file map in sync with the current - * value of the encoding search path. - * - * TODO: Check the callers of this routine to see if it's called - * too frequently. - * - * Results: - * None. - * - * Side effects: - * Entries are added to the encoding file map. - * - *--------------------------------------------------------------------------- - */ - -void -FillEncodingFileMap() -{ - Tcl_Obj *map = MakeFileMap(); TclSetProcessGlobalValue(&encodingFileMap, map, NULL); Tcl_DecrRefCount(map); } @@ -1395,67 +1370,134 @@ Tcl_FindExecutable(argv0) /* *--------------------------------------------------------------------------- * - * LoadEncodingFile -- + * OpenEncodingFileChannel -- * - * Read a file that describes an encoding and create a new Encoding - * from the data. + * Open the file believed to hold data for the encoding, "name". * * Results: - * The return value is the newly loaded Encoding, or NULL if - * the file didn't exist of was in the incorrect format. If NULL was + * Returns the readable Tcl_Channel from opening the file, or NULL + * if the file could not be successfully opened. If NULL was * returned, an error message is left in interp's result object, * unless interp was NULL. * * Side effects: - * File read from disk. + * Channel may be opened. Information about the filesystem may be + * cached to speed later calls. * *--------------------------------------------------------------------------- */ -static Tcl_Encoding -LoadEncodingFile(interp, name) +static Tcl_Channel +OpenEncodingFileChannel(interp, name) Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */ CONST char *name; /* The name of the encoding file on disk * and also the name for new encoding. */ { - Tcl_Channel chan; - Tcl_Encoding encoding; - Tcl_Obj *map, *path, *directory = NULL; Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); - int ch, scanned = 0; + Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj); + Tcl_Obj *searchPath = Tcl_DuplicateObj(TclGetEncodingSearchPath()); + Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap); + Tcl_Obj **dir, *path, *directory = NULL; + Tcl_Channel chan = NULL; + int i, numDirs; + + Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir); + Tcl_IncrRefCount(nameObj); + Tcl_AppendToObj(fileNameObj, ".enc", -1); + Tcl_IncrRefCount(fileNameObj); + Tcl_DictObjGet(NULL, map, nameObj, &directory); + /* Check that any cached directory is still on the encoding search path */ + if (NULL != directory) { + int verified = 0; - Tcl_IncrRefCount(nameObj); - while (1) { - map = TclGetProcessGlobalValue(&encodingFileMap); - Tcl_DictObjGet(NULL, map, nameObj, &directory); - if (scanned || (NULL != directory)) { - break; + for (i=0; i<numDirs && !verified; i++) { + if (dir[i] == directory) { + verified = 1; + } + } + if (!verified) { + CONST char *dirString = Tcl_GetString(directory); + for (i=0; i<numDirs && !verified; i++) { + if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) { + verified = 1; + } + } + } + if (!verified) { + /* Directory no longer on the search path. Remove from cache */ + map = Tcl_DuplicateObj(map); + Tcl_DictObjRemove(NULL, map, nameObj); + TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + directory = NULL; } -scan: - FillEncodingFileMap(); - scanned = 1; } - if (NULL == directory) { - Tcl_DecrRefCount(nameObj); - goto unknown; + + if (NULL != directory) { + /* Got a directory from the cache. Try to use it first */ + Tcl_IncrRefCount(directory); + path = Tcl_FSJoinToPath(directory, 1, &fileNameObj); + Tcl_IncrRefCount(path); + Tcl_DecrRefCount(directory); + chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0); + Tcl_DecrRefCount(path); } - /* Construct $directory/$encoding.enc path name */ - Tcl_IncrRefCount(directory); - Tcl_AppendToObj(nameObj, ".enc", -1); - path = Tcl_FSJoinToPath(directory, 1, &nameObj); - Tcl_DecrRefCount(directory); + /* Scan the search path until we find it. */ + for (i=0; i<numDirs && (chan == NULL); i++) { + path = Tcl_FSJoinToPath(dir[i], 1, &fileNameObj); + Tcl_IncrRefCount(path); + chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0); + Tcl_DecrRefCount(path); + if (chan != NULL) { + /* Save directory in the cache */ + map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap)); + Tcl_DictObjPut(NULL, map, nameObj, dir[i]); + TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + } + } + if ((NULL == chan) && (interp != NULL)) { + Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL); + } + Tcl_DecrRefCount(fileNameObj); Tcl_DecrRefCount(nameObj); - Tcl_IncrRefCount(path); - chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0); - Tcl_DecrRefCount(path); + Tcl_DecrRefCount(searchPath); + return chan; +} + +/* + *--------------------------------------------------------------------------- + * + * LoadEncodingFile -- + * + * Read a file that describes an encoding and create a new Encoding + * from the data. + * + * Results: + * The return value is the newly loaded Encoding, or NULL if + * the file didn't exist of was in the incorrect format. If NULL was + * returned, an error message is left in interp's result object, + * unless interp was NULL. + * + * Side effects: + * File read from disk. + * + *--------------------------------------------------------------------------- + */ - if (NULL == chan) { - if (!scanned) { - goto scan; - } - goto unknown; +static Tcl_Encoding +LoadEncodingFile(interp, name) + Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */ + CONST char *name; /* The name of the encoding file on disk + * and also the name for new encoding. */ +{ + Tcl_Channel chan = NULL; + Tcl_Encoding encoding = NULL; + int ch; + + chan = OpenEncodingFileChannel(interp, name); + if (chan == NULL) { + return NULL; } Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8"); @@ -1472,7 +1514,6 @@ scan: } } - encoding = NULL; switch (ch) { case 'S': { encoding = LoadTableEncoding(name, ENCODING_SINGLEBYTE, chan); @@ -1496,12 +1537,6 @@ scan: } Tcl_Close(NULL, chan); return encoding; - - unknown: - if (interp != NULL) { - Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL); - } - return NULL; } /* @@ -3185,43 +3220,3 @@ InitializeEncodingSearchPath(valuePtr, lengthPtr, encodingPtr) memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1); Tcl_DecrRefCount(searchPath); } - -/* - *------------------------------------------------------------------------- - * - * InitializeEncodingFileMap -- - * - * This is the fallback routine that fills the encoding data - * file map if the application has not set up an encoding - * search path by the first time the file map is needed to - * load encoding data. - * - * Results: - * None. - * - * Side effects: - * Fills the encoding data file map. - * - *------------------------------------------------------------------------- - */ - -void -InitializeEncodingFileMap(valuePtr, lengthPtr, encodingPtr) - char **valuePtr; - int *lengthPtr; - Tcl_Encoding *encodingPtr; -{ - char *bytes; - int numBytes; - Tcl_Obj *map = MakeFileMap(); - - *encodingPtr = encodingSearchPath.encoding; - if (*encodingPtr) { - ((Encoding *)(*encodingPtr))->refCount++; - } - bytes = Tcl_GetStringFromObj(map, &numBytes); - *lengthPtr = numBytes; - *valuePtr = ckalloc((unsigned int) numBytes + 1); - memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1); - Tcl_DecrRefCount(map); -} diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 75df800..a6d9442 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.167.2.10 2005/04/10 23:14:48 kennykb Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.11 2005/04/25 21:37:20 kennykb Exp $ */ #include "tclInt.h" @@ -4289,7 +4289,7 @@ TclExecuteByteCode(interp, codePtr) */ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) { i = valuePtr->internalRep.longValue; - TclNewLongObj(objResultPtr, -i) + TclNewLongObj(objResultPtr, -i); TRACE_WITH_OBJ(("%ld => ", i), objResultPtr); } else if (tPtr == &tclWideIntType) { TclGetWide(w,valuePtr); @@ -4329,7 +4329,7 @@ TclExecuteByteCode(interp, codePtr) i = (w == W0); TRACE_WITH_OBJ((LLD" => ", w), objResultPtr); } else { - i = (valuePtr->internalRep.doubleValue == 0.0) + i = (valuePtr->internalRep.doubleValue == 0.0); TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr); } objResultPtr = eePtr->constants[i]; @@ -4639,7 +4639,10 @@ TclExecuteByteCode(interp, codePtr) * If some var in some var list still has a remaining list * element iterate one more time. Assign to var the next * element from its value list. We already checked above - * that each list temp holds a valid list object. + * that each list temp holds a valid list object (by calling + * Tcl_ListObjLength), but cannot rely on that check remaining + * valid: one list could have been shimmered as a side effect of + * setting a traced variable. */ if (continueLoop) { @@ -4650,7 +4653,7 @@ TclExecuteByteCode(interp, codePtr) listVarPtr = &(compiledLocals[listTmpIndex]); listPtr = listVarPtr->value.objPtr; - TclListObjGetElements(listPtr, listLen, elements); + Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { diff --git a/generic/tclFileName.c b/generic/tclFileName.c index ab06aee..a5eca37 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.60.2.5 2005/04/10 23:14:50 kennykb Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.60.2.6 2005/04/25 21:37:20 kennykb Exp $ */ #include "tclInt.h" @@ -2302,7 +2302,7 @@ DoGlob(interp, matchesObj, separators, pathPtr, flags, pattern, types) * The current prefix must end in a separator, unless * this is a volume-relative path. In particular * globbing in Windows shares, when not using -dir - * or -path, e.g. 'glob [file join //machine share dir *]' + * or -path, e.g. 'glob [file join //machine/share/subdir *]' * requires adding a separator here. This behaviour * is not currently tested for in the test suite. */ diff --git a/generic/tclGet.c b/generic/tclGet.c index b410ba1..0be4b7e 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -11,11 +11,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclGet.c,v 1.9.2.2 2005/03/04 20:43:46 kennykb Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.9.2.3 2005/04/25 21:37:20 kennykb Exp $ */ #include "tclInt.h" -#include <math.h> /* @@ -38,76 +37,25 @@ */ int -Tcl_GetInt(interp, string, intPtr) +Tcl_GetInt(interp, str, intPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - CONST char *string; /* String containing a (possibly signed) - * integer in a form acceptable to strtol. */ + CONST char *str; /* String containing a (possibly signed) + * integer in a form acceptable to strtoul. */ int *intPtr; /* Place to store converted result. */ { - char *end; - CONST char *p = string; - long i; - - /* - * Note: use strtoul instead of strtol for integer conversions - * to allow full-size unsigned numbers, but don't depend on strtoul - * to handle sign characters; it won't in some implementations. - */ - - errno = 0; -#ifdef TCL_STRTOUL_SIGN_CHECK - /* - * This special sign check actually causes bad numbers to be allowed - * when strtoul. I can't find a strtoul that doesn't validly handle - * signed characters, and the C standard implies that this is all - * unnecessary. [Bug #634856] - */ - for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ - /* Empty loop body. */ - } - if (*p == '-') { - p++; - i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */ - } else if (*p == '+') { - p++; - i = strtoul(p, &end, 0); /* INTL: Tcl source. */ - } else -#else - i = strtoul(p, &end, 0); /* INTL: Tcl source. */ -#endif - if (end == p) { - badInteger: - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "expected integer but got \"", string, - "\"", (char *) NULL); - TclCheckBadOctal(interp, string); - } - return TCL_ERROR; - } - - /* - * The second test below is needed on platforms where "long" is - * larger than "int" to detect values that fit in a long but not in - * an int. - */ - - if ((errno == ERANGE) || (((long)(int) i) != i)) { - if (interp != (Tcl_Interp *) NULL) { - Tcl_SetResult(interp, "integer value too large to represent", - TCL_STATIC); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", - Tcl_GetStringResult(interp), (char *) NULL); - } - return TCL_ERROR; - } - while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */ - end++; - } - if (*end != 0) { - goto badInteger; + Tcl_Obj obj; + int code; + + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; + + code = Tcl_GetIntFromObj(interp, &obj, intPtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } - *intPtr = (int) i; - return TCL_OK; + return code; } /* @@ -133,64 +81,27 @@ Tcl_GetInt(interp, string, intPtr) */ int -TclGetLong(interp, string, longPtr) +TclGetLong(interp, str, longPtr) Tcl_Interp *interp; /* Interpreter used for error reporting * if not NULL. */ - CONST char *string; /* String containing a (possibly signed) + CONST char *str; /* String containing a (possibly signed) * long integer in a form acceptable to * strtoul. */ long *longPtr; /* Place to store converted long result. */ { - char *end; - CONST char *p = string; - long i; + Tcl_Obj obj; + int code; - /* - * Note: don't depend on strtoul to handle sign characters; it won't - * in some implementations. - */ + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; - errno = 0; -#ifdef TCL_STRTOUL_SIGN_CHECK - for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ - /* Empty loop body. */ + code = Tcl_GetLongFromObj(interp, &obj, longPtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } - if (*p == '-') { - p++; - i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */ - } else if (*p == '+') { - p++; - i = strtoul(p, &end, 0); /* INTL: Tcl source. */ - } else -#else - i = strtoul(p, &end, 0); /* INTL: Tcl source. */ -#endif - if (end == p) { - badInteger: - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "expected integer but got \"", string, - "\"", (char *) NULL); - TclCheckBadOctal(interp, string); - } - return TCL_ERROR; - } - if (errno == ERANGE) { - if (interp != (Tcl_Interp *) NULL) { - Tcl_SetResult(interp, "integer value too large to represent", - TCL_STATIC); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", - Tcl_GetStringResult(interp), (char *) NULL); - } - return TCL_ERROR; - } - while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */ - end++; - } - if (*end != 0) { - goto badInteger; - } - *longPtr = i; - return TCL_OK; + return code; } /* @@ -214,34 +125,25 @@ TclGetLong(interp, string, longPtr) */ int -Tcl_GetDouble(interp, string, doublePtr) +Tcl_GetDouble(interp, str, doublePtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *string; /* String containing a floating-point number + CONST char *str; /* String containing a floating-point number * in a form acceptable to strtod. */ double *doublePtr; /* Place to store converted result. */ { - CONST char *end; - double d; + Tcl_Obj obj; + int code; - errno = 0; - d = TclStrToD(string, &end); /* INTL: Tcl source. */ - if (end == string) { - badDouble: - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, - "expected floating-point number but got \"", - string, "\"", (char *) NULL); - } - return TCL_ERROR; - } - while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */ - end++; - } - if (*end != 0) { - goto badDouble; + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; + + code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } - *doublePtr = d; - return TCL_OK; + return code; } /* @@ -265,64 +167,28 @@ Tcl_GetDouble(interp, string, doublePtr) */ int -Tcl_GetBoolean(interp, string, boolPtr) +Tcl_GetBoolean(interp, str, boolPtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *string; /* String containing a boolean number + CONST char *str; /* String containing a boolean number * specified either as 1/0 or true/false or * yes/no. */ int *boolPtr; /* Place to store converted result, which * will be 0 or 1. */ { - int i; - char lowerCase[10], c; - size_t length; + Tcl_Obj obj; + int code; - /* - * Convert the input string to all lower-case. - * INTL: This code will work on UTF strings. - */ + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; - for (i = 0; i < 9; i++) { - c = string[i]; - if (c == 0) { - break; - } - if ((c >= 'A') && (c <= 'Z')) { - c += (char) ('a' - 'A'); - } - lowerCase[i] = c; + code = Tcl_ConvertToType(interp, &obj, &tclBooleanType); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } - lowerCase[i] = 0; - - length = strlen(lowerCase); - c = lowerCase[0]; - if ((c == '0') && (lowerCase[1] == '\0')) { - *boolPtr = 0; - } else if ((c == '1') && (lowerCase[1] == '\0')) { - *boolPtr = 1; - } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) { - *boolPtr = 1; - } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) { - *boolPtr = 0; - } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) { - *boolPtr = 1; - } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) { - *boolPtr = 0; - } else if ((c == 'o') && (length >= 2)) { - if (strncmp(lowerCase, "on", length) == 0) { - *boolPtr = 1; - } else if (strncmp(lowerCase, "off", length) == 0) { - *boolPtr = 0; - } else { - goto badBoolean; - } - } else { - badBoolean: - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "expected boolean value but got \"", - string, "\"", (char *) NULL); - } - return TCL_ERROR; + if (code == TCL_OK) { + *boolPtr = obj.internalRep.longValue; } - return TCL_OK; + return code; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 8b0636c..b1a0ed7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.81.2.2 2005/04/10 23:14:51 kennykb Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.81.2.3 2005/04/25 21:37:20 kennykb Exp $ */ #include "tclInt.h" @@ -6045,7 +6045,7 @@ Tcl_ChannelBuffered(chan) * Tcl_SetChannelBufferSize -- * * Sets the size of buffers to allocate to store input or output - * in the channel. The size must be between 10 bytes and 1 MByte. + * in the channel. The size must be between 1 byte and 1 MByte. * * Results: * None. @@ -6065,11 +6065,11 @@ Tcl_SetChannelBufferSize(chan, sz) ChannelState *statePtr; /* State of real channel structure. */ /* - * If the buffer size is smaller than 10 bytes or larger than one MByte, + * If the buffer size is smaller than 1 byte or larger than one MByte, * do not accept the requested size and leave the current buffer size. */ - if (sz < 10) { + if (sz < 1) { return; } if (sz > (1024 * 1024)) { diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 08224de..5e7863f 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.1 2005/01/20 14:53:39 kennykb Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.2 2005/04/25 21:37:21 kennykb Exp $ */ #include "tclInt.h" @@ -2986,7 +2986,8 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, } /* Copy this across, since both are equal for the native fs */ *clientDataPtr = (ClientData)*handlePtr; - return retVal; + Tcl_ResetResult(interp); + return TCL_OK; } if (Tcl_GetErrno() != EXDEV) { return retVal; @@ -3011,7 +3012,9 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, */ copyToPtr = TclpTempFileName(); if (copyToPtr == NULL) { - return -1; + Tcl_AppendResult(interp, "couldn't create temporary file: ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; } Tcl_IncrRefCount(copyToPtr); @@ -3025,7 +3028,9 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, */ Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); - return -1; + Tcl_AppendResult(interp, "couldn't load from current filesystem", + (char *) NULL); + return TCL_ERROR; } if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) { @@ -3090,6 +3095,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, (*handlePtr) = newLoadHandle; (*clientDataPtr) = newClientData; (*unloadProcPtr) = newUnloadProcPtr; + Tcl_ResetResult(interp); return TCL_OK; } /* @@ -3138,6 +3144,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, (*handlePtr) = newLoadHandle; (*clientDataPtr) = (ClientData)tvdlPtr; (*unloadProcPtr) = &FSUnloadTempFile; + Tcl_ResetResult(interp); return retVal; } else { /* Cross-platform copy failed */ @@ -3147,7 +3154,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs, } } Tcl_SetErrno(ENOENT); - return -1; + return TCL_ERROR; } /* * This function used to be in the platform specific directories, but it diff --git a/generic/tclInt.h b/generic/tclInt.h index c6b7a1b..04b80ec 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.202.2.10 2005/04/10 23:14:52 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.11 2005/04/25 21:37:22 kennykb Exp $ */ #ifndef _TCLINT @@ -2143,6 +2143,9 @@ MODULE_SCOPE int Tcl_DictObjCmd _ANSI_ARGS_((ClientData clientData, MODULE_SCOPE int Tcl_EncodingObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +MODULE_SCOPE int TclEncodingDirsObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); MODULE_SCOPE int Tcl_EofObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -2504,10 +2507,12 @@ MODULE_SCOPE Tcl_Obj * TclPtrIncrWideVar _ANSI_ARGS_((Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclThreadAllocObj _ANSI_ARGS_((void)); MODULE_SCOPE void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *)); MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex _ANSI_ARGS_((void)); +MODULE_SCOPE void TclFreeAllocCache _ANSI_ARGS_((void *)); MODULE_SCOPE void * TclpGetAllocCache _ANSI_ARGS_((void)); MODULE_SCOPE void TclpSetAllocCache _ANSI_ARGS_((void *)); MODULE_SCOPE void TclFinalizeThreadAlloc _ANSI_ARGS_((void)); MODULE_SCOPE void TclpFreeAllocMutex _ANSI_ARGS_((Tcl_Mutex* mutex)); +MODULE_SCOPE void TclpFreeAllocCache _ANSI_ARGS_((void *)); # define TclAllocObjStorage(objPtr) \ (objPtr) = TclThreadAllocObj() diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b21af73..ec78d95 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.54.2.1 2004/12/29 22:47:00 kennykb Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.54.2.2 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -298,10 +298,6 @@ int Tcl_Init(interp) Tcl_Interp *interp; /* Interpreter to initialize. */ { - int code; - Tcl_DString script, encodingName; - Tcl_Obj *path; - if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { return (TCL_ERROR); @@ -347,133 +343,69 @@ Tcl_Init(interp) * Note that this entire search mechanism can be bypassed by defining an * alternate tclInit procedure before calling Tcl_Init(). */ - code = Tcl_Eval(interp, + return Tcl_Eval(interp, "if {[info proc tclInit]==\"\"} {\n" " proc tclInit {} {\n" -" global tcl_libPath tcl_library\n" -" global env tclDefaultLibrary\n" -" variable ::tcl::LibPath\n" +" global tcl_libPath tcl_library env tclDefaultLibrary\n" " rename tclInit {}\n" -" set errors {}\n" -" set localPath {}\n" -" set LibPath {}\n" " if {[info exists tcl_library]} {\n" -" lappend localPath $tcl_library\n" +" set scripts {{set tcl_library}}\n" " } else {\n" -" if {[info exists env(TCL_LIBRARY)]\n" -" && [string length $env(TCL_LIBRARY)]} {\n" -" lappend localPath $env(TCL_LIBRARY)\n" -" lappend LibPath $env(TCL_LIBRARY)\n" -" if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail]} {\n" -" if {$tail ne [info tclversion]} {\n" -" lappend localPath [file join [file dirname\\\n" -" $env(TCL_LIBRARY)] tcl[info tclversion]]\n" -" lappend LibPath [file join [file dirname\\\n" -" $env(TCL_LIBRARY)] tcl[info tclversion]]\n" -" }\n" -" }\n" +" set scripts {}\n" +" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" +" lappend scripts {set env(TCL_LIBRARY)}\n" +" lappend scripts {\n" +"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n" +"if {$tail eq [info tclversion]} continue\n" +"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n" " }\n" -" if {[catch {\n" -" lappend localPath $tclDefaultLibrary\n" -" unset tclDefaultLibrary\n" -" }]} {\n" -" lappend localPath [::tcl::pkgconfig get scriptdir,runtime]\n" +" if {[info exists tclDefaultLibrary]} {\n" +" lappend scripts {set tclDefaultLibrary}\n" +" } else {\n" +" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n" " }\n" -" set parentDir [file normalize [file dirname [file dirname\\\n" -" [info nameofexecutable]]]]\n" -" set grandParentDir [file dirname $parentDir]\n" -" lappend LibPath [file join $parentDir lib tcl[info tclversion]]\n" -" lappend LibPath [file join $grandParentDir lib tcl[info tclversion]]\n" -" lappend LibPath [file join $parentDir library]\n" -" lappend LibPath [file join $grandParentDir library]\n" -" lappend LibPath [file join $grandParentDir\\\n" -" tcl[info patchlevel] library]\n" -" lappend LibPath [file join [file dirname $grandParentDir]\\\n" -" tcl[info patchlevel] library]\n" -" catch {\n" -" set LibPath [concat $LibPath $tcl_libPath]\n" +" lappend scripts {\n" +"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" +"set grandParentDir [file dirname $parentDir]\n" +"file join $parentDir lib tcl[info tclversion]} \\\n" +" {file join $grandParentDir lib tcl[info tclversion]} \\\n" +" {file join $parentDir library} \\\n" +" {file join $grandParentDir library} \\\n" +" {file join $grandParentDir tcl[info patchlevel] library} \\\n" +" {\n" +"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n" +" if {[info exists tcl_libPath]\n" +" && [catch {llength $tcl_libPath} len] == 0} {\n" +" for {set i 0} {$i < $len} {incr i} {\n" +" lappend scripts [list lindex \\$tcl_libPath $i]\n" +" }\n" " }\n" " }\n" -" foreach i [concat $localPath $LibPath] {\n" -" set tcl_library $i\n" -" set tclfile [file join $i init.tcl]\n" +" set dirs {}\n" +" set errors {}\n" +" foreach script $scripts {\n" +" lappend dirs [eval $script]\n" +" set tcl_library [lindex $dirs end]\n" +" set tclfile [file join $tcl_library init.tcl]\n" " if {[file exists $tclfile]} {\n" -" if {![catch {uplevel #0 [list source $tclfile]} msg opts]} {\n" -" return\n" -" } else {\n" +" if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n" " append errors \"$tclfile: $msg\n\"\n" " append errors \"[dict get $opts -errorinfo]\n\"\n" +" continue\n" " }\n" +" unset -nocomplain tclDefaultLibrary\n" +" return\n" " }\n" " }\n" +" unset -nocomplain tclDefaultLibrary\n" " set msg \"Can't find a usable init.tcl in the following directories: \n\"\n" -" append msg \" $localPath $LibPath\n\n\"\n" +" append msg \" $dirs\n\n\"\n" " append msg \"$errors\n\n\"\n" " append msg \"This probably means that Tcl wasn't installed properly.\n\"\n" " error $msg\n" " }\n" "}\n" "tclInit"); - - if (code != TCL_OK) { - return code; - } - - /* - * Now that [info library] is initialized, make sure that - * [file join [info library] encoding] is on the encoding - * search path. - * - * Relying on use of original built-in commands. - * Should be a safe assumption during interp initialization. - * More robust would be to use C-coded equivalents, but that's such - * a pain... - */ - - Tcl_DStringInit(&script); - Tcl_DStringAppend(&script, "lsearch -exact", -1); - path = Tcl_DuplicateObj(TclGetEncodingSearchPath()); - Tcl_IncrRefCount(path); - Tcl_DStringAppendElement(&script, Tcl_GetString(path)); - Tcl_DStringAppend(&script, " [file join [info library] encoding]", -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), - Tcl_DStringLength(&script), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&script); - if (code == TCL_OK) { - int index; - Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &index); - if (index != -1) { - /* [info library]/encoding already on the encoding search path */ - goto done; - } - } - Tcl_DStringInit(&script); - Tcl_DStringAppend(&script, "file join [info library] encoding", -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&script), - Tcl_DStringLength(&script), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&script); - if (code == TCL_OK) { - Tcl_ListObjAppendElement(NULL, path, Tcl_GetObjResult(interp)); - TclSetEncodingSearchPath(path); - } -done: - /* - * Now that we know the distributed *.enc files are on the encoding - * search path, check whether the [encoding system] matches that - * specified by the environment, and if not, attempt to correct it - */ - TclpGetEncodingNameFromEnvironment(&encodingName); - if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) { - code = Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName)); - if (code == TCL_ERROR) { - Tcl_Panic("system encoding \"", Tcl_DStringValue(&encodingName), - "\" not available"); - } - } - Tcl_DStringFree(&encodingName); - Tcl_DecrRefCount(path); - Tcl_ResetResult(interp); - return TCL_OK; } /* diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index eb0e342..9564a98 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLiteral.c,v 1.20.2.1 2004/12/29 22:47:01 kennykb Exp $ + * RCS: @(#) $Id: tclLiteral.c,v 1.20.2.2 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -270,8 +270,6 @@ TclRegisterLiteral(envPtr, bytes, length, flags) register Tcl_Obj *objPtr; unsigned int hash; int localHash, globalHash, objIndex; - long n; - char buf[TCL_INTEGER_SPACE]; Namespace *nsPtr; if (length < 0) { @@ -366,10 +364,13 @@ TclRegisterLiteral(envPtr, bytes, length, flags) TclInitStringRep(objPtr, bytes, length); } +#if 0 if (TclLooksLikeInt(bytes, length)) { /* * From here we use the objPtr, because it is NULL terminated */ + long n; + char buf[TCL_INTEGER_SPACE]; if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) { TclFormatInt(buf, n); if (strcmp(objPtr->bytes, buf) == 0) { @@ -378,6 +379,7 @@ TclRegisterLiteral(envPtr, bytes, length, flags) } } } +#endif #ifdef TCL_COMPILE_DEBUG if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { diff --git a/generic/tclObj.c b/generic/tclObj.c index 51b84bc..1861cb3 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.72.2.10 2005/04/10 23:14:54 kennykb Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.72.2.11 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -1284,9 +1284,8 @@ Tcl_SetBooleanObj(objPtr, boolValue) * * Tcl_GetBooleanFromObj -- * - * Attempt to return a boolean from the Tcl object "objPtr". If the - * object is not already a boolean, an attempt will be made to convert - * it to one. + * Attempt to return a boolean from the Tcl object "objPtr". This + * includes conversion from any of Tcl's numeric types. * * Results: * The return value is a standard Tcl object result. If an error occurs @@ -1294,8 +1293,7 @@ Tcl_SetBooleanObj(objPtr, boolValue) * result unless "interp" is NULL. * * Side effects: - * If the object is not already a boolean, the conversion will free - * any old internal representation. + * The intrep of *objPtr may be changed. * *---------------------------------------------------------------------- */ @@ -1306,18 +1304,54 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) register Tcl_Obj *objPtr; /* The object from which to get boolean. */ register int *boolPtr; /* Place to store resulting boolean. */ { - register int result; + double d; + long l; if (objPtr->typePtr == &tclBooleanType) { - result = TCL_OK; - } else { - result = SetBooleanFromAny(interp, objPtr); + *boolPtr = (int) objPtr->internalRep.longValue; + return TCL_OK; } + /* + * The following call retrieves a numeric value without shimmering + * away any existing numeric intrep Tcl_ObjTypes. + */ + if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) { + *boolPtr = (d != 0.0); - if (result == TCL_OK) { + /* Attempt shimmer to "boolean" objType */ + SetBooleanFromAny(NULL, objPtr); + return TCL_OK; + } + /* + * Value didn't already have a numeric intrep, but perhaps we can + * generate one. Try a long value first... + */ + if (Tcl_GetLongFromObj(NULL, objPtr, &l) == TCL_OK) { + *boolPtr = (l != 0); + return TCL_OK; + } +#ifndef TCL_WIDE_INT_IS_LONG + else { + Tcl_WideInt w; + /* + * ...then a wide. Check in that order so that we don't promote + * anything to wide unnecessarily. + */ + if (Tcl_GetWideIntFromObj(NULL, objPtr, &w) == TCL_OK) { + *boolPtr = (w != 0); + return TCL_OK; + } + } +#endif + /* + * Finally, check for the string values like "yes" + * and generate error message for non-boolean values. + */ + if (SetBooleanFromAny(interp, objPtr) == TCL_OK) { *boolPtr = (int) objPtr->internalRep.longValue; + return TCL_OK; } - return result; + return TCL_ERROR; } /* @@ -1345,69 +1379,87 @@ SetBooleanFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { - char *string, *end; - register char c; - char lowerCase[8]; - int newBool, length; - register int i; - - /* - * Get the string representation. Make it up-to-date if necessary. - */ - - string = Tcl_GetStringFromObj(objPtr, &length); + char *str, lowerCase[6]; + int i, newBool, length; /* - * Use the obvious shortcuts for numerical values; if objPtr is not - * of numerical type, parse its string rep. + * For some "pure" numeric Tcl_ObjTypes (no string rep), we can + * determine whether a boolean conversion is possible without + * generating the string rep. */ - if (objPtr->typePtr == &tclIntType) { - newBool = (objPtr->internalRep.longValue != 0); - goto goodBoolean; - } else if (objPtr->typePtr == &tclDoubleType) { - newBool = (objPtr->internalRep.doubleValue != 0.0); - goto goodBoolean; - } else if (objPtr->typePtr == &tclWideIntType) { - newBool = (objPtr->internalRep.wideValue != 0); - goto goodBoolean; + if (objPtr->bytes == NULL) { + if (objPtr->typePtr == &tclDoubleType) { + goto badBoolean; + } + if (objPtr->typePtr == &tclIntType) { + long l = objPtr->internalRep.longValue; + switch (l) { + case 0: case 1: + newBool = (int)l; + goto goodBoolean; + } + goto badBoolean; + } + if (objPtr->typePtr == &tclWideIntType) { + Tcl_WideInt w = objPtr->internalRep.wideValue; + switch (w) { + case 0: case 1: + newBool = (int)w; + goto goodBoolean; + } + goto badBoolean; + } } /* * Parse the string as a boolean. We use an implementation here * that doesn't report errors in interp if interp is NULL. - * - * First we define a macro to factor out the to-lower-case code. - * The len parameter is the maximum number of characters to copy - * to allow the following comparisons to proceed correctly, - * including (properly) the trailing \0 character. This is done - * in multiple places so the number of copying steps is minimised - * and only performed when needed. */ -#define SBFA_TOLOWER(len) \ - for (i=0 ; i<(len) && i<length ; i++) { \ - c = string[i]; \ - if (c & 0x80) { \ - goto badBoolean; \ - } \ - if (Tcl_UniCharIsUpper(UCHAR(c))) { \ - c = (char) Tcl_UniCharToLower(UCHAR(c)); \ - } \ - lowerCase[i] = c; \ - } \ - lowerCase[i] = 0; - - switch (string[0]) { - case 'y': case 'Y': - /* - * Copy the string converting its characters to lower case. - * This also weeds out international characters so we can - * safely operate on single bytes. - */ + str = Tcl_GetStringFromObj(objPtr, &length); + if ((length == 0) || (length > 5)) { + /* longest valid boolean string rep. is "false" */ + goto badBoolean; + } + + switch (str[0]) { + case '0': + if (length == 1) { + newBool = 0; + goto goodBoolean; + } + goto badBoolean; + case '1': + if (length == 1) { + newBool = 1; + goto goodBoolean; + } + goto badBoolean; - SBFA_TOLOWER(4); + } + + /* + * Force to lower case for case-insensitive detection. + * Filter out known invalid characters at the same time. + */ + for (i=0; i < length; i++) { + char c = str[i]; + switch (c) { + case 'A': case 'E': case 'F': case 'L': case 'N': + case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y': + lowerCase[i] = c + (char) ('a' - 'A'); break; + case 'a': case 'e': case 'f': case 'l': case 'n': + case 'o': case 'r': case 's': case 't': case 'u': case 'y': + lowerCase[i] = c; break; + default: + goto badBoolean; + } + } + lowerCase[length] = 0; + switch (lowerCase[0]) { + case 'y': /* * Checking the 'y' is redundant, but makes the code clearer. */ @@ -1416,32 +1468,28 @@ SetBooleanFromAny(interp, objPtr) goto goodBoolean; } goto badBoolean; - case 'n': case 'N': - SBFA_TOLOWER(3); + case 'n': if (strncmp(lowerCase, "no", (size_t) length) == 0) { newBool = 0; goto goodBoolean; } goto badBoolean; - case 't': case 'T': - SBFA_TOLOWER(5); + case 't': if (strncmp(lowerCase, "true", (size_t) length) == 0) { newBool = 1; goto goodBoolean; } goto badBoolean; - case 'f': case 'F': - SBFA_TOLOWER(6); + case 'f': if (strncmp(lowerCase, "false", (size_t) length) == 0) { newBool = 0; goto goodBoolean; } goto badBoolean; - case 'o': case 'O': + case 'o': if (length < 2) { goto badBoolean; } - SBFA_TOLOWER(4); if (strncmp(lowerCase, "on", (size_t) length) == 0) { newBool = 1; goto goodBoolean; @@ -1450,92 +1498,8 @@ SetBooleanFromAny(interp, objPtr) goto goodBoolean; } goto badBoolean; -#undef SBFA_TOLOWER - case '0': - if (string[1] == '\0') { - newBool = 0; - goto goodBoolean; - } - goto parseNumeric; - case '1': - if (string[1] == '\0') { - newBool = 1; - goto goodBoolean; - } - /* deliberate fall-through */ default: - parseNumeric: - { - double dbl; - /* - * Boolean values can be extracted from ints or doubles. - * Note that we don't use strtoul or strtoull here because - * we don't care about what the value is, just whether it - * is equal to zero or not. - */ -#ifdef TCL_WIDE_INT_IS_LONG - newBool = strtol(string, &end, 0); - if (end != string) { - /* - * Make sure the string has no garbage after the end of - * the int. - */ - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end == (string+length)) { - newBool = (newBool != 0); - goto goodBoolean; - } - } -#else /* !TCL_WIDE_INT_IS_LONG */ - Tcl_WideInt wide = strtoll(string, &end, 0); - if (end != string) { - /* - * Make sure the string has no garbage after the end of - * the wide int. - */ - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end == (string+length)) { - newBool = (wide != Tcl_LongAsWide(0)); - goto goodBoolean; - } - } -#endif /* TCL_WIDE_INT_IS_LONG */ - /* - * Still might be a string containing the characters - * representing an int or double that wasn't handled - * above. This would be a string like "27" or "1.0" that - * is non-zero and not "1". Such a string would result in - * the boolean value true. We try converting to double. If - * that succeeds and the resulting double is non-zero, we - * have a "true". Note that numbers can't have embedded - * NULLs. - */ - - dbl = TclStrToD(string, (CONST char **) &end); - if (end == string) { - goto badBoolean; - } - - /* - * Make sure the string has no garbage after the end of - * the double. - */ - - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end != (string+length)) { - goto badBoolean; - } - newBool = (dbl != 0.0); - } + goto badBoolean; } /* @@ -1554,7 +1518,8 @@ SetBooleanFromAny(interp, objPtr) if (interp != NULL) { Tcl_Obj *msg = Tcl_NewStringObj("expected boolean value but got \"", -1); - TclAppendLimitedToObj(msg, string, length, 50, ""); + str = Tcl_GetStringFromObj(objPtr, &length); + TclAppendLimitedToObj(msg, str, length, 50, ""); Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); } @@ -1761,21 +1726,24 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) result = TCL_OK; } else if (objPtr->typePtr == &tclIntType) { *dblPtr = objPtr->internalRep.longValue; - result = TCL_OK; - } else { - result = SetDoubleFromAny(interp, objPtr); - if (result == TCL_OK) { - *dblPtr = objPtr->internalRep.doubleValue; - } + return TCL_OK; + } else if (objPtr->typePtr == &tclWideIntType) { + *dblPtr = (double) objPtr->internalRep.wideValue; + return TCL_OK; } - if ( result == TCL_OK && IS_NAN( *dblPtr ) ) { - if ( interp != NULL ) { - Tcl_SetObjResult - ( interp, - Tcl_NewStringObj( "floating point value is Not a Number", - -1 ) ); + + result = SetDoubleFromAny(interp, objPtr); + if ( result == TCL_OK ) { + if ( IS_NAN( *dblPtr ) ) { + if ( interp != NULL ) { + Tcl_SetObjResult + ( interp, + Tcl_NewStringObj( "floating point value is Not a Number", + -1 ) ); + } + return TCL_ERROR; } - result = TCL_ERROR; + *dblPtr = objPtr->internalRep.doubleValue; } return result; } @@ -1847,6 +1815,13 @@ SetDoubleFromAny(interp, objPtr) goto badDouble; } + if (errno != 0) { + if (interp != NULL) { + TclExprFloatError(interp, newDouble); + } + return TCL_ERROR; + } + /* * The conversion to double succeeded. Free the old internalRep before * setting the new one. We do this as late as possible to allow the @@ -2012,15 +1987,14 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr) register Tcl_Obj *objPtr; /* The object from which to get a int. */ register int *intPtr; /* Place to store resulting int. */ { - register long l = 0; int result; + Tcl_WideInt w = 0; /* If the object isn't already an integer of any width, try to * convert it to one. */ - if (objPtr->typePtr != &tclIntType - && objPtr->typePtr != &tclWideIntType) { + if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) { result = SetIntOrWideFromAny(interp, objPtr); if (result != TCL_OK) { return result; @@ -2029,45 +2003,26 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr) /* Object should now be either int or wide. Get its value. */ - if (objPtr->typePtr == &tclIntType) { - l = objPtr->internalRep.longValue; - } else if (objPtr->typePtr == &tclWideIntType) { #ifndef TCL_WIDE_INT_IS_LONG - /* - * If the object is already a wide integer, don't convert it. - * This code allows for any integer in the range -ULONG_MAX to - * ULONG_MAX to be converted to a long, ignoring overflow. - * The rule preserves existing semantics for conversion of - * integers on input, but avoids inadvertent demotion of - * wide integers to 32-bit ones in the internal rep. - */ - Tcl_WideInt w = objPtr->internalRep.wideValue; - if (w >= -(Tcl_WideInt)(ULONG_MAX) - && w <= (Tcl_WideInt)(ULONG_MAX)) { - l = Tcl_WideAsLong(w); - } else { - goto tooBig; - } -#else - l = objPtr->internalRep.longValue; + if (objPtr->typePtr == &tclWideIntType) { + w = objPtr->internalRep.wideValue; + } else #endif - } else { - Tcl_Panic("string->integer conversion failed to convert the obj."); + { + w = Tcl_LongAsWide(objPtr->internalRep.longValue); } - if (((long)((int)l)) == l) { - *intPtr = (int)l; - return TCL_OK; - } -#ifndef TCL_WIDE_INT_IS_LONG - tooBig: -#endif - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + if ((LLONG_MAX > UINT_MAX) + && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent as non-long integer", -1)); + } + return TCL_ERROR; } - return TCL_ERROR; + *intPtr = (int)w; + return TCL_OK; } /* @@ -2138,7 +2093,6 @@ SetIntOrWideFromAny(interp, objPtr) register char *p; unsigned long newLong; int isNegative = 0; - int isWide = 0; /* * Get the string representation. Make it up-to-date if necessary. @@ -2150,8 +2104,9 @@ SetIntOrWideFromAny(interp, objPtr) * Now parse "objPtr"s string as an int. We use an implementation here * that doesn't report errors in interp if interp is NULL. Note: use * strtoul instead of strtol for integer conversions to allow full-size - * unsigned numbers, but don't depend on strtoul to handle sign - * characters; it won't in some implementations. + * unsigned numbers. We parse the leading space and sign ourselves so + * we can tell the difference between apparently positive and negative + * values. */ errno = 0; @@ -2180,14 +2135,6 @@ SetIntOrWideFromAny(interp, objPtr) if (end == p) { goto badInteger; } - if (errno == ERANGE) { - if (interp != NULL) { - CONST char *s = "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); - } - return TCL_ERROR; - } /* * Make sure that the string has no garbage after the end of the int. @@ -2201,17 +2148,14 @@ SetIntOrWideFromAny(interp, objPtr) goto badInteger; } - /* - * If the resulting integer will exceed the range of a long, - * put it into a wide instead. (Tcl Bug #868489) - */ - -#ifndef TCL_WIDE_INT_IS_LONG - if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1) - || (!isNegative && newLong > LONG_MAX)) { - isWide = 1; + if (errno == ERANGE) { + if (interp != NULL) { + CONST char *s = "integer value too large to represent"; + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); + } + return TCL_ERROR; } -#endif /* * The conversion to int succeeded. Free the old internalRep before @@ -2221,11 +2165,20 @@ SetIntOrWideFromAny(interp, objPtr) */ TclFreeIntRep(objPtr); - if (isWide) { +#ifndef TCL_WIDE_INT_IS_LONG + /* + * If the resulting integer will exceed the range of a long, + * put it into a wide instead. (Tcl Bug #868489) + */ + + if ((isNegative && newLong > (unsigned long) (LONG_MAX) + 1) + || (!isNegative && newLong > LONG_MAX)) { objPtr->internalRep.wideValue = (isNegative ? -(Tcl_WideInt)newLong : (Tcl_WideInt)newLong); objPtr->typePtr = &tclWideIntType; - } else { + } else +#endif + { objPtr->internalRep.longValue = (isNegative ? -(long)newLong : (long)newLong); objPtr->typePtr = &tclIntType; @@ -2528,25 +2481,11 @@ SetWideIntFromAny(interp, objPtr) * Now parse "objPtr"s string as an int. We use an implementation here * that doesn't report errors in interp if interp is NULL. Note: use * strtoull instead of strtoll for integer conversions to allow full-size - * unsigned numbers, but don't depend on strtoull to handle sign - * characters; it won't in some implementations. + * unsigned numbers. */ errno = 0; -#ifdef TCL_STRTOUL_SIGN_CHECK - for (; isspace(UCHAR(*p)) ; p++) { /* INTL: ISO space. */ - /* Empty loop body. */ - } - if (*p == '-') { - p++; - newWide = -((Tcl_WideInt)strtoull(p, &end, 0)); - } else if (*p == '+') { - p++; - newWide = strtoull(p, &end, 0); - } else -#else - newWide = strtoull(p, &end, 0); -#endif + newWide = strtoull(p, &end, 0); if (end == p) { badInteger: if (interp != NULL) { @@ -2559,14 +2498,6 @@ SetWideIntFromAny(interp, objPtr) } return TCL_ERROR; } - if (errno == ERANGE) { - if (interp != NULL) { - CONST char *s = "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); - } - return TCL_ERROR; - } /* * Make sure that the string has no garbage after the end of the int. @@ -2580,6 +2511,14 @@ SetWideIntFromAny(interp, objPtr) goto badInteger; } + if (errno == ERANGE) { + if (interp != NULL) { + CONST char *s = "integer value too large to represent"; + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); + } + return TCL_ERROR; + } /* * The conversion to int succeeded. Free the old internalRep before * setting the new one. We do this as late as possible to allow the diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 553bd4f..813b9a7 100755 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThreadAlloc.c,v 1.14 2004/07/21 01:45:44 hobbs Exp $ + * RCS: @(#) $Id: tclThreadAlloc.c,v 1.14.2.1 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -988,6 +988,8 @@ TclFinalizeThreadAlloc() TclpFreeAllocMutex(listLockPtr); listLockPtr = NULL; + + TclpFreeAllocCache(NULL); } #else diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 6708699..0d538e0 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.51.2.9 2005/04/10 23:14:57 kennykb Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.51.2.10 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -2851,14 +2851,14 @@ TclGetProcessGlobalValue(pgvPtr) /* If no thread has set the shared value, call the initializer */ Tcl_MutexLock(&pgvPtr->mutex); - if (NULL == pgvPtr->value) { - if (pgvPtr->proc) { - pgvPtr->epoch++; - (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes, - &pgvPtr->encoding); - Tcl_CreateExitHandler(FreeProcessGlobalValue, - (ClientData) pgvPtr); + if ((NULL == pgvPtr->value) && (pgvPtr->proc)) { + pgvPtr->epoch++; + (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes, + &pgvPtr->encoding); + if (pgvPtr->value == NULL) { + Tcl_Panic("PGV Initializer did not initialize."); } + Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr); } /* Store a copy of the shared value in our epoch-indexed cache */ diff --git a/generic/tclVar.c b/generic/tclVar.c index 035de76..bac67dc 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.99.2.3 2005/04/10 23:14:57 kennykb Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.99.2.4 2005/04/25 21:37:22 kennykb Exp $ */ #include "tclInt.h" @@ -2917,8 +2917,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_DecrRefCount(namePtr); /* free unneeded name obj */ return result; } - Tcl_SetObjResult(interp, resultPtr); } + Tcl_SetObjResult(interp, resultPtr); break; } case ARRAY_NEXTELEMENT: { diff --git a/library/clock.tcl b/library/clock.tcl index f1a64b5..2d217d6 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.tcl,v 1.12.2.1 2004/12/29 22:47:05 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.12.2.2 2005/04/25 21:37:23 kennykb Exp $ # #---------------------------------------------------------------------- @@ -82,9 +82,37 @@ namespace eval ::tcl::clock { namespace import ::msgcat::mcload namespace import ::msgcat::mclocale +} + +#---------------------------------------------------------------------- +# +# ::tcl::clock::Initialize -- +# +# Finish initializing the 'clock' subsystem +# +# Results: +# None. +# +# Side effects: +# Namespace variable in the 'clock' subsystem are initialized. +# +# The '::tcl::clock::Initialize' procedure initializes the namespace +# variables and root locale message catalog for the 'clock' subsystem. +# It is broken into a procedure rather than simply evaluated as a script +# so that it will be able to use local variables, avoiding the dangers +# of 'creative writing' as in Bug 1185933. +# +#---------------------------------------------------------------------- + +proc ::tcl::clock::Initialize {} { + + rename ::tcl::clock::Initialize {} + + variable LibDir + # Define the Greenwich time zone - proc initTZData {} { + proc InitTZData {} { variable TZData array unset TZData set TZData(:Etc/GMT) { @@ -96,7 +124,7 @@ namespace eval ::tcl::clock { } set TZData(:UTC) $TZData(:Etc/UTC) } - initTZData + InitTZData # Define the message catalog for the root locale. @@ -227,21 +255,16 @@ namespace eval ::tcl::clock { # are known to reside on various operating systems variable ZoneinfoPaths {} - proc ZoneinfoInit {} { - variable ZoneinfoPaths - rename ZoneinfoInit {} - foreach path { - /usr/share/zoneinfo - /usr/share/lib/zoneinfo - /usr/local/etc/zoneinfo - C:/Progra~1/cygwin/usr/local/etc/zoneinfo - } { - if { [file isdirectory $path] } { - lappend ZoneinfoPaths $path - } + foreach path { + /usr/share/zoneinfo + /usr/share/lib/zoneinfo + /usr/local/etc/zoneinfo + C:/Progra~1/cygwin/usr/local/etc/zoneinfo + } { + if { [file isdirectory $path] } { + lappend ZoneinfoPaths $path } } - ZoneinfoInit # Define the directories for time zone data and message catalogs. @@ -264,7 +287,6 @@ namespace eval ::tcl::clock { foreach j $DaysInRomanMonthInLeapYear { lappend DaysInPriorMonthsInLeapYear [incr i $j] } - unset i j # Another epoch (Hi, Jeff!) @@ -598,6 +620,7 @@ namespace eval ::tcl::clock { # Daylight Saving Time indicator, and # time zone abbreviation. } +::tcl::clock::Initialize #---------------------------------------------------------------------- # @@ -707,7 +730,7 @@ proc ::tcl::clock::format { args } { set state {} set retval {} foreach char [split $format {}] { - switch -exact $state { + switch -exact -- $state { {} { if { [string equal % $char] } { set state percent @@ -1304,10 +1327,6 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { if { [llength $parseWeekday] > 0 } { - # TODO - There's no reason for this to involve the - # ISO calendar; day of week is determined by - # Julian Day and there's no need to extract - # week of year foreach {dayOrdinal dayOfWeek} $parseWeekday break set date2 [GetJulianDay \ [ConvertUTCToLocal \ @@ -4411,7 +4430,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearMonthDay { date } { # Get absolute year number from the civil year - switch -exact [dict get $date era] { + switch -exact -- [dict get $date era] { BCE { set year [expr { 1 - [dict get $date year] }] } @@ -4493,7 +4512,7 @@ proc ::tcl::clock::GetJulianDayFromEraYearDay { date } { # Get absolute year number from the civil year - switch -exact [dict get $date era] { + switch -exact -- [dict get $date era] { BCE { set year [expr { 1 - [dict get $date year] }] } @@ -5042,6 +5061,6 @@ proc ::tcl::clock::ClearCaches {} { set LocaleNumeralCache {} set McLoaded {} catch {unset CachedSystemTimeZone} - initTZData + InitTZData } diff --git a/library/init.tcl b/library/init.tcl index 9fef16f..9536b7e 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.69 2004/11/30 22:19:21 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.69.2.1 2005/04/25 21:37:23 kennykb Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -48,30 +48,35 @@ if {![info exists auto_path]} { } namespace eval tcl { variable Dir - if {[info library] != ""} { - foreach Dir [list [info library] [file dirname [info library]]] { - if {[lsearch -exact $::auto_path $Dir] < 0} { - lappend ::auto_path $Dir - } + foreach Dir [list $::tcl_library [file dirname $::tcl_library]] { + if {$Dir ni $::auto_path} { + lappend ::auto_path $Dir } } set Dir [file join [file dirname [file dirname \ [info nameofexecutable]]] lib] - if {[lsearch -exact $::auto_path $Dir] < 0} { + if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } - if {[info exists ::tcl_pkgPath]} { + catch { foreach Dir $::tcl_pkgPath { - if {[lsearch -exact $::auto_path $Dir] < 0} { + if {$Dir ni $::auto_path} { lappend ::auto_path $Dir } } } + + variable Path [unsupported::EncodingDirs] + set Dir [file join $::tcl_library encoding] + if {$Dir ni $Path} { + lappend Path $Dir + unsupported::EncodingDirs $Path + } } - + # Windows specific end of initialization -if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { +if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { namespace eval tcl { proc EnvTraceProc {lo n1 n2 op} { set x $::env($n2) @@ -82,7 +87,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { global env tcl_platform foreach p [array names env] { set u [string toupper $p] - if {![string equal $u $p]} { + if {$u ne $p} { switch -- $u { COMSPEC - PATH { @@ -98,7 +103,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { } } if {![info exists env(COMSPEC)]} { - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { set env(COMSPEC) cmd.exe } else { set env(COMSPEC) command.com @@ -111,13 +116,42 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} { # Setup the unknown package handler -package unknown tclPkgUnknown -if {![interp issafe]} { - # setup platform specific unknown package handlers - if {[string equal $::tcl_platform(platform) "unix"] && \ - [string equal $::tcl_platform(os) "Darwin"]} { - package unknown [list tcl::MacOSXPkgUnknown [package unknown]] +if {[interp issafe]} { + package unknown ::tclPkgUnknown +} else { + # Set up search for Tcl Modules (TIP #189). + # and setup platform specific unknown package handlers + if {$::tcl_platform(os) eq "Darwin" + && $::tcl_platform(platform) eq "unix"} { + package unknown {::tcl::tm::UnknownHandler \ + {::tcl::MacOSXPkgUnknown ::tclPkgUnknown}} + } else { + package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown} + } + + # Set up the 'clock' ensemble + + namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library] + + proc clock args { + namespace eval ::tcl::clock [list namespace ensemble create -command \ + [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \ + -subcommands { + add clicks format microseconds milliseconds scan seconds + }] + + # 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]] + } + } + + return [uplevel 1 [info level 0]] } } @@ -264,19 +298,19 @@ proc unknown args { } } - if {([info level] == 1) && [string equal [info script] ""] \ + if {([info level] == 1) && ([info script] eq "") \ && [info exists tcl_interactive] && $tcl_interactive} { if {![info exists auto_noexec]} { set new [auto_execok $name] if {$new != ""} { set redir "" - if {[string equal [info commands console] ""]} { + if {[info commands console] eq ""} { set redir ">&@stdout <@stdin" } return [uplevel 1 exec $redir $new [lrange $args 1 end]] } } - if {[string equal $name "!!"]} { + if {$name eq "!!"} { set newcmd [history event] } elseif {[regexp {^!(.+)$} $name dummy event]} { set newcmd [history event $event] @@ -291,7 +325,7 @@ proc unknown args { } set ret [catch {set candidates [info commands $name*]} msg] - if {[string equal $name "::"]} { + if {$name eq "::"} { set name "" } if {$ret != 0} { @@ -311,7 +345,7 @@ proc unknown args { return [uplevel 1 [lreplace $args 0 0 $cmds]] } if {[llength $cmds]} { - if {[string equal $name ""]} { + if {$name eq ""} { return -code error "empty command name \"\"" } else { return -code error \ @@ -390,8 +424,7 @@ proc auto_load_index {} { variable ::tcl::auto_oldpath global auto_index auto_path - if {[info exists auto_oldpath] && \ - [string equal $auto_oldpath $auto_path]} { + if {[info exists auto_oldpath] && ($auto_oldpath eq $auto_path)} { return 0 } set auto_oldpath $auto_path @@ -410,12 +443,11 @@ proc auto_load_index {} { } else { set error [catch { set id [gets $f] - if {[string equal $id \ - "# Tcl autoload index file, version 2.0"]} { + if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] - } elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} { + } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"]} { while {[gets $f line] >= 0} { - if {[string equal [string index $line 0] "#"] \ + if {([string index $line 0] eq "#") \ || ([llength $line] != 2)} { continue } @@ -480,14 +512,14 @@ proc auto_qualify {cmd namespace} { # (if the current namespace is not the global one) if {$n == 0} { - if {[string equal $namespace ::]} { + if {$namespace eq "::"} { # ( nocolons , :: ) -> nocolons return [list $cmd] } else { # ( nocolons , ::sub ) -> ::sub::nocolons nocolons return [list ${namespace}::$cmd $cmd] } - } elseif {[string equal $namespace ::]} { + } elseif {$namespace eq "::"} { # ( foo::bar , :: ) -> ::foo::bar return [list ::$cmd] } else { @@ -542,7 +574,7 @@ proc auto_import {pattern} { # Arguments: # name - Name of a command. -if {[string equal windows $tcl_platform(platform)]} { +if {$tcl_platform(platform) eq "windows"} { # Windows version. # # Note that info executable doesn't work under Windows, so we have to @@ -560,7 +592,7 @@ proc auto_execok name { set shellBuiltins [list cls copy date del erase dir echo mkdir \ md rename ren rmdir rd time type ver vol] - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { # NT includes the 'start' built-in lappend shellBuiltins "start" } @@ -571,7 +603,7 @@ proc auto_execok name { set execExtensions [list {} .com .exe .bat] } - if {[lsearch -exact $shellBuiltins $name] != -1} { + if {$name in $shellBuiltins} { # When this is command.com for some reason on Win2K, Tcl won't # exec it unless the case is right, which this corrects. COMSPEC # may not point to a real file, so do the check. @@ -597,7 +629,7 @@ proc auto_execok name { set windir $env(WINDIR) } if {[info exists windir]} { - if {[string equal $tcl_platform(os) "Windows NT"]} { + if {$tcl_platform(os) eq "Windows NT"} { append path "$windir/system32;" } append path "$windir/system;$windir;" @@ -611,7 +643,7 @@ proc auto_execok name { foreach dir [split $path {;}] { # Skip already checked directories - if {[info exists checked($dir)] || [string equal {} $dir]} { continue } + if {[info exists checked($dir)] || ($dir eq {})} { continue } set checked($dir) {} foreach ext $execExtensions { set file [file join $dir ${name}${ext}] @@ -640,7 +672,7 @@ proc auto_execok name { return $auto_execs($name) } foreach dir [split $env(PATH) :] { - if {[string equal $dir ""]} { + if {$dir eq ""} { set dir . } set file [file join $dir $name] @@ -672,10 +704,10 @@ proc tcl::CopyDirectory {action src dest} { set nsrc [file normalize $src] set ndest [file normalize $dest] - if {[string equal $action "renaming"]} { + if {$action eq "renaming"} { # Can't rename volumes. We could give a more precise # error message here, but that would break the test suite. - if {[lsearch -exact [file volumes] $nsrc] != -1} { + if {$nsrc in [file volumes]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ into itself" @@ -687,7 +719,7 @@ proc tcl::CopyDirectory {action src dest} { \"$dest\": trying to rename a volume or move a directory\ into itself" } - if {[string equal $action "copying"]} { + if {$action eq "copying"} { # We used to throw an error here, but, looking more closely # at the core copy code in tclFCmd.c, if the destination # exists, then we should only call this function if -force @@ -739,44 +771,3 @@ proc tcl::CopyDirectory {action src dest} { } return } - -# Set up the 'clock' ensemble - -if { ![interp issafe] } { - - namespace eval ::tcl::clock \ - [list variable TclLibDir [file dirname [info script]]] - - namespace eval ::tcl::clock { - namespace ensemble create -command ::clock \ - -subcommands { - add clicks format - microseconds milliseconds - scan seconds - } - - # Auto-loading stub for 'clock.tcl' - - proc add args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - proc format args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - proc scan args { - variable TclLibDir - source -encoding utf-8 [file join $TclLibDir clock.tcl] - return [uplevel 1 [info level 0]] - } - } -} - -# Set up search for Tcl Modules (TIP #189). - -if { ![interp issafe] } { - source [file join [file dirname [info script]] tm.tcl] -} diff --git a/library/tclIndex b/library/tclIndex index 5d963a0..3a435d1 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -74,8 +74,14 @@ set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]] set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]] set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]] set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]] +set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]] set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]] set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] +set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]] diff --git a/library/tm.tcl b/library/tm.tcl index 14dab45..5c05e27 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -362,4 +362,3 @@ proc ::tcl::tm::roots {paths} { # handler into the chain. ::tcl::tm::Defaults -package unknown [list ::tcl::tm::UnknownHandler [package unknown]] diff --git a/library/tzdata/America/Boise b/library/tzdata/America/Boise index baa4e7a..4a75f3a 100644 --- a/library/tzdata/America/Boise +++ b/library/tzdata/America/Boise @@ -2,7 +2,7 @@ set TZData(:America/Boise) { {-9223372036854775808 -27889 0 LMT} - {-2717640911 -28800 0 PST} + {-2717640000 -28800 0 PST} {-1633269600 -25200 1 PDT} {-1615129200 -28800 0 PST} {-1601820000 -25200 1 PDT} diff --git a/library/tzdata/America/Chicago b/library/tzdata/America/Chicago index b485883..63b5b95 100644 --- a/library/tzdata/America/Chicago +++ b/library/tzdata/America/Chicago @@ -2,7 +2,7 @@ set TZData(:America/Chicago) { {-9223372036854775808 -21036 0 LMT} - {-2717647764 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Denver b/library/tzdata/America/Denver index 2fcb023..11337b3 100644 --- a/library/tzdata/America/Denver +++ b/library/tzdata/America/Denver @@ -2,7 +2,7 @@ set TZData(:America/Denver) { {-9223372036854775808 -25196 0 LMT} - {-2717643604 -25200 0 MST} + {-2717643600 -25200 0 MST} {-1633273200 -21600 1 MDT} {-1615132800 -25200 0 MST} {-1601823600 -21600 1 MDT} diff --git a/library/tzdata/America/Indiana/Knox b/library/tzdata/America/Indiana/Knox index 9e00ee0..65786e7 100644 --- a/library/tzdata/America/Indiana/Knox +++ b/library/tzdata/America/Indiana/Knox @@ -2,7 +2,7 @@ set TZData(:America/Indiana/Knox) { {-9223372036854775808 -20790 0 LMT} - {-2717648010 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Indiana/Marengo b/library/tzdata/America/Indiana/Marengo index 6d8d733..6ca72ba 100644 --- a/library/tzdata/America/Indiana/Marengo +++ b/library/tzdata/America/Indiana/Marengo @@ -2,7 +2,7 @@ set TZData(:America/Indiana/Marengo) { {-9223372036854775808 -20723 0 LMT} - {-2717648077 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Indiana/Vevay b/library/tzdata/America/Indiana/Vevay index db14061..aac8975 100644 --- a/library/tzdata/America/Indiana/Vevay +++ b/library/tzdata/America/Indiana/Vevay @@ -2,7 +2,7 @@ set TZData(:America/Indiana/Vevay) { {-9223372036854775808 -20416 0 LMT} - {-2717648384 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Indianapolis b/library/tzdata/America/Indianapolis index c5c011d..0834d47 100644 --- a/library/tzdata/America/Indianapolis +++ b/library/tzdata/America/Indianapolis @@ -2,7 +2,7 @@ set TZData(:America/Indianapolis) { {-9223372036854775808 -20678 0 LMT} - {-2717648122 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Kentucky/Monticello b/library/tzdata/America/Kentucky/Monticello index 00bfd80..5602f61 100644 --- a/library/tzdata/America/Kentucky/Monticello +++ b/library/tzdata/America/Kentucky/Monticello @@ -2,7 +2,7 @@ set TZData(:America/Kentucky/Monticello) { {-9223372036854775808 -20364 0 LMT} - {-2717648436 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Los_Angeles b/library/tzdata/America/Los_Angeles index 5283906..7d0e4ed 100644 --- a/library/tzdata/America/Los_Angeles +++ b/library/tzdata/America/Los_Angeles @@ -2,7 +2,7 @@ set TZData(:America/Los_Angeles) { {-9223372036854775808 -28378 0 LMT} - {-2717640422 -28800 0 PST} + {-2717640000 -28800 0 PST} {-1633269600 -25200 1 PDT} {-1615129200 -28800 0 PST} {-1601820000 -25200 1 PDT} diff --git a/library/tzdata/America/Louisville b/library/tzdata/America/Louisville index 7813308..2b430e4 100644 --- a/library/tzdata/America/Louisville +++ b/library/tzdata/America/Louisville @@ -2,7 +2,7 @@ set TZData(:America/Louisville) { {-9223372036854775808 -20582 0 LMT} - {-2717648218 -21600 0 CST} + {-2717647200 -21600 0 CST} {-1633276800 -18000 1 CDT} {-1615136400 -21600 0 CST} {-1601827200 -18000 1 CDT} diff --git a/library/tzdata/America/Managua b/library/tzdata/America/Managua index 9224166..ad066d1 100644 --- a/library/tzdata/America/Managua +++ b/library/tzdata/America/Managua @@ -14,4 +14,6 @@ set TZData(:America/Managua) { {717310800 -21600 0 CST} {725882400 -18000 0 EST} {912488400 -21600 0 CST} + {1113112800 -18000 1 CDT} + {1126414800 -21600 0 CST} } diff --git a/library/tzdata/America/Montevideo b/library/tzdata/America/Montevideo index fd17b41..c93aaa3 100644 --- a/library/tzdata/America/Montevideo +++ b/library/tzdata/America/Montevideo @@ -67,5 +67,5 @@ set TZData(:America/Montevideo) { {719377200 -7200 1 UYST} {730864800 -10800 0 UYT} {1095562800 -7200 1 UYST} - {1110679200 -10800 0 UYT} + {1111896000 -10800 0 UYT} } diff --git a/library/tzdata/America/New_York b/library/tzdata/America/New_York index 72cd976..2f7c8df 100644 --- a/library/tzdata/America/New_York +++ b/library/tzdata/America/New_York @@ -2,7 +2,7 @@ set TZData(:America/New_York) { {-9223372036854775808 -17762 0 LMT} - {-2717651038 -18000 0 EST} + {-2717650800 -18000 0 EST} {-1633280400 -14400 1 EDT} {-1615140000 -18000 0 EST} {-1601830800 -14400 1 EDT} diff --git a/library/tzdata/America/North_Dakota/Center b/library/tzdata/America/North_Dakota/Center index 9ab4470..6903b52 100644 --- a/library/tzdata/America/North_Dakota/Center +++ b/library/tzdata/America/North_Dakota/Center @@ -2,7 +2,7 @@ set TZData(:America/North_Dakota/Center) { {-9223372036854775808 -24312 0 LMT} - {-2717644488 -25200 0 MST} + {-2717643600 -25200 0 MST} {-1633273200 -21600 1 MDT} {-1615132800 -25200 0 MST} {-1601823600 -21600 1 MDT} diff --git a/library/tzdata/America/Phoenix b/library/tzdata/America/Phoenix index c5f933b..9f1d2d5 100644 --- a/library/tzdata/America/Phoenix +++ b/library/tzdata/America/Phoenix @@ -2,7 +2,7 @@ set TZData(:America/Phoenix) { {-9223372036854775808 -26898 0 LMT} - {-2717641902 -25200 0 MST} + {-2717643600 -25200 0 MST} {-1633273200 -21600 1 MDT} {-1615132800 -25200 0 MST} {-1601823600 -21600 1 MDT} diff --git a/library/tzdata/America/Port-au-Prince b/library/tzdata/America/Port-au-Prince index 9f43cbb..3d93098 100644 --- a/library/tzdata/America/Port-au-Prince +++ b/library/tzdata/America/Port-au-Prince @@ -34,4 +34,6 @@ set TZData(:America/Port-au-Prince) { {846378000 -18000 0 EST} {860288400 -14400 1 EDT} {877827600 -18000 0 EST} + {1112504400 -14400 1 EDT} + {1130644800 -18000 0 EST} } diff --git a/library/tzdata/Asia/Almaty b/library/tzdata/Asia/Almaty index 47fb933..3a29b3e 100644 --- a/library/tzdata/Asia/Almaty +++ b/library/tzdata/Asia/Almaty @@ -52,194 +52,5 @@ set TZData(:Asia/Almaty) { {1067133600 21600 0 ALMT} {1080439200 25200 1 ALMST} {1099188000 21600 0 ALMT} - {1111888800 25200 1 ALMST} - {1130637600 21600 0 ALMT} - {1143338400 25200 1 ALMST} - {1162087200 21600 0 ALMT} - {1174788000 25200 1 ALMST} - {1193536800 21600 0 ALMT} - {1206842400 25200 1 ALMST} - {1224986400 21600 0 ALMT} - {1238292000 25200 1 ALMST} - {1256436000 21600 0 ALMT} - {1269741600 25200 1 ALMST} - {1288490400 21600 0 ALMT} - {1301191200 25200 1 ALMST} - {1319940000 21600 0 ALMT} - {1332640800 25200 1 ALMST} - {1351389600 21600 0 ALMT} - {1364695200 25200 1 ALMST} - {1382839200 21600 0 ALMT} - {1396144800 25200 1 ALMST} - {1414288800 21600 0 ALMT} - {1427594400 25200 1 ALMST} - {1445738400 21600 0 ALMT} - {1459044000 25200 1 ALMST} - {1477792800 21600 0 ALMT} - {1490493600 25200 1 ALMST} - {1509242400 21600 0 ALMT} - {1521943200 25200 1 ALMST} - {1540692000 21600 0 ALMT} - {1553997600 25200 1 ALMST} - {1572141600 21600 0 ALMT} - {1585447200 25200 1 ALMST} - {1603591200 21600 0 ALMT} - {1616896800 25200 1 ALMST} - {1635645600 21600 0 ALMT} - {1648346400 25200 1 ALMST} - {1667095200 21600 0 ALMT} - {1679796000 25200 1 ALMST} - {1698544800 21600 0 ALMT} - {1711850400 25200 1 ALMST} - {1729994400 21600 0 ALMT} - {1743300000 25200 1 ALMST} - {1761444000 21600 0 ALMT} - {1774749600 25200 1 ALMST} - {1792893600 21600 0 ALMT} - {1806199200 25200 1 ALMST} - {1824948000 21600 0 ALMT} - {1837648800 25200 1 ALMST} - {1856397600 21600 0 ALMT} - {1869098400 25200 1 ALMST} - {1887847200 21600 0 ALMT} - {1901152800 25200 1 ALMST} - {1919296800 21600 0 ALMT} - {1932602400 25200 1 ALMST} - {1950746400 21600 0 ALMT} - {1964052000 25200 1 ALMST} - {1982800800 21600 0 ALMT} - {1995501600 25200 1 ALMST} - {2014250400 21600 0 ALMT} - {2026951200 25200 1 ALMST} - {2045700000 21600 0 ALMT} - {2058400800 25200 1 ALMST} - {2077149600 21600 0 ALMT} - {2090455200 25200 1 ALMST} - {2108599200 21600 0 ALMT} - {2121904800 25200 1 ALMST} - {2140048800 21600 0 ALMT} - {2153354400 25200 1 ALMST} - {2172103200 21600 0 ALMT} - {2184804000 25200 1 ALMST} - {2203552800 21600 0 ALMT} - {2216253600 25200 1 ALMST} - {2235002400 21600 0 ALMT} - {2248308000 25200 1 ALMST} - {2266452000 21600 0 ALMT} - {2279757600 25200 1 ALMST} - {2297901600 21600 0 ALMT} - {2311207200 25200 1 ALMST} - {2329351200 21600 0 ALMT} - {2342656800 25200 1 ALMST} - {2361405600 21600 0 ALMT} - {2374106400 25200 1 ALMST} - {2392855200 21600 0 ALMT} - {2405556000 25200 1 ALMST} - {2424304800 21600 0 ALMT} - {2437610400 25200 1 ALMST} - {2455754400 21600 0 ALMT} - {2469060000 25200 1 ALMST} - {2487204000 21600 0 ALMT} - {2500509600 25200 1 ALMST} - {2519258400 21600 0 ALMT} - {2531959200 25200 1 ALMST} - {2550708000 21600 0 ALMT} - {2563408800 25200 1 ALMST} - {2582157600 21600 0 ALMT} - {2595463200 25200 1 ALMST} - {2613607200 21600 0 ALMT} - {2626912800 25200 1 ALMST} - {2645056800 21600 0 ALMT} - {2658362400 25200 1 ALMST} - {2676506400 21600 0 ALMT} - {2689812000 25200 1 ALMST} - {2708560800 21600 0 ALMT} - {2721261600 25200 1 ALMST} - {2740010400 21600 0 ALMT} - {2752711200 25200 1 ALMST} - {2771460000 21600 0 ALMT} - {2784765600 25200 1 ALMST} - {2802909600 21600 0 ALMT} - {2816215200 25200 1 ALMST} - {2834359200 21600 0 ALMT} - {2847664800 25200 1 ALMST} - {2866413600 21600 0 ALMT} - {2879114400 25200 1 ALMST} - {2897863200 21600 0 ALMT} - {2910564000 25200 1 ALMST} - {2929312800 21600 0 ALMT} - {2942013600 25200 1 ALMST} - {2960762400 21600 0 ALMT} - {2974068000 25200 1 ALMST} - {2992212000 21600 0 ALMT} - {3005517600 25200 1 ALMST} - {3023661600 21600 0 ALMT} - {3036967200 25200 1 ALMST} - {3055716000 21600 0 ALMT} - {3068416800 25200 1 ALMST} - {3087165600 21600 0 ALMT} - {3099866400 25200 1 ALMST} - {3118615200 21600 0 ALMT} - {3131920800 25200 1 ALMST} - {3150064800 21600 0 ALMT} - {3163370400 25200 1 ALMST} - {3181514400 21600 0 ALMT} - {3194820000 25200 1 ALMST} - {3212964000 21600 0 ALMT} - {3226269600 25200 1 ALMST} - {3245018400 21600 0 ALMT} - {3257719200 25200 1 ALMST} - {3276468000 21600 0 ALMT} - {3289168800 25200 1 ALMST} - {3307917600 21600 0 ALMT} - {3321223200 25200 1 ALMST} - {3339367200 21600 0 ALMT} - {3352672800 25200 1 ALMST} - {3370816800 21600 0 ALMT} - {3384122400 25200 1 ALMST} - {3402871200 21600 0 ALMT} - {3415572000 25200 1 ALMST} - {3434320800 21600 0 ALMT} - {3447021600 25200 1 ALMST} - {3465770400 21600 0 ALMT} - {3479076000 25200 1 ALMST} - {3497220000 21600 0 ALMT} - {3510525600 25200 1 ALMST} - {3528669600 21600 0 ALMT} - {3541975200 25200 1 ALMST} - {3560119200 21600 0 ALMT} - {3573424800 25200 1 ALMST} - {3592173600 21600 0 ALMT} - {3604874400 25200 1 ALMST} - {3623623200 21600 0 ALMT} - {3636324000 25200 1 ALMST} - {3655072800 21600 0 ALMT} - {3668378400 25200 1 ALMST} - {3686522400 21600 0 ALMT} - {3699828000 25200 1 ALMST} - {3717972000 21600 0 ALMT} - {3731277600 25200 1 ALMST} - {3750026400 21600 0 ALMT} - {3762727200 25200 1 ALMST} - {3781476000 21600 0 ALMT} - {3794176800 25200 1 ALMST} - {3812925600 21600 0 ALMT} - {3825626400 25200 1 ALMST} - {3844375200 21600 0 ALMT} - {3857680800 25200 1 ALMST} - {3875824800 21600 0 ALMT} - {3889130400 25200 1 ALMST} - {3907274400 21600 0 ALMT} - {3920580000 25200 1 ALMST} - {3939328800 21600 0 ALMT} - {3952029600 25200 1 ALMST} - {3970778400 21600 0 ALMT} - {3983479200 25200 1 ALMST} - {4002228000 21600 0 ALMT} - {4015533600 25200 1 ALMST} - {4033677600 21600 0 ALMT} - {4046983200 25200 1 ALMST} - {4065127200 21600 0 ALMT} - {4078432800 25200 1 ALMST} - {4096576800 21600 0 ALMT} + {1110823200 21600 0 ALMT} } diff --git a/library/tzdata/Asia/Aqtau b/library/tzdata/Asia/Aqtau index 0409a9e..240242e 100644 --- a/library/tzdata/Asia/Aqtau +++ b/library/tzdata/Asia/Aqtau @@ -54,194 +54,5 @@ set TZData(:Asia/Aqtau) { {1067133600 14400 0 AQTT} {1080439200 18000 1 AQTST} {1099188000 14400 0 AQTT} - {1111888800 18000 1 AQTST} - {1130637600 14400 0 AQTT} - {1143338400 18000 1 AQTST} - {1162087200 14400 0 AQTT} - {1174788000 18000 1 AQTST} - {1193536800 14400 0 AQTT} - {1206842400 18000 1 AQTST} - {1224986400 14400 0 AQTT} - {1238292000 18000 1 AQTST} - {1256436000 14400 0 AQTT} - {1269741600 18000 1 AQTST} - {1288490400 14400 0 AQTT} - {1301191200 18000 1 AQTST} - {1319940000 14400 0 AQTT} - {1332640800 18000 1 AQTST} - {1351389600 14400 0 AQTT} - {1364695200 18000 1 AQTST} - {1382839200 14400 0 AQTT} - {1396144800 18000 1 AQTST} - {1414288800 14400 0 AQTT} - {1427594400 18000 1 AQTST} - {1445738400 14400 0 AQTT} - {1459044000 18000 1 AQTST} - {1477792800 14400 0 AQTT} - {1490493600 18000 1 AQTST} - {1509242400 14400 0 AQTT} - {1521943200 18000 1 AQTST} - {1540692000 14400 0 AQTT} - {1553997600 18000 1 AQTST} - {1572141600 14400 0 AQTT} - {1585447200 18000 1 AQTST} - {1603591200 14400 0 AQTT} - {1616896800 18000 1 AQTST} - {1635645600 14400 0 AQTT} - {1648346400 18000 1 AQTST} - {1667095200 14400 0 AQTT} - {1679796000 18000 1 AQTST} - {1698544800 14400 0 AQTT} - {1711850400 18000 1 AQTST} - {1729994400 14400 0 AQTT} - {1743300000 18000 1 AQTST} - {1761444000 14400 0 AQTT} - {1774749600 18000 1 AQTST} - {1792893600 14400 0 AQTT} - {1806199200 18000 1 AQTST} - {1824948000 14400 0 AQTT} - {1837648800 18000 1 AQTST} - {1856397600 14400 0 AQTT} - {1869098400 18000 1 AQTST} - {1887847200 14400 0 AQTT} - {1901152800 18000 1 AQTST} - {1919296800 14400 0 AQTT} - {1932602400 18000 1 AQTST} - {1950746400 14400 0 AQTT} - {1964052000 18000 1 AQTST} - {1982800800 14400 0 AQTT} - {1995501600 18000 1 AQTST} - {2014250400 14400 0 AQTT} - {2026951200 18000 1 AQTST} - {2045700000 14400 0 AQTT} - {2058400800 18000 1 AQTST} - {2077149600 14400 0 AQTT} - {2090455200 18000 1 AQTST} - {2108599200 14400 0 AQTT} - {2121904800 18000 1 AQTST} - {2140048800 14400 0 AQTT} - {2153354400 18000 1 AQTST} - {2172103200 14400 0 AQTT} - {2184804000 18000 1 AQTST} - {2203552800 14400 0 AQTT} - {2216253600 18000 1 AQTST} - {2235002400 14400 0 AQTT} - {2248308000 18000 1 AQTST} - {2266452000 14400 0 AQTT} - {2279757600 18000 1 AQTST} - {2297901600 14400 0 AQTT} - {2311207200 18000 1 AQTST} - {2329351200 14400 0 AQTT} - {2342656800 18000 1 AQTST} - {2361405600 14400 0 AQTT} - {2374106400 18000 1 AQTST} - {2392855200 14400 0 AQTT} - {2405556000 18000 1 AQTST} - {2424304800 14400 0 AQTT} - {2437610400 18000 1 AQTST} - {2455754400 14400 0 AQTT} - {2469060000 18000 1 AQTST} - {2487204000 14400 0 AQTT} - {2500509600 18000 1 AQTST} - {2519258400 14400 0 AQTT} - {2531959200 18000 1 AQTST} - {2550708000 14400 0 AQTT} - {2563408800 18000 1 AQTST} - {2582157600 14400 0 AQTT} - {2595463200 18000 1 AQTST} - {2613607200 14400 0 AQTT} - {2626912800 18000 1 AQTST} - {2645056800 14400 0 AQTT} - {2658362400 18000 1 AQTST} - {2676506400 14400 0 AQTT} - {2689812000 18000 1 AQTST} - {2708560800 14400 0 AQTT} - {2721261600 18000 1 AQTST} - {2740010400 14400 0 AQTT} - {2752711200 18000 1 AQTST} - {2771460000 14400 0 AQTT} - {2784765600 18000 1 AQTST} - {2802909600 14400 0 AQTT} - {2816215200 18000 1 AQTST} - {2834359200 14400 0 AQTT} - {2847664800 18000 1 AQTST} - {2866413600 14400 0 AQTT} - {2879114400 18000 1 AQTST} - {2897863200 14400 0 AQTT} - {2910564000 18000 1 AQTST} - {2929312800 14400 0 AQTT} - {2942013600 18000 1 AQTST} - {2960762400 14400 0 AQTT} - {2974068000 18000 1 AQTST} - {2992212000 14400 0 AQTT} - {3005517600 18000 1 AQTST} - {3023661600 14400 0 AQTT} - {3036967200 18000 1 AQTST} - {3055716000 14400 0 AQTT} - {3068416800 18000 1 AQTST} - {3087165600 14400 0 AQTT} - {3099866400 18000 1 AQTST} - {3118615200 14400 0 AQTT} - {3131920800 18000 1 AQTST} - {3150064800 14400 0 AQTT} - {3163370400 18000 1 AQTST} - {3181514400 14400 0 AQTT} - {3194820000 18000 1 AQTST} - {3212964000 14400 0 AQTT} - {3226269600 18000 1 AQTST} - {3245018400 14400 0 AQTT} - {3257719200 18000 1 AQTST} - {3276468000 14400 0 AQTT} - {3289168800 18000 1 AQTST} - {3307917600 14400 0 AQTT} - {3321223200 18000 1 AQTST} - {3339367200 14400 0 AQTT} - {3352672800 18000 1 AQTST} - {3370816800 14400 0 AQTT} - {3384122400 18000 1 AQTST} - {3402871200 14400 0 AQTT} - {3415572000 18000 1 AQTST} - {3434320800 14400 0 AQTT} - {3447021600 18000 1 AQTST} - {3465770400 14400 0 AQTT} - {3479076000 18000 1 AQTST} - {3497220000 14400 0 AQTT} - {3510525600 18000 1 AQTST} - {3528669600 14400 0 AQTT} - {3541975200 18000 1 AQTST} - {3560119200 14400 0 AQTT} - {3573424800 18000 1 AQTST} - {3592173600 14400 0 AQTT} - {3604874400 18000 1 AQTST} - {3623623200 14400 0 AQTT} - {3636324000 18000 1 AQTST} - {3655072800 14400 0 AQTT} - {3668378400 18000 1 AQTST} - {3686522400 14400 0 AQTT} - {3699828000 18000 1 AQTST} - {3717972000 14400 0 AQTT} - {3731277600 18000 1 AQTST} - {3750026400 14400 0 AQTT} - {3762727200 18000 1 AQTST} - {3781476000 14400 0 AQTT} - {3794176800 18000 1 AQTST} - {3812925600 14400 0 AQTT} - {3825626400 18000 1 AQTST} - {3844375200 14400 0 AQTT} - {3857680800 18000 1 AQTST} - {3875824800 14400 0 AQTT} - {3889130400 18000 1 AQTST} - {3907274400 14400 0 AQTT} - {3920580000 18000 1 AQTST} - {3939328800 14400 0 AQTT} - {3952029600 18000 1 AQTST} - {3970778400 14400 0 AQTT} - {3983479200 18000 1 AQTST} - {4002228000 14400 0 AQTT} - {4015533600 18000 1 AQTST} - {4033677600 14400 0 AQTT} - {4046983200 18000 1 AQTST} - {4065127200 14400 0 AQTT} - {4078432800 18000 1 AQTST} - {4096576800 14400 0 AQTT} + {1110830400 14400 0 AQTT} } diff --git a/library/tzdata/Asia/Aqtobe b/library/tzdata/Asia/Aqtobe index 92ddb45..9829e04 100644 --- a/library/tzdata/Asia/Aqtobe +++ b/library/tzdata/Asia/Aqtobe @@ -53,194 +53,5 @@ set TZData(:Asia/Aqtobe) { {1067133600 18000 0 AQTT} {1080439200 21600 1 AQTST} {1099188000 18000 0 AQTT} - {1111888800 21600 1 AQTST} - {1130637600 18000 0 AQTT} - {1143338400 21600 1 AQTST} - {1162087200 18000 0 AQTT} - {1174788000 21600 1 AQTST} - {1193536800 18000 0 AQTT} - {1206842400 21600 1 AQTST} - {1224986400 18000 0 AQTT} - {1238292000 21600 1 AQTST} - {1256436000 18000 0 AQTT} - {1269741600 21600 1 AQTST} - {1288490400 18000 0 AQTT} - {1301191200 21600 1 AQTST} - {1319940000 18000 0 AQTT} - {1332640800 21600 1 AQTST} - {1351389600 18000 0 AQTT} - {1364695200 21600 1 AQTST} - {1382839200 18000 0 AQTT} - {1396144800 21600 1 AQTST} - {1414288800 18000 0 AQTT} - {1427594400 21600 1 AQTST} - {1445738400 18000 0 AQTT} - {1459044000 21600 1 AQTST} - {1477792800 18000 0 AQTT} - {1490493600 21600 1 AQTST} - {1509242400 18000 0 AQTT} - {1521943200 21600 1 AQTST} - {1540692000 18000 0 AQTT} - {1553997600 21600 1 AQTST} - {1572141600 18000 0 AQTT} - {1585447200 21600 1 AQTST} - {1603591200 18000 0 AQTT} - {1616896800 21600 1 AQTST} - {1635645600 18000 0 AQTT} - {1648346400 21600 1 AQTST} - {1667095200 18000 0 AQTT} - {1679796000 21600 1 AQTST} - {1698544800 18000 0 AQTT} - {1711850400 21600 1 AQTST} - {1729994400 18000 0 AQTT} - {1743300000 21600 1 AQTST} - {1761444000 18000 0 AQTT} - {1774749600 21600 1 AQTST} - {1792893600 18000 0 AQTT} - {1806199200 21600 1 AQTST} - {1824948000 18000 0 AQTT} - {1837648800 21600 1 AQTST} - {1856397600 18000 0 AQTT} - {1869098400 21600 1 AQTST} - {1887847200 18000 0 AQTT} - {1901152800 21600 1 AQTST} - {1919296800 18000 0 AQTT} - {1932602400 21600 1 AQTST} - {1950746400 18000 0 AQTT} - {1964052000 21600 1 AQTST} - {1982800800 18000 0 AQTT} - {1995501600 21600 1 AQTST} - {2014250400 18000 0 AQTT} - {2026951200 21600 1 AQTST} - {2045700000 18000 0 AQTT} - {2058400800 21600 1 AQTST} - {2077149600 18000 0 AQTT} - {2090455200 21600 1 AQTST} - {2108599200 18000 0 AQTT} - {2121904800 21600 1 AQTST} - {2140048800 18000 0 AQTT} - {2153354400 21600 1 AQTST} - {2172103200 18000 0 AQTT} - {2184804000 21600 1 AQTST} - {2203552800 18000 0 AQTT} - {2216253600 21600 1 AQTST} - {2235002400 18000 0 AQTT} - {2248308000 21600 1 AQTST} - {2266452000 18000 0 AQTT} - {2279757600 21600 1 AQTST} - {2297901600 18000 0 AQTT} - {2311207200 21600 1 AQTST} - {2329351200 18000 0 AQTT} - {2342656800 21600 1 AQTST} - {2361405600 18000 0 AQTT} - {2374106400 21600 1 AQTST} - {2392855200 18000 0 AQTT} - {2405556000 21600 1 AQTST} - {2424304800 18000 0 AQTT} - {2437610400 21600 1 AQTST} - {2455754400 18000 0 AQTT} - {2469060000 21600 1 AQTST} - {2487204000 18000 0 AQTT} - {2500509600 21600 1 AQTST} - {2519258400 18000 0 AQTT} - {2531959200 21600 1 AQTST} - {2550708000 18000 0 AQTT} - {2563408800 21600 1 AQTST} - {2582157600 18000 0 AQTT} - {2595463200 21600 1 AQTST} - {2613607200 18000 0 AQTT} - {2626912800 21600 1 AQTST} - {2645056800 18000 0 AQTT} - {2658362400 21600 1 AQTST} - {2676506400 18000 0 AQTT} - {2689812000 21600 1 AQTST} - {2708560800 18000 0 AQTT} - {2721261600 21600 1 AQTST} - {2740010400 18000 0 AQTT} - {2752711200 21600 1 AQTST} - {2771460000 18000 0 AQTT} - {2784765600 21600 1 AQTST} - {2802909600 18000 0 AQTT} - {2816215200 21600 1 AQTST} - {2834359200 18000 0 AQTT} - {2847664800 21600 1 AQTST} - {2866413600 18000 0 AQTT} - {2879114400 21600 1 AQTST} - {2897863200 18000 0 AQTT} - {2910564000 21600 1 AQTST} - {2929312800 18000 0 AQTT} - {2942013600 21600 1 AQTST} - {2960762400 18000 0 AQTT} - {2974068000 21600 1 AQTST} - {2992212000 18000 0 AQTT} - {3005517600 21600 1 AQTST} - {3023661600 18000 0 AQTT} - {3036967200 21600 1 AQTST} - {3055716000 18000 0 AQTT} - {3068416800 21600 1 AQTST} - {3087165600 18000 0 AQTT} - {3099866400 21600 1 AQTST} - {3118615200 18000 0 AQTT} - {3131920800 21600 1 AQTST} - {3150064800 18000 0 AQTT} - {3163370400 21600 1 AQTST} - {3181514400 18000 0 AQTT} - {3194820000 21600 1 AQTST} - {3212964000 18000 0 AQTT} - {3226269600 21600 1 AQTST} - {3245018400 18000 0 AQTT} - {3257719200 21600 1 AQTST} - {3276468000 18000 0 AQTT} - {3289168800 21600 1 AQTST} - {3307917600 18000 0 AQTT} - {3321223200 21600 1 AQTST} - {3339367200 18000 0 AQTT} - {3352672800 21600 1 AQTST} - {3370816800 18000 0 AQTT} - {3384122400 21600 1 AQTST} - {3402871200 18000 0 AQTT} - {3415572000 21600 1 AQTST} - {3434320800 18000 0 AQTT} - {3447021600 21600 1 AQTST} - {3465770400 18000 0 AQTT} - {3479076000 21600 1 AQTST} - {3497220000 18000 0 AQTT} - {3510525600 21600 1 AQTST} - {3528669600 18000 0 AQTT} - {3541975200 21600 1 AQTST} - {3560119200 18000 0 AQTT} - {3573424800 21600 1 AQTST} - {3592173600 18000 0 AQTT} - {3604874400 21600 1 AQTST} - {3623623200 18000 0 AQTT} - {3636324000 21600 1 AQTST} - {3655072800 18000 0 AQTT} - {3668378400 21600 1 AQTST} - {3686522400 18000 0 AQTT} - {3699828000 21600 1 AQTST} - {3717972000 18000 0 AQTT} - {3731277600 21600 1 AQTST} - {3750026400 18000 0 AQTT} - {3762727200 21600 1 AQTST} - {3781476000 18000 0 AQTT} - {3794176800 21600 1 AQTST} - {3812925600 18000 0 AQTT} - {3825626400 21600 1 AQTST} - {3844375200 18000 0 AQTT} - {3857680800 21600 1 AQTST} - {3875824800 18000 0 AQTT} - {3889130400 21600 1 AQTST} - {3907274400 18000 0 AQTT} - {3920580000 21600 1 AQTST} - {3939328800 18000 0 AQTT} - {3952029600 21600 1 AQTST} - {3970778400 18000 0 AQTT} - {3983479200 21600 1 AQTST} - {4002228000 18000 0 AQTT} - {4015533600 21600 1 AQTST} - {4033677600 18000 0 AQTT} - {4046983200 21600 1 AQTST} - {4065127200 18000 0 AQTT} - {4078432800 21600 1 AQTST} - {4096576800 18000 0 AQTT} + {1110826800 18000 0 AQTT} } diff --git a/library/tzdata/Asia/Baku b/library/tzdata/Asia/Baku index 5cc99b9..bbe5789 100644 --- a/library/tzdata/Asia/Baku +++ b/library/tzdata/Asia/Baku @@ -28,8 +28,7 @@ set TZData(:Asia/Baku) { {683496000 14400 0 AZST} {686109600 10800 0 AZT} {701812800 14400 1 AZST} - {717534000 10800 0 AZT} - {717559200 14400 0 AZT} + {717537600 14400 0 AZT} {820440000 14400 0 AZT} {828234000 18000 1 AZST} {846378000 14400 0 AZT} diff --git a/library/tzdata/Asia/Jerusalem b/library/tzdata/Asia/Jerusalem index c0b2c01..3423a7a 100644 --- a/library/tzdata/Asia/Jerusalem +++ b/library/tzdata/Asia/Jerusalem @@ -79,70 +79,70 @@ set TZData(:Asia/Jerusalem) { {1065132000 7200 0 IST} {1081292400 10800 1 IDT} {1095804000 7200 0 IST} - {1114380000 10800 1 IDT} - {1128805200 7200 0 IST} - {1144965600 10800 1 IDT} - {1159650000 7200 0 IST} - {1175637600 10800 1 IDT} - {1189890000 7200 0 IST} - {1208728800 10800 1 IDT} - {1223154000 7200 0 IST} - {1239314400 10800 1 IDT} - {1253998800 7200 0 IST} - {1269986400 10800 1 IDT} - {1284238800 7200 0 IST} - {1303250400 10800 1 IDT} - {1317502800 7200 0 IST} - {1333836000 10800 1 IDT} - {1348347600 7200 0 IST} - {1364335200 10800 1 IDT} - {1378587600 7200 0 IST} - {1397599200 10800 1 IDT} - {1411851600 7200 0 IST} - {1428184800 10800 1 IDT} - {1442696400 7200 0 IST} - {1461448800 10800 1 IDT} - {1475960400 7200 0 IST} - {1491948000 10800 1 IDT} - {1506200400 7200 0 IST} - {1522533600 10800 1 IDT} - {1537045200 7200 0 IST} - {1555797600 10800 1 IDT} - {1570309200 7200 0 IST} - {1586469600 10800 1 IDT} - {1601154000 7200 0 IST} - {1616968800 10800 1 IDT} - {1631394000 7200 0 IST} - {1650146400 10800 1 IDT} - {1664658000 7200 0 IST} - {1680818400 10800 1 IDT} - {1695502800 7200 0 IST} - {1713909600 10800 1 IDT} - {1728162000 7200 0 IST} - {1744581600 10800 1 IDT} - {1759006800 7200 0 IST} - {1775167200 10800 1 IDT} - {1789851600 7200 0 IST} - {1808431200 10800 1 IDT} - {1823115600 7200 0 IST} - {1839103200 10800 1 IDT} - {1853355600 7200 0 IST} - {1869688800 10800 1 IDT} - {1884200400 7200 0 IST} - {1902780000 10800 1 IDT} - {1917464400 7200 0 IST} - {1933452000 10800 1 IDT} - {1947704400 7200 0 IST} - {1964037600 10800 1 IDT} - {1978549200 7200 0 IST} - {1997128800 10800 1 IDT} - {2011813200 7200 0 IST} - {2027800800 10800 1 IDT} - {2042053200 7200 0 IST} - {2061064800 10800 1 IDT} - {2075317200 7200 0 IST} - {2091650400 10800 1 IDT} - {2106162000 7200 0 IST} - {2122149600 10800 1 IDT} - {2136402000 7200 0 IST} + {1112313600 10800 1 IDT} + {1128812400 7200 0 IST} + {1143763200 10800 1 IDT} + {1159657200 7200 0 IST} + {1175212800 10800 1 IDT} + {1189897200 7200 0 IST} + {1206662400 10800 1 IDT} + {1223161200 7200 0 IST} + {1238112000 10800 1 IDT} + {1254006000 7200 0 IST} + {1269561600 10800 1 IDT} + {1284246000 7200 0 IST} + {1301616000 10800 1 IDT} + {1317510000 7200 0 IST} + {1333065600 10800 1 IDT} + {1348354800 7200 0 IST} + {1364515200 10800 1 IDT} + {1378594800 7200 0 IST} + {1395964800 10800 1 IDT} + {1411858800 7200 0 IST} + {1427414400 10800 1 IDT} + {1442703600 7200 0 IST} + {1459468800 10800 1 IDT} + {1475967600 7200 0 IST} + {1490918400 10800 1 IDT} + {1506207600 7200 0 IST} + {1522368000 10800 1 IDT} + {1537052400 7200 0 IST} + {1553817600 10800 1 IDT} + {1570316400 7200 0 IST} + {1585267200 10800 1 IDT} + {1601161200 7200 0 IST} + {1616716800 10800 1 IDT} + {1631401200 7200 0 IST} + {1648771200 10800 1 IDT} + {1664665200 7200 0 IST} + {1680220800 10800 1 IDT} + {1695510000 7200 0 IST} + {1711670400 10800 1 IDT} + {1728169200 7200 0 IST} + {1743120000 10800 1 IDT} + {1759014000 7200 0 IST} + {1774569600 10800 1 IDT} + {1789858800 7200 0 IST} + {1806019200 10800 1 IDT} + {1823122800 7200 0 IST} + {1838073600 10800 1 IDT} + {1853362800 7200 0 IST} + {1869523200 10800 1 IDT} + {1884207600 7200 0 IST} + {1900972800 10800 1 IDT} + {1917471600 7200 0 IST} + {1932422400 10800 1 IDT} + {1947711600 7200 0 IST} + {1963872000 10800 1 IDT} + {1978556400 7200 0 IST} + {1995926400 10800 1 IDT} + {2011820400 7200 0 IST} + {2027376000 10800 1 IDT} + {2042060400 7200 0 IST} + {2058825600 10800 1 IDT} + {2075324400 7200 0 IST} + {2090275200 10800 1 IDT} + {2106169200 7200 0 IST} + {2121724800 10800 1 IDT} + {2136409200 7200 0 IST} } diff --git a/library/tzdata/Asia/Oral b/library/tzdata/Asia/Oral index 0d54c34..bcdcd44 100644 --- a/library/tzdata/Asia/Oral +++ b/library/tzdata/Asia/Oral @@ -54,194 +54,5 @@ set TZData(:Asia/Oral) { {1067133600 14400 0 ORAT} {1080439200 18000 1 ORAST} {1099188000 14400 0 ORAT} - {1111888800 18000 1 ORAST} - {1130637600 14400 0 ORAT} - {1143338400 18000 1 ORAST} - {1162087200 14400 0 ORAT} - {1174788000 18000 1 ORAST} - {1193536800 14400 0 ORAT} - {1206842400 18000 1 ORAST} - {1224986400 14400 0 ORAT} - {1238292000 18000 1 ORAST} - {1256436000 14400 0 ORAT} - {1269741600 18000 1 ORAST} - {1288490400 14400 0 ORAT} - {1301191200 18000 1 ORAST} - {1319940000 14400 0 ORAT} - {1332640800 18000 1 ORAST} - {1351389600 14400 0 ORAT} - {1364695200 18000 1 ORAST} - {1382839200 14400 0 ORAT} - {1396144800 18000 1 ORAST} - {1414288800 14400 0 ORAT} - {1427594400 18000 1 ORAST} - {1445738400 14400 0 ORAT} - {1459044000 18000 1 ORAST} - {1477792800 14400 0 ORAT} - {1490493600 18000 1 ORAST} - {1509242400 14400 0 ORAT} - {1521943200 18000 1 ORAST} - {1540692000 14400 0 ORAT} - {1553997600 18000 1 ORAST} - {1572141600 14400 0 ORAT} - {1585447200 18000 1 ORAST} - {1603591200 14400 0 ORAT} - {1616896800 18000 1 ORAST} - {1635645600 14400 0 ORAT} - {1648346400 18000 1 ORAST} - {1667095200 14400 0 ORAT} - {1679796000 18000 1 ORAST} - {1698544800 14400 0 ORAT} - {1711850400 18000 1 ORAST} - {1729994400 14400 0 ORAT} - {1743300000 18000 1 ORAST} - {1761444000 14400 0 ORAT} - {1774749600 18000 1 ORAST} - {1792893600 14400 0 ORAT} - {1806199200 18000 1 ORAST} - {1824948000 14400 0 ORAT} - {1837648800 18000 1 ORAST} - {1856397600 14400 0 ORAT} - {1869098400 18000 1 ORAST} - {1887847200 14400 0 ORAT} - {1901152800 18000 1 ORAST} - {1919296800 14400 0 ORAT} - {1932602400 18000 1 ORAST} - {1950746400 14400 0 ORAT} - {1964052000 18000 1 ORAST} - {1982800800 14400 0 ORAT} - {1995501600 18000 1 ORAST} - {2014250400 14400 0 ORAT} - {2026951200 18000 1 ORAST} - {2045700000 14400 0 ORAT} - {2058400800 18000 1 ORAST} - {2077149600 14400 0 ORAT} - {2090455200 18000 1 ORAST} - {2108599200 14400 0 ORAT} - {2121904800 18000 1 ORAST} - {2140048800 14400 0 ORAT} - {2153354400 18000 1 ORAST} - {2172103200 14400 0 ORAT} - {2184804000 18000 1 ORAST} - {2203552800 14400 0 ORAT} - {2216253600 18000 1 ORAST} - {2235002400 14400 0 ORAT} - {2248308000 18000 1 ORAST} - {2266452000 14400 0 ORAT} - {2279757600 18000 1 ORAST} - {2297901600 14400 0 ORAT} - {2311207200 18000 1 ORAST} - {2329351200 14400 0 ORAT} - {2342656800 18000 1 ORAST} - {2361405600 14400 0 ORAT} - {2374106400 18000 1 ORAST} - {2392855200 14400 0 ORAT} - {2405556000 18000 1 ORAST} - {2424304800 14400 0 ORAT} - {2437610400 18000 1 ORAST} - {2455754400 14400 0 ORAT} - {2469060000 18000 1 ORAST} - {2487204000 14400 0 ORAT} - {2500509600 18000 1 ORAST} - {2519258400 14400 0 ORAT} - {2531959200 18000 1 ORAST} - {2550708000 14400 0 ORAT} - {2563408800 18000 1 ORAST} - {2582157600 14400 0 ORAT} - {2595463200 18000 1 ORAST} - {2613607200 14400 0 ORAT} - {2626912800 18000 1 ORAST} - {2645056800 14400 0 ORAT} - {2658362400 18000 1 ORAST} - {2676506400 14400 0 ORAT} - {2689812000 18000 1 ORAST} - {2708560800 14400 0 ORAT} - {2721261600 18000 1 ORAST} - {2740010400 14400 0 ORAT} - {2752711200 18000 1 ORAST} - {2771460000 14400 0 ORAT} - {2784765600 18000 1 ORAST} - {2802909600 14400 0 ORAT} - {2816215200 18000 1 ORAST} - {2834359200 14400 0 ORAT} - {2847664800 18000 1 ORAST} - {2866413600 14400 0 ORAT} - {2879114400 18000 1 ORAST} - {2897863200 14400 0 ORAT} - {2910564000 18000 1 ORAST} - {2929312800 14400 0 ORAT} - {2942013600 18000 1 ORAST} - {2960762400 14400 0 ORAT} - {2974068000 18000 1 ORAST} - {2992212000 14400 0 ORAT} - {3005517600 18000 1 ORAST} - {3023661600 14400 0 ORAT} - {3036967200 18000 1 ORAST} - {3055716000 14400 0 ORAT} - {3068416800 18000 1 ORAST} - {3087165600 14400 0 ORAT} - {3099866400 18000 1 ORAST} - {3118615200 14400 0 ORAT} - {3131920800 18000 1 ORAST} - {3150064800 14400 0 ORAT} - {3163370400 18000 1 ORAST} - {3181514400 14400 0 ORAT} - {3194820000 18000 1 ORAST} - {3212964000 14400 0 ORAT} - {3226269600 18000 1 ORAST} - {3245018400 14400 0 ORAT} - {3257719200 18000 1 ORAST} - {3276468000 14400 0 ORAT} - {3289168800 18000 1 ORAST} - {3307917600 14400 0 ORAT} - {3321223200 18000 1 ORAST} - {3339367200 14400 0 ORAT} - {3352672800 18000 1 ORAST} - {3370816800 14400 0 ORAT} - {3384122400 18000 1 ORAST} - {3402871200 14400 0 ORAT} - {3415572000 18000 1 ORAST} - {3434320800 14400 0 ORAT} - {3447021600 18000 1 ORAST} - {3465770400 14400 0 ORAT} - {3479076000 18000 1 ORAST} - {3497220000 14400 0 ORAT} - {3510525600 18000 1 ORAST} - {3528669600 14400 0 ORAT} - {3541975200 18000 1 ORAST} - {3560119200 14400 0 ORAT} - {3573424800 18000 1 ORAST} - {3592173600 14400 0 ORAT} - {3604874400 18000 1 ORAST} - {3623623200 14400 0 ORAT} - {3636324000 18000 1 ORAST} - {3655072800 14400 0 ORAT} - {3668378400 18000 1 ORAST} - {3686522400 14400 0 ORAT} - {3699828000 18000 1 ORAST} - {3717972000 14400 0 ORAT} - {3731277600 18000 1 ORAST} - {3750026400 14400 0 ORAT} - {3762727200 18000 1 ORAST} - {3781476000 14400 0 ORAT} - {3794176800 18000 1 ORAST} - {3812925600 14400 0 ORAT} - {3825626400 18000 1 ORAST} - {3844375200 14400 0 ORAT} - {3857680800 18000 1 ORAST} - {3875824800 14400 0 ORAT} - {3889130400 18000 1 ORAST} - {3907274400 14400 0 ORAT} - {3920580000 18000 1 ORAST} - {3939328800 14400 0 ORAT} - {3952029600 18000 1 ORAST} - {3970778400 14400 0 ORAT} - {3983479200 18000 1 ORAST} - {4002228000 14400 0 ORAT} - {4015533600 18000 1 ORAST} - {4033677600 14400 0 ORAT} - {4046983200 18000 1 ORAST} - {4065127200 14400 0 ORAT} - {4078432800 18000 1 ORAST} - {4096576800 14400 0 ORAT} + {1110830400 14400 0 ORAT} } diff --git a/library/tzdata/Asia/Qyzylorda b/library/tzdata/Asia/Qyzylorda index 28db804..271495e 100644 --- a/library/tzdata/Asia/Qyzylorda +++ b/library/tzdata/Asia/Qyzylorda @@ -54,194 +54,5 @@ set TZData(:Asia/Qyzylorda) { {1067133600 21600 0 QYZT} {1080439200 25200 1 QYZST} {1099188000 21600 0 QYZT} - {1111888800 25200 1 QYZST} - {1130637600 21600 0 QYZT} - {1143338400 25200 1 QYZST} - {1162087200 21600 0 QYZT} - {1174788000 25200 1 QYZST} - {1193536800 21600 0 QYZT} - {1206842400 25200 1 QYZST} - {1224986400 21600 0 QYZT} - {1238292000 25200 1 QYZST} - {1256436000 21600 0 QYZT} - {1269741600 25200 1 QYZST} - {1288490400 21600 0 QYZT} - {1301191200 25200 1 QYZST} - {1319940000 21600 0 QYZT} - {1332640800 25200 1 QYZST} - {1351389600 21600 0 QYZT} - {1364695200 25200 1 QYZST} - {1382839200 21600 0 QYZT} - {1396144800 25200 1 QYZST} - {1414288800 21600 0 QYZT} - {1427594400 25200 1 QYZST} - {1445738400 21600 0 QYZT} - {1459044000 25200 1 QYZST} - {1477792800 21600 0 QYZT} - {1490493600 25200 1 QYZST} - {1509242400 21600 0 QYZT} - {1521943200 25200 1 QYZST} - {1540692000 21600 0 QYZT} - {1553997600 25200 1 QYZST} - {1572141600 21600 0 QYZT} - {1585447200 25200 1 QYZST} - {1603591200 21600 0 QYZT} - {1616896800 25200 1 QYZST} - {1635645600 21600 0 QYZT} - {1648346400 25200 1 QYZST} - {1667095200 21600 0 QYZT} - {1679796000 25200 1 QYZST} - {1698544800 21600 0 QYZT} - {1711850400 25200 1 QYZST} - {1729994400 21600 0 QYZT} - {1743300000 25200 1 QYZST} - {1761444000 21600 0 QYZT} - {1774749600 25200 1 QYZST} - {1792893600 21600 0 QYZT} - {1806199200 25200 1 QYZST} - {1824948000 21600 0 QYZT} - {1837648800 25200 1 QYZST} - {1856397600 21600 0 QYZT} - {1869098400 25200 1 QYZST} - {1887847200 21600 0 QYZT} - {1901152800 25200 1 QYZST} - {1919296800 21600 0 QYZT} - {1932602400 25200 1 QYZST} - {1950746400 21600 0 QYZT} - {1964052000 25200 1 QYZST} - {1982800800 21600 0 QYZT} - {1995501600 25200 1 QYZST} - {2014250400 21600 0 QYZT} - {2026951200 25200 1 QYZST} - {2045700000 21600 0 QYZT} - {2058400800 25200 1 QYZST} - {2077149600 21600 0 QYZT} - {2090455200 25200 1 QYZST} - {2108599200 21600 0 QYZT} - {2121904800 25200 1 QYZST} - {2140048800 21600 0 QYZT} - {2153354400 25200 1 QYZST} - {2172103200 21600 0 QYZT} - {2184804000 25200 1 QYZST} - {2203552800 21600 0 QYZT} - {2216253600 25200 1 QYZST} - {2235002400 21600 0 QYZT} - {2248308000 25200 1 QYZST} - {2266452000 21600 0 QYZT} - {2279757600 25200 1 QYZST} - {2297901600 21600 0 QYZT} - {2311207200 25200 1 QYZST} - {2329351200 21600 0 QYZT} - {2342656800 25200 1 QYZST} - {2361405600 21600 0 QYZT} - {2374106400 25200 1 QYZST} - {2392855200 21600 0 QYZT} - {2405556000 25200 1 QYZST} - {2424304800 21600 0 QYZT} - {2437610400 25200 1 QYZST} - {2455754400 21600 0 QYZT} - {2469060000 25200 1 QYZST} - {2487204000 21600 0 QYZT} - {2500509600 25200 1 QYZST} - {2519258400 21600 0 QYZT} - {2531959200 25200 1 QYZST} - {2550708000 21600 0 QYZT} - {2563408800 25200 1 QYZST} - {2582157600 21600 0 QYZT} - {2595463200 25200 1 QYZST} - {2613607200 21600 0 QYZT} - {2626912800 25200 1 QYZST} - {2645056800 21600 0 QYZT} - {2658362400 25200 1 QYZST} - {2676506400 21600 0 QYZT} - {2689812000 25200 1 QYZST} - {2708560800 21600 0 QYZT} - {2721261600 25200 1 QYZST} - {2740010400 21600 0 QYZT} - {2752711200 25200 1 QYZST} - {2771460000 21600 0 QYZT} - {2784765600 25200 1 QYZST} - {2802909600 21600 0 QYZT} - {2816215200 25200 1 QYZST} - {2834359200 21600 0 QYZT} - {2847664800 25200 1 QYZST} - {2866413600 21600 0 QYZT} - {2879114400 25200 1 QYZST} - {2897863200 21600 0 QYZT} - {2910564000 25200 1 QYZST} - {2929312800 21600 0 QYZT} - {2942013600 25200 1 QYZST} - {2960762400 21600 0 QYZT} - {2974068000 25200 1 QYZST} - {2992212000 21600 0 QYZT} - {3005517600 25200 1 QYZST} - {3023661600 21600 0 QYZT} - {3036967200 25200 1 QYZST} - {3055716000 21600 0 QYZT} - {3068416800 25200 1 QYZST} - {3087165600 21600 0 QYZT} - {3099866400 25200 1 QYZST} - {3118615200 21600 0 QYZT} - {3131920800 25200 1 QYZST} - {3150064800 21600 0 QYZT} - {3163370400 25200 1 QYZST} - {3181514400 21600 0 QYZT} - {3194820000 25200 1 QYZST} - {3212964000 21600 0 QYZT} - {3226269600 25200 1 QYZST} - {3245018400 21600 0 QYZT} - {3257719200 25200 1 QYZST} - {3276468000 21600 0 QYZT} - {3289168800 25200 1 QYZST} - {3307917600 21600 0 QYZT} - {3321223200 25200 1 QYZST} - {3339367200 21600 0 QYZT} - {3352672800 25200 1 QYZST} - {3370816800 21600 0 QYZT} - {3384122400 25200 1 QYZST} - {3402871200 21600 0 QYZT} - {3415572000 25200 1 QYZST} - {3434320800 21600 0 QYZT} - {3447021600 25200 1 QYZST} - {3465770400 21600 0 QYZT} - {3479076000 25200 1 QYZST} - {3497220000 21600 0 QYZT} - {3510525600 25200 1 QYZST} - {3528669600 21600 0 QYZT} - {3541975200 25200 1 QYZST} - {3560119200 21600 0 QYZT} - {3573424800 25200 1 QYZST} - {3592173600 21600 0 QYZT} - {3604874400 25200 1 QYZST} - {3623623200 21600 0 QYZT} - {3636324000 25200 1 QYZST} - {3655072800 21600 0 QYZT} - {3668378400 25200 1 QYZST} - {3686522400 21600 0 QYZT} - {3699828000 25200 1 QYZST} - {3717972000 21600 0 QYZT} - {3731277600 25200 1 QYZST} - {3750026400 21600 0 QYZT} - {3762727200 25200 1 QYZST} - {3781476000 21600 0 QYZT} - {3794176800 25200 1 QYZST} - {3812925600 21600 0 QYZT} - {3825626400 25200 1 QYZST} - {3844375200 21600 0 QYZT} - {3857680800 25200 1 QYZST} - {3875824800 21600 0 QYZT} - {3889130400 25200 1 QYZST} - {3907274400 21600 0 QYZT} - {3920580000 25200 1 QYZST} - {3939328800 21600 0 QYZT} - {3952029600 25200 1 QYZST} - {3970778400 21600 0 QYZT} - {3983479200 25200 1 QYZST} - {4002228000 21600 0 QYZT} - {4015533600 25200 1 QYZST} - {4033677600 21600 0 QYZT} - {4046983200 25200 1 QYZST} - {4065127200 21600 0 QYZT} - {4078432800 25200 1 QYZST} - {4096576800 21600 0 QYZT} + {1110823200 21600 0 QYZT} } diff --git a/library/tzdata/Asia/Tehran b/library/tzdata/Asia/Tehran index 369245e..8523379 100644 --- a/library/tzdata/Asia/Tehran +++ b/library/tzdata/Asia/Tehran @@ -80,8 +80,8 @@ set TZData(:Asia/Tehran) { {1695324600 12600 0 IRST} {1710966600 16200 1 IRDT} {1726860600 12600 0 IRST} - {1742502600 16200 1 IRDT} - {1758396600 12600 0 IRST} + {1742589000 16200 1 IRDT} + {1758483000 12600 0 IRST} {1774125000 16200 1 IRDT} {1790019000 12600 0 IRST} {1805661000 16200 1 IRDT} diff --git a/library/tzdata/Indian/Chagos b/library/tzdata/Indian/Chagos index f3ac8df..98bbcd3 100644 --- a/library/tzdata/Indian/Chagos +++ b/library/tzdata/Indian/Chagos @@ -1,6 +1,7 @@ # created by ../tools/tclZIC.tcl - do not edit set TZData(:Indian/Chagos) { - {-9223372036854775808 18000 0 IOT} + {-9223372036854775808 17380 0 LMT} + {-1988167780 18000 0 IOT} {820436400 21600 0 IOT} } diff --git a/library/tzdata/Indian/Cocos b/library/tzdata/Indian/Cocos index 511ed58..d237dfa 100644 --- a/library/tzdata/Indian/Cocos +++ b/library/tzdata/Indian/Cocos @@ -1,5 +1,6 @@ # created by ../tools/tclZIC.tcl - do not edit set TZData(:Indian/Cocos) { - {-9223372036854775808 23400 0 CCT} + {-9223372036854775808 23260 0 LMT} + {-2209012060 23400 0 CCT} } diff --git a/libtommath/bn.pdf b/libtommath/bn.pdf Binary files differindex 13c6d22..615ff4e 100644 --- a/libtommath/bn.pdf +++ b/libtommath/bn.pdf diff --git a/libtommath/tombc/grammar.txt b/libtommath/tombc/grammar.txt new file mode 100644 index 0000000..a780e75 --- /dev/null +++ b/libtommath/tombc/grammar.txt @@ -0,0 +1,35 @@ +program := program statement | statement | empty +statement := { statement } | + identifier = numexpression; | + identifier[numexpression] = numexpression; | + function(expressionlist); | + for (identifer = numexpression; numexpression; identifier = numexpression) { statement } | + while (numexpression) { statement } | + if (numexpresion) { statement } elif | + break; | + continue; + +elif := else statement | empty +function := abs | countbits | exptmod | jacobi | print | isprime | nextprime | issquare | readinteger | exit +expressionlist := expressionlist, expression | expression + +// LR(1) !!!? +expression := string | numexpression +numexpression := cmpexpr && cmpexpr | cmpexpr \|\| cmpexpr | cmpexpr +cmpexpr := boolexpr < boolexpr | boolexpr > boolexpr | boolexpr == boolexpr | + boolexpr <= boolexpr | boolexpr >= boolexpr | boolexpr +boolexpr := shiftexpr & shiftexpr | shiftexpr ^ shiftexpr | shiftexpr \| shiftexpr | shiftexpr +shiftexpr := addsubexpr << addsubexpr | addsubexpr >> addsubexpr | addsubexpr +addsubexpr := mulexpr + mulexpr | mulexpr - mulexpr | mulexpr +mulexpr := expr * expr | expr / expr | expr % expr | expr +expr := -nexpr | nexpr +nexpr := integer | identifier | ( numexpression ) | identifier[numexpression] + +identifier := identifer digits | identifier alpha | alpha +alpha := a ... z | A ... Z +integer := hexnumber | digits +hexnumber := 0xhexdigits +hexdigits := hexdigits hexdigit | hexdigit +hexdigit := 0 ... 9 | a ... f | A ... F +digits := digits digit | digit +digit := 0 ... 9 diff --git a/libtommath/tommath.pdf b/libtommath/tommath.pdf Binary files differindex 82f1558..c486d29 100644 --- a/libtommath/tommath.pdf +++ b/libtommath/tommath.pdf diff --git a/tests/clock.test b/tests/clock.test index 9983ca4..234e326 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.test,v 1.52.2.1 2004/12/29 22:47:05 kennykb Exp $ +# RCS: @(#) $Id: clock.test,v 1.52.2.2 2005/04/25 21:37:26 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -35399,6 +35399,18 @@ test clock-47.2 {regression test - four digit time} { clock scan 0039 } [clock scan 0039 -format %H%M] +test clock-48.1 {Bug 1185933: 'i' destroyed by clock init} -setup { + interp create child +} -body { + interp eval child { + set i 12345 + clock format 0 + list [catch { set i } result] $result + } +} -cleanup { + interp delete child +} -result {0 12345} + # cleanup namespace delete ::testClock diff --git a/tests/encoding.test b/tests/encoding.test index 897bebf..a14f778 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.21 2004/11/30 19:34:51 dgp Exp $ +# RCS: @(#) $Id: encoding.test,v 1.21.2.1 2005/04/25 21:37:28 kennykb Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -556,6 +556,19 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } +testConstraint testgetdefenc [llength [info commands testgetdefenc]] + +test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints { + testgetdefenc +} -setup { + set origDir [testgetdefenc] + testsetdefenc slappy +} -body { + testgetdefenc +} -cleanup { + testsetdefenc $origDir +} -result slappy + file delete {expand}[glob -directory [temporaryDirectory] *.chars *.tcltestout] # ===> Cut here <=== diff --git a/tests/io.test b/tests/io.test index 72f5042..f03cba9 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.65.2.1 2005/02/02 15:53:31 kennykb Exp $ +# RCS: @(#) $Id: io.test,v 1.65.2.2 2005/04/25 21:37:28 kennykb Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -4792,7 +4792,7 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { lappend l [fconfigure $f -buffersize] close $f set l -} {4096 10000 10000 10000 10000 100000 100000} +} {4096 10000 1 1 1 100000 100000} test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed diff --git a/tests/iogt.test b/tests/iogt.test index 53fd737..5d91bf1 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,7 +10,7 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.11 2004/06/23 15:36:57 dkf Exp $ +# RCS: @(#) $Id: iogt.test,v 1.11.2.1 2005/04/25 21:37:29 kennykb Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -498,7 +498,7 @@ test iogt-2.1 {basic I/O, operation trail} {testchannel unix} { audit_ops aout -attach $fout fconfigure $fin -buffersize 10 - fconfigure $fout -buffersize 5 + fconfigure $fout -buffersize 10 fcopy $fin $fout @@ -548,7 +548,7 @@ test iogt-2.2 {basic I/O, data trail} {testchannel unix} { audit_flow aout -attach $fout fconfigure $fin -buffersize 10 - fconfigure $fout -buffersize 5 + fconfigure $fout -buffersize 10 fcopy $fin $fout diff --git a/tests/string.test b/tests/string.test index 42fbc4e..43e8fa3 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.43.2.1 2005/03/09 14:39:28 kennykb Exp $ +# RCS: @(#) $Id: string.test,v 1.43.2.2 2005/04/25 21:37:30 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -22,6 +22,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] +testConstraint testindexobj [expr {[info commands testindexobj] != {}}] test string-1.1 {error conditions} { list [catch {string gorp a b} msg] $msg @@ -1385,6 +1386,12 @@ test string-22.13 {string wordstart, unicode} { string wordstart "\uc700\uc700 abc" 8 } 3 +test string-23.0 {string is boolean, Bug 1187123} testindexobj { + set x 5 + catch {testindexobj $x foo bar soom} + string is boolean $x +} 0 + # cleanup ::tcltest::cleanupTests return diff --git a/tests/unixInit.test b/tests/unixInit.test index 79437c0..f5a93c8 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -10,9 +10,9 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixInit.test,v 1.44.2.1 2004/12/08 18:24:36 kennykb Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.44.2.2 2005/04/25 21:37:30 kennykb Exp $ -package require tcltest 2 +package require tcltest 2.2 namespace import -force ::tcltest::* unset -nocomplain path catch {set oldlang $env(LANG)} @@ -92,40 +92,21 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} } } {OK} -proc getlibpath [list [list program [interpreter]]] { - set f [open "|[list $program]" w+] - fconfigure $f -buffering none - puts $f {puts $::tcl::LibPath; exit} - set path [gets $f] - close $f - return $path -} - -# Some tests require the testgetdefenc command +# The unixInit-2.* tests were written to test the internal routine, +# TclpInitLibraryPath. That routine no longer does the things it used +# to do so those tests are obsolete. Skip them. -testConstraint testgetdefenc [llength [info commands testgetdefenc]] +skip [concat [skip] unixInit-2.*] -unset -nocomplain oldlibrary -catch { - set oldlibrary $env(TCL_LIBRARY) - unset env(TCL_LIBRARY) -} -testConstraint canInitWithoutEnvTclLibrary [expr {[catch getlibpath] == 0}] -if {[info exists oldlibrary]} { - set env(TCL_LIBRARY) $oldlibrary -} - -test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \ - {unix testgetdefenc} { +test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} { set origDir [testgetdefenc] testsetdefenc slappy set path [testgetdefenc] testsetdefenc $origDir set path } {slappy} -test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -constraints { - unix stdio canInitWithoutEnvTclLibrary -} -setup { + +test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) @@ -148,9 +129,8 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -constr unset oldlibrary } } -result {0 0} -test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -constraints { - unix stdio canInitWithoutEnvTclLibrary -} -setup { + +test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) @@ -169,9 +149,8 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -constraints { unset oldlibrary } } -result "sparkly" -test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -constraints { - unix stdio canInitWithoutEnvTclLibrary -} -setup { + +test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) @@ -190,9 +169,8 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -constraints unset oldlibrary } } -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]] -test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -constraints { - unix stdio canInitWithoutEnvTclLibrary knownBug -} -setup { + +test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup { if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) } @@ -211,13 +189,11 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -constraints { unset oldlibrary } } -result "\xa7" -test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \ - {emptyTest unix} { +test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} { # cannot test } {} -test unixInit-2.6 {TclpInitLibraryPath: executable relative} -constraints { - unix stdio -} -setup { + +test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) @@ -248,23 +224,18 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -constraints { } } -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]] -test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \ - {emptyTest unix} { +test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} { # would need test command to get defaultLibDir and compare it to # [lindex $auto_path end] } {} + # # The following two tests write to the directory /tmp/sparkly instead # of to [temporaryDirectory]. This is because the failures tested by # these tests need paths near the "root" of the file system to present # themselves. # -testConstraint noSparkly [expr {![file exists [file join /tmp sparkly]]}] -testConstraint noTmpInstall [expr {![file exists \ - [file join /tmp lib tcl[info tclversion]]]}] -test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -constraints { - unix noSparkly noTmpInstall -} -setup { +test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) @@ -325,10 +296,8 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -constraints { unset oldlibrary } } -result 1 -testConstraint noTmpBuild [expr {![file exists [file join /tmp library]]}] -test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -constraints { - unix noSparkly noTmpBuild -} -setup { + +test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup { # Checking for Bug 438014 unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { @@ -355,9 +324,7 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -constrain } -result [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ /tmp/library /library /tcl[info patchlevel]/library] -test unixInit-2.10 {TclpInitLibraryPath: executable relative} -constraints { - unix stdio -} -setup { +test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 524eb74..bca76cc 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -25,14 +25,16 @@ # #---------------------------------------------------------------------- # -# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclZIC.tcl,v 1.3 2004/11/02 15:16:38 kennykb Exp $ +# RCS: @(#) $Id: tclZIC.tcl,v 1.3.2.1 2005/04/25 21:37:30 kennykb Exp $ # #---------------------------------------------------------------------- +package require Tcl 8.5 + # Define the names of the Olson files that we need to load. # We avoid the solar time files and the leap seconds. @@ -52,40 +54,15 @@ set maxyear 2100 # Determine how big a wide integer is. -set MAXWIDE [expr { wide(1) }] +set MAXWIDE [expr {wide(1)}] while 1 { - set next [expr { $MAXWIDE + $MAXWIDE + 1}] - if { $next < 0 } { + set next [expr {$MAXWIDE + $MAXWIDE + 1}] + if {$next < 0} { break } set MAXWIDE $next } -set MINWIDE [expr { - $MAXWIDE - 1 }] - -#---------------------------------------------------------------------- -# -# K -- -# -# The K combinator returns its first argument. It's used for -# reference count management. -# -# Parameters: -# x - Argument to be unreferenced. -# y - Unused. -# -# Results: -# Returns the first argument. -# -# Side effects: -# None. -# -# The K combinator is used for its effect that [K $x [set x {}]] -# reads out the value of x destructively, giving an unshared Tcl -# object and avoiding 'copy on write' -# -#---------------------------------------------------------------------- - -proc K {x y} {return $x} +set MINWIDE [expr {-$MAXWIDE-1}] #---------------------------------------------------------------------- # @@ -105,7 +82,7 @@ proc K {x y} {return $x} # #---------------------------------------------------------------------- -proc loadFiles { dir } { +proc loadFiles {dir} { variable olsonFiles foreach file $olsonFiles { puts "loading: [file join $dir $file]" @@ -136,9 +113,10 @@ proc loadFiles { dir } { proc checkForwardRuleRefs {} { variable forwardRuleRefs variable rules - foreach { rule where } [array get forwardRuleRefs] { - if { ![info exists rules($rule)] } { - foreach { fileName lno } $where { + + foreach {rule where} [array get forwardRuleRefs] { + if {![info exists rules($rule)]} { + foreach {fileName lno} $where { puts stderr "$fileName:$lno:can't locate rule \"$rule\"" incr errorCount } @@ -167,8 +145,7 @@ proc checkForwardRuleRefs {} { # #---------------------------------------------------------------------- -proc loadZIC { fileName } { - +proc loadZIC {fileName} { variable errorCount variable links @@ -186,19 +163,16 @@ proc loadZIC { fileName } { # Break a line of input into words. - regsub {[[:space:]]*(\#.*)?$} $line {} line - if { $line eq {} } { + regsub {\s*(\#.*)?$} $line {} line + if {$line eq ""} { continue } set words {} - if { [regexp {^[[:space:]]+(.*)} $line -> l] } { - lappend words {} - set line $l - } - while {[regexp {^([^[:space:]]+)[[:space:]]*(.*)} $line -> \ - word line]} { - lappend words $word + if {[regexp {^\s} $line]} { + # Detect continuations of a zone and flag the list appropriately + lappend words "" } + lappend words {expand}[regexp -all -inline {\S+} $line] # Switch on the directive @@ -212,12 +186,14 @@ proc loadZIC { fileName } { Zone { set lastZone [lindex $words 1] set until [parseZone $fileName $lno \ - $lastZone [lrange $words 2 end] minimum] + $lastZone [lrange $words 2 end] "minimum"] } - {} { # Continuation of a Zone + {} { set i 0 foreach word $words { - if { [lindex $words $i] ne {} } break + if {[lindex $words $i] ne ""} { + break + } incr i } set words [lrange $words $i end] @@ -231,7 +207,6 @@ proc loadZIC { fileName } { } return - } #---------------------------------------------------------------------- @@ -254,50 +229,47 @@ proc loadZIC { fileName } { # #---------------------------------------------------------------------- -proc parseRule { fileName lno words } { - +proc parseRule {fileName lno words} { variable rules variable errorCount # Break out the columns - foreach { Rule name from to type in on at save letter } $words {} + lassign $words Rule name from to type in on at save letter # Handle the 'only' keyword - if { $to eq {only} } { + if {$to eq "only"} { set to $from } # Process the start year - set l [string length $from] - if { ![string is integer $from] } { - if { $from ne [string range {minumum} 0 [expr { $l - 1 }]] } { + if {![string is integer $from]} { + if {![string equal -length [string length $from] $from "minimum"]} { puts stderr "$fileName:$lno:FROM field \"$from\" not an integer." incr errorCount return } else { - set from minimum + set from "minimum" } } # Process the end year - set l [string length $to] - if { ![string is integer $to] } { - if { $to ne [string range {maximum} 0 [expr { $l - 1 }]] } { + if {![string is integer $to]} { + if {![string equal -length [string length $to] $to "maximum"]} { puts stderr "$fileName:$lno:TO field \"$to\" not an integer." incr errorCount return } else { - set to maximum + set to "maximum" } } # Process the type of year in which the rule applies - if { $type ne {-} } { + if {$type ne "-"} { puts stderr "$fileName:$lno:year types are not yet supported." incr errorCount return @@ -305,7 +277,7 @@ proc parseRule { fileName lno words } { # Process the month in which the rule starts - if { [catch {lookupMonth $in} in] } { + if {[catch {lookupMonth $in} in]} { puts stderr "$fileName:$lno:$in" incr errorCount return @@ -313,7 +285,7 @@ proc parseRule { fileName lno words } { # Process the day of the month on which the rule starts - if { [catch {parseON $on} on] } { + if {[catch {parseON $on} on]} { puts stderr "$fileName:$lno:$on" incr errorCount return @@ -321,7 +293,7 @@ proc parseRule { fileName lno words } { # Process the time of day on which the rule starts - if { [catch {parseTOD $at} at] } { + if {[catch {parseTOD $at} at]} { puts stderr "$fileName:$lno:$at" incr errorCount return @@ -329,16 +301,16 @@ proc parseRule { fileName lno words } { # Process the DST adder - if { [catch {parseOffsetTime $save} save] } { + if {[catch {parseOffsetTime $save} save]} { puts stderr "$fileName:$lno:$save" incr errorCount return } - + # Process the letter to use for summer time - if { $letter eq {-} } { - set letter {} + if {$letter eq "-"} { + set letter "" } # Accumulate all the data. @@ -358,7 +330,7 @@ proc parseRule { fileName lno words } { # on - the ON field from a line in an Olson file. # # Results: -# Returns a partial Tcl command. When the year and number of the +# Returns a partial Tcl command. When the year and number of the # month are appended, the command will return the Julian Day Number # of the desired date. # @@ -374,14 +346,14 @@ proc parseRule { fileName lno words } { # space. This designates the last occurrence of the given weekday # in the month. # -#---------------------------------------------------------------------- +#---------------------------------------------------------------------- -proc parseON { on } { - if { ! [regexp -expanded { +proc parseON {on} { + if {![regexp -expanded { ^(?: # first possibility - simple number - field 1 ([[:digit:]]+) - | + | # second possibility - weekday >= (or <=) number # field 2 - weekday ([[:alpha:]]+) @@ -389,26 +361,26 @@ proc parseON { on } { ([<>]=) # field 4 - number ([[:digit:]]+) - | + | # third possibility - lastWeekday - field 5 last([[:alpha:]]+) - )$ - } $on -> dom1 wday2 dir2 num2 wday3] } { + )$ + } $on -> dom1 wday2 dir2 num2 wday3]} then { error "can't parse ON field \"$on\"" } - if { $dom1 ne {} } { + if {$dom1 ne ""} { return [list onDayOfMonth $dom1] - } elseif { $wday2 ne {} } { + } elseif {$wday2 ne ""} { set wday2 [lookupDayOfWeek $wday2] return [list onWeekdayInMonth $wday2 $dir2 $num2] - } elseif { $wday3 ne {} } { + } elseif {$wday3 ne ""} { set wday3 [lookupDayOfWeek $wday3] return [list onLastWeekdayInMonth $wday3] } else { error "in parseOn \"$on\": can't happen" } } - + #---------------------------------------------------------------------- # # onDayOfMonth -- @@ -428,10 +400,9 @@ proc parseON { on } { # #---------------------------------------------------------------------- -proc onDayOfMonth { day year month } { - set date [dict create era CE year $year month $month dayOfMonth $day] +proc onDayOfMonth {day year month} { set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [K $date [set date {}]]] + [dict create era CE year $year month $month dayOfMonth $day]] return [dict get $date julianDay] } @@ -462,19 +433,17 @@ proc onDayOfMonth { day year month } { # #---------------------------------------------------------------------- -proc onWeekdayInMonth { dayOfWeek relation dayOfMonth year month } { - set date [dict create \ - era CE year $year month $month dayOfMonth $dayOfMonth] - set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [K $date [set date {}]]] +proc onWeekdayInMonth {dayOfWeek relation dayOfMonth year month} { + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ + era CE year $year month $month dayOfMonth $dayOfMonth]] switch -exact -- $relation { <= { return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ - [dict get $date julianDay]] + [dict get $date julianDay]] } >= { return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ - [expr { [dict get $date julianDay] + 6 }]] + [expr {[dict get $date julianDay] + 6}]] } } } @@ -499,18 +468,16 @@ proc onWeekdayInMonth { dayOfWeek relation dayOfMonth year month } { # #---------------------------------------------------------------------- -proc onLastWeekdayInMonth { dayOfWeek year month } { +proc onLastWeekdayInMonth {dayOfWeek year month} { incr month # Find day 0 of the following month, which is the last day of # the current month. Yes, it works to ask for day 0 of month 13! - set date [dict create \ - era CE year $year month $month dayOfMonth 0] - set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [K $date [set date {}]]] + set date [::tcl::clock::GetJulianDayFromEraYearMonthDay [dict create \ + era CE year $year month $month dayOfMonth 0]] return [::tcl::clock::WeekdayOnOrBefore $dayOfWeek \ - [dict get $date julianDay]] + [dict get $date julianDay]] } - + #---------------------------------------------------------------------- # # parseTOD -- @@ -532,42 +499,38 @@ proc onLastWeekdayInMonth { dayOfWeek year month } { # #---------------------------------------------------------------------- -proc parseTOD { tod } { - if { ![regexp -expanded { +proc parseTOD {tod} { + if {![regexp -expanded { ^ - # field 1 - hour - ([[:digit:]]{1,2}) + ([[:digit:]]{1,2}) # field 1 - hour (?: - # field 2 - minute - :([[:digit:]]{2}) - (?: - # field 3 - second - :([[:digit:]]{2}) - )? + :([[:digit:]]{2}) # field 2 - minute + (?: + :([[:digit:]]{2}) # field 3 - second + )? )? (?: - # field 4 - type indicator - ([wsugz]) - )? - } $tod -> hour minute second ind] } { + ([wsugz]) # field 4 - type indicator + )? + } $tod -> hour minute second ind]} then { puts stderr "$fileName:$lno:can't parse time field \"$tod\"" incr errorCount } scan $hour %d hour - if { $minute ne {} } { + if {$minute ne ""} { scan $minute %d minute } else { set minute 0 } - if { $second ne {} } { + if {$second ne ""} { scan $second %d second } else { set second 0 } - if { $ind eq {} } { + if {$ind eq ""} { set ind w } - return [list [expr { ( $hour * 60 + $minute ) * 60 + $second }] $ind] + return [list [expr {($hour * 60 + $minute) * 60 + $second}] $ind] } #---------------------------------------------------------------------- @@ -587,38 +550,34 @@ proc parseTOD { tod } { # #---------------------------------------------------------------------- -proc parseOffsetTime { offset } { - if { ![regexp -expanded { +proc parseOffsetTime {offset} { + if {![regexp -expanded { ^ - # field 1 - signum - ([-+])? - # field 2 - hour - ([[:digit:]]{1,2}) + ([-+])? # field 1 - signum + ([[:digit:]]{1,2}) # field 2 - hour (?: - # field 3 - minute - :([[:digit:]]{2}) - (?: - # field 4 - second - :([[:digit:]]{2}) - )? + :([[:digit:]]{2}) # field 3 - minute + (?: + :([[:digit:]]{2}) # field 4 - second + )? )? - } $offset -> signum hour minute second] } { + } $offset -> signum hour minute second]} then { puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" incr errorCount } append signum 1 scan $hour %d hour - if { $minute ne {} } { + if {$minute ne ""} { scan $minute %d minute } else { set minute 0 } - if { $second ne {} } { + if {$second ne ""} { scan $second %d second } else { set second 0 } - return [expr { ( ( $hour * 60 + $minute ) * 60 + $second ) * $signum }] + return [expr {(($hour * 60 + $minute) * 60 + $second) * $signum}] } @@ -638,13 +597,12 @@ proc parseOffsetTime { offset } { # #---------------------------------------------------------------------- -proc lookupMonth { month } { - +proc lookupMonth {month} { set indx [lsearch -regexp { {} January February March April May June July August September October November December } ${month}.*] - if { $indx < 1 } { + if {$indx < 1} { error "unknown month name \"$month\"" } return $indx @@ -667,11 +625,11 @@ proc lookupMonth { month } { # #---------------------------------------------------------------------- -proc lookupDayOfWeek { wday } { +proc lookupDayOfWeek {wday} { set indx [lsearch -regexp { {} Monday Tuesday Wednesday Thursday Friday Saturday Sunday } ${wday}.*] - if { $indx < 1 } { + if {$indx < 1} { error "unknown weekday name \"$wday\"" } return $indx @@ -689,7 +647,7 @@ proc lookupDayOfWeek { wday } { # zone -- Name of the time zone # words -- Remaining words on the line. # start -- 'Until' time from the previous line if this is a -# continuation line, or 'minimum' if this is the first line. +# continuation line, or 'minimum' if this is the first line. # # Results: # Returns the 'until' field of the current line @@ -701,8 +659,8 @@ proc lookupDayOfWeek { wday } { # Standard Time, and a format for printing the time zone. # # The start time is the result of an earlier call to 'parseUntil' -# or else the keyword 'minimum'. The GMT offset is the -# result of a call to 'parseOffsetTime'. The Daylight Saving +# or else the keyword 'minimum'. The GMT offset is the +# result of a call to 'parseOffsetTime'. The Daylight Saving # Time offset is represented as a partial Tcl command. To the # command will be appended a start time (seconds from epoch) # the current offset of Standard Time from Greenwich, the current @@ -714,31 +672,30 @@ proc lookupDayOfWeek { wday } { # #---------------------------------------------------------------------- -proc parseZone { fileName lno zone words start } { +proc parseZone {fileName lno zone words start} { variable zones variable rules variable errorCount variable forwardRuleRefs - foreach { gmtoff save format } $words break - if { [catch {parseOffsetTime $gmtoff} gmtoff] } { + + lassign $words gmtoff save format + if {[catch {parseOffsetTime $gmtoff} gmtoff]} { puts stderr "$fileName:$lno:$gmtoff" incr errorCount return - } - if { [info exists rules($save)] } { + } + if {[info exists rules($save)]} { set save [list applyRules $save] - } elseif { $save eq {-} } { + } elseif {$save eq "-"} { set save [list applyNoRule] + } elseif {[catch {parseOffsetTime $save} save2]} { + lappend forwardRuleRefs($save) $fileName $lno + set save [list applyRules $save] } else { - if { [catch { parseOffsetTime $save } save2] } { - lappend forwardRuleRefs($save) $fileName $lno - set save [list applyRules $save] - } else { - set save [list applyDSTOffset $save2] - } + set save [list applyDSTOffset $save2] } lappend zones($zone) $start $gmtoff $save $format - if { [llength $words] >= 4 } { + if {[llength $words] >= 4} { return [parseUntil [lrange $words 3 end]] } else { return {} @@ -748,7 +705,7 @@ proc parseZone { fileName lno zone words start } { #---------------------------------------------------------------------- # # parseUntil -- -# +# # Parses the 'UNTIL' part of a 'Zone' directive. # # Parameters: @@ -761,30 +718,31 @@ proc parseZone { fileName lno zone words start } { # #---------------------------------------------------------------------- -proc parseUntil { words } { +proc parseUntil {words} { variable firstYear - if { [llength $words] >= 1 } { + + if {[llength $words] >= 1} { set year [lindex $words 0] - if { ![string is integer $year] } { + if {![string is integer $year]} { error "can't parse UNTIL field \"$words\"" } - if { ![info exists firstYear] || $year < $firstYear } { + if {![info exists firstYear] || $year < $firstYear} { set firstYear $year } } else { - set year maximum + set year "maximum" } - if { [llength $words] >= 2 } { + if {[llength $words] >= 2} { set month [lookupMonth [lindex $words 1]] } else { set month 1 } - if { [llength $words] >= 3 } { + if {[llength $words] >= 3} { set day [parseON [lindex $words 2]] } else { set day {onDayOfMonth 1} } - if { [llength $words] >= 4 } { + if {[llength $words] >= 4} { set tod [parseTOD [lindex $words 3]] } else { set tod {0 w} @@ -824,25 +782,24 @@ proc parseUntil { words } { # #---------------------------------------------------------------------- -proc applyNoRule { year startSecs stdGMTOffset DSTOffset nextGMTOffset - namePattern until pointsVar } { +proc applyNoRule {year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { upvar 1 $pointsVar points lappend points $startSecs $nextGMTOffset 0 \ - [convertNamePattern $namePattern -] + [convertNamePattern $namePattern -] return [list $nextGMTOffset 0] - } #---------------------------------------------------------------------- # -# applyNoRule -- +# applyDSTOffset -- # # Generates time zone data for a zone with permanent Daylight # Saving Time. # # Parameters: # nextDSTOffset - Offset of Daylight from Standard while the -# rule is in effect. +# rule is in effect. # year - Year in which the rule applies # startSecs - Time at which the rule starts. # stdGMTOffset - Offset from Greenwich prior to the start of the @@ -866,15 +823,15 @@ proc applyNoRule { year startSecs stdGMTOffset DSTOffset nextGMTOffset # #---------------------------------------------------------------------- -proc applyDSTOffset { nextDSTOffset year startSecs - stdGMTOffset DSTOffset nextGMTOffset - namePattern until pointsVar } { +proc applyDSTOffset {nextDSTOffset year startSecs + stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { upvar 1 $pointsVar points lappend points \ - $startSecs \ - [expr { $nextGMTOffset + $nextDSTOffset }] \ - 1 \ - [convertNamePattern $namePattern S] + $startSecs \ + [expr {$nextGMTOffset + $nextDSTOffset}] \ + 1 \ + [convertNamePattern $namePattern S] return [list $nextGMTOffset $nextDSTOffset] } @@ -911,8 +868,8 @@ proc applyDSTOffset { nextDSTOffset year startSecs # #---------------------------------------------------------------------- -proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ - namePattern until pointsVar } { +proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset + namePattern until pointsVar} { variable done variable rules variable maxyear @@ -923,91 +880,80 @@ proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ # of rules (now or in future) that will end at a specific year. # Ignore rules entirely in the past. - foreach { - currentRules nSunsetRules - } [divideRules $ruleSet $year] break + lassign [divideRules $ruleSet $year] currentRules nSunsetRules # If the first transition is later than $startSecs, and $stdGMTOffset is # different from $nextGMTOffset, we will need an initial record like: - # lappend points $startSecs $stdGMTOffset 0 \ - # [convertNamePattern $namePattern -] + # lappend points $startSecs $stdGMTOffset 0 \ + # [convertNamePattern $namePattern -] set didTransitionIn false # Determine the letter to use in Standard Time - set prevLetter {} - foreach { + set prevLetter "" + foreach { fromYear toYear yearType monthIn daySpecOn timeAt save letter - } $rules($ruleSet) { - if { $save == 0 } { + } $rules($ruleSet) { + if {$save == 0} { set prevLetter $letter break - } + } } # Walk through each year in turn. This loop will break when - # (a) the 'until' time is passed + # (a) the 'until' time is passed # or (b) the 'until' time is empty and all remaining rules extend to - # the end of time + # the end of time set stdGMTOffset $nextGMTOffset # convert "until" to seconds from epoch in current time zone - if { $until ne {} } { - foreach { - untilYear untilMonth untilDaySpec untilTimeOfDay - } $until break + if {$until ne ""} { + lassign $until untilYear untilMonth untilDaySpec untilTimeOfDay lappend untilDaySpec $untilYear $untilMonth set untilJCD [eval $untilDaySpec] set untilBaseSecs [expr { - wide(86400) * wide($untilJCD) - - 210866803200 }] - set untilSecs [eval [linsert $untilTimeOfDay 0 convertTimeOfDay \ - $untilBaseSecs $stdGMTOffset $DSTOffset]] + wide(86400) * wide($untilJCD) - 210866803200 }] + set untilSecs [convertTimeOfDay $untilBaseSecs $stdGMTOffset \ + $DSTOffset {expand}$untilTimeOfDay] } set origStartSecs $startSecs - while { ( $until ne {} && - $startSecs < $untilSecs ) - || ( $until eq {} && - ( $nSunsetRules > 0 || $year < $maxyear ) ) } { - + while {($until ne "" && $startSecs < $untilSecs) + || ($until eq "" && ($nSunsetRules > 0 || $year < $maxyear))} { set remainingRules $currentRules - while { [llength $remainingRules] > 0 } { - + while {[llength $remainingRules] > 0} { # Find the rule with the earliest start time from among the # active rules that haven't yet been processed. - foreach { - earliestSecs earliestIndex - } [findEarliestRule $remainingRules $year \ - $stdGMTOffset $DSTOffset] break - + lassign [findEarliestRule $remainingRules $year \ + $stdGMTOffset $DSTOffset] earliestSecs earliestIndex + set endi [expr {$earliestIndex + 7}] set rule [lrange $remainingRules $earliestIndex $endi] - foreach { - fromYear toYear yearType monthIn daySpecOn timeAt save letter - } $rule break + lassign $rule fromYear toYear \ + yearType monthIn daySpecOn timeAt save letter # Test if the rule is in effect. - if { $earliestSecs > $startSecs && - ( $until eq {} || $earliestSecs < $untilSecs ) } { - + if { + $earliestSecs > $startSecs && + ($until eq "" || $earliestSecs < $untilSecs) + } then { # Test if the initial transition has been done. # If not, do it now. - if { !$didTransitionIn && $earliestSecs > $origStartSecs } { + if {!$didTransitionIn && $earliestSecs > $origStartSecs} { set nm [convertNamePattern $namePattern $prevLetter] lappend points \ - $origStartSecs \ - [expr { $stdGMTOffset + $DSTOffset }] \ - 0 \ - $nm + $origStartSecs \ + [expr {$stdGMTOffset + $DSTOffset}] \ + 0 \ + $nm set didTransitionIn true } @@ -1015,18 +961,17 @@ proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ set nm [convertNamePattern $namePattern $letter] lappend points \ - $earliestSecs \ - [expr { $stdGMTOffset + $save }] \ - [expr { $save != 0 }] \ - $nm + $earliestSecs \ + [expr {$stdGMTOffset + $save}] \ + [expr {$save != 0}] \ + $nm } # Remove the rule just applied from the queue set remainingRules [lreplace \ - [K $remainingRules \ - [set remainingRules {}]] \ - $earliestIndex $endi] + $remainingRules[set remainingRules {}] \ + $earliestIndex $endi] # Update current DST offset and time zone letter @@ -1034,11 +979,10 @@ proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ set prevLetter $letter # Reconvert the 'until' time in the current zone. - - if { $until ne {} } { - set untilSecs [eval [linsert $untilTimeOfDay 0 \ - convertTimeOfDay $untilBaseSecs \ - $stdGMTOffset $DSTOffset]] + + if {$until ne ""} { + set untilSecs [convertTimeOfDay $untilBaseSecs \ + $stdGMTOffset $DSTOffset {expand}$untilTimeOfDay] } } @@ -1046,18 +990,15 @@ proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ incr year set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ - [dict create era CE year $year month 1 dayOfMonth 1]] - set startSecs [expr { [dict get $date julianDay] * wide(86400) \ - -210866803200 }] - set startSecs [expr { $startSecs - $stdGMTOffset - $DSTOffset }] - + [dict create era CE year $year month 1 dayOfMonth 1]] + set startSecs [expr { + [dict get $date julianDay] * wide(86400) - 210866803200 + - $stdGMTOffset - $DSTOffset + }] # Get rules in effect in the new year. - foreach { - currentRules nSunsetRules - } [divideRules $ruleSet $year] break - + lassign [divideRules $ruleSet $year] currentRules nSunsetRules } return [list $stdGMTOffset $DSTOffset] @@ -1085,24 +1026,23 @@ proc applyRules { ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset \ # #---------------------------------------------------------------------- -proc divideRules { ruleSet year } { - +proc divideRules {ruleSet year} { variable rules set currentRules {} set nSunsetRules 0 - foreach { + foreach { fromYear toYear yearType monthIn daySpecOn timeAt save letter - } $rules($ruleSet) { - if { $toYear ne {maximum} && $year > $toYear } { + } $rules($ruleSet) { + if {$toYear ne "maximum" && $year > $toYear} { # ignore - rule is in the past } else { - if { $fromYear eq {minimum} || $fromYear <= $year } { + if {$fromYear eq "minimum" || $fromYear <= $year} { lappend currentRules $fromYear $toYear $yearType $monthIn \ - $daySpecOn $timeAt $save $letter + $daySpecOn $timeAt $save $letter } - if { $toYear ne {maximum} } { + if {$toYear ne "maximum"} { incr nSunsetRules } } @@ -1123,7 +1063,7 @@ proc divideRules { ruleSet year } { # year - Year being processed. # stdGMTOffset - Current offset of standard time from GMT # DSTOffset - Current offset of daylight time from standard, -# if daylight time is in effect. +# if daylight time is in effect. # # Results: # Returns the index in remainingRules of the next rule to @@ -1134,8 +1074,7 @@ proc divideRules { ruleSet year } { # #---------------------------------------------------------------------- -proc findEarliestRule { remainingRules year stdGMTOffset DSTOffset } { - +proc findEarliestRule {remainingRules year stdGMTOffset DSTOffset} { set earliest $::MAXWIDE set i 0 foreach { @@ -1143,12 +1082,10 @@ proc findEarliestRule { remainingRules year stdGMTOffset DSTOffset } { } $remainingRules { lappend daySpecOn $year $monthIn set dayIn [eval $daySpecOn] - set secs [expr { - wide(86400) * wide($dayIn) - -210866803200 }] - set secs [eval [linsert $timeAt 0 convertTimeOfDay \ - $secs $stdGMTOffset $DSTOffset]] - if { $secs < $earliest } { + set secs [expr {wide(86400) * wide($dayIn) - 210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {expand}$timeAt] + if {$secs < $earliest} { set earliest $secs set earliestIdx $i } @@ -1156,7 +1093,6 @@ proc findEarliestRule { remainingRules year stdGMTOffset DSTOffset } { } return [list $earliest $earliestIdx] - } #---------------------------------------------------------------------- @@ -1178,9 +1114,9 @@ proc findEarliestRule { remainingRules year stdGMTOffset DSTOffset } { # #---------------------------------------------------------------------- -proc convertNamePattern { pattern flag } { - if { [regexp {(.*)/(.*)} $pattern -> standard daylight] } { - if { $flag ne {} } { +proc convertNamePattern {pattern flag} { + if {[regexp {(.*)/(.*)} $pattern -> standard daylight]} { + if {$flag ne ""} { set pattern $daylight } else { set pattern $standard @@ -1204,7 +1140,7 @@ proc convertNamePattern { pattern flag } { # timeOfDay - Time of day to convert, in seconds from midnight # flag - Flag indicating whether the time is Greenwich, Standard # or wall-clock. (g, s, or w) -# +# # Results: # Returns the time of day in seconds from the Posix epoch. # @@ -1213,17 +1149,17 @@ proc convertNamePattern { pattern flag } { # #---------------------------------------------------------------------- -proc convertTimeOfDay { seconds stdGMTOffset DSTOffset timeOfDay flag } { +proc convertTimeOfDay {seconds stdGMTOffset DSTOffset timeOfDay flag} { incr seconds $timeOfDay switch -exact $flag { g - u - z { } w { - incr seconds [expr { -$stdGMTOffset }] - incr seconds [expr { -$DSTOffset }] + incr seconds [expr {-$stdGMTOffset}] + incr seconds [expr {-$DSTOffset}] } z { - incr seconds [expr { -$stdGMTOffset }] + incr seconds [expr {-$stdGMTOffset}] } } return $seconds @@ -1242,7 +1178,7 @@ proc convertTimeOfDay { seconds stdGMTOffset DSTOffset timeOfDay flag } { # obtained from 'parseZone. # # Results: -# Returns a list of rows. Each row consists of a time in +# Returns a list of rows. Each row consists of a time in # seconds from the Posix epoch, an offset from GMT to local # that begins at that time, a flag indicating whether DST # is in effect after that time, and the printable name of the @@ -1253,36 +1189,33 @@ proc convertTimeOfDay { seconds stdGMTOffset DSTOffset timeOfDay flag } { # #---------------------------------------------------------------------- -proc processTimeZone { zoneName zoneData } { - +proc processTimeZone {zoneName zoneData} { set points {} set i 0 - foreach { startTime nextGMTOffset dstRule namePattern } $zoneData { + foreach {startTime nextGMTOffset dstRule namePattern} $zoneData { incr i 4 set until [lindex $zoneData $i] - if {! [info exists stdGMTOffset] } { + if {![info exists stdGMTOffset]} { set stdGMTOffset $nextGMTOffset } - if {! [info exists DSTOffset] } { + if {![info exists DSTOffset]} { set DSTOffset 0 } - if { $startTime eq {minimum} } { + if {$startTime eq "minimum"} { set secs $::MINWIDE set year 0 } else { - foreach { year month dayRule timeOfDay } $startTime break + lassign $startTime year month dayRule timeOfDay lappend dayRule $year $month set startDay [eval $dayRule] - set secs [expr { - wide(86400) * wide($startDay) - -210866803200}] - set secs [eval [linsert $timeOfDay 0 convertTimeOfDay \ - $secs $stdGMTOffset $DSTOffset]] + set secs [expr {wide(86400) * wide($startDay) -210866803200}] + set secs [convertTimeOfDay $secs \ + $stdGMTOffset $DSTOffset {expand}$timeOfDay] } lappend dstRule \ - $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ - $namePattern $until points - foreach {stdGMTOffset DSTOffset} [eval $dstRule] break + $year $secs $stdGMTOffset $DSTOffset $nextGMTOffset \ + $namePattern $until points + lassign [eval $dstRule] stdGMTOffset DSTOffset } return $points } @@ -1305,8 +1238,7 @@ proc processTimeZone { zoneName zoneData } { # #---------------------------------------------------------------------- -proc writeZones { outDir } { - +proc writeZones {outDir} { variable zones # Walk the zones @@ -1318,18 +1250,18 @@ proc writeZones { outDir } { # Create directories as needed set dirName [file dirname $fileName] - if { ![file exists $dirName] } { + if {![file exists $dirName]} { puts "creating directory: $dirName" file mkdir $dirName } # Generate data for a zone - set data {} - foreach { - time offset dst name + set data "" + foreach { + time offset dst name } [processTimeZone $zoneName $zones($zoneName)] { - append data \n { } [list [list $time $offset $dst $name]] + append data "\n " [list [list $time $offset $dst $name]] } append data \n @@ -1337,10 +1269,9 @@ proc writeZones { outDir } { set f [open $fileName w] puts $f "\# created by $::argv0 - do not edit" - puts $f {} + puts $f "" puts $f [list set TZData(:$zoneName) $data] close $f - } return @@ -1362,8 +1293,7 @@ proc writeZones { outDir } { # Side effects: # Creates a file for each link. -proc writeLinks { outDir } { - +proc writeLinks {outDir} { variable links # Walk the links @@ -1375,7 +1305,7 @@ proc writeLinks { outDir } { # Create directories as needed set dirName [file dirname $fileName] - if { ![file exists $dirName] } { + if {![file exists $dirName]} { puts "creating directory: $dirName" file mkdir $dirName } @@ -1407,7 +1337,7 @@ proc writeLinks { outDir } { # Determine directories -foreach { inDir outDir } $argv break +lassign $argv inDir outDir # Initialize count of errors @@ -1416,14 +1346,14 @@ set errorCount 0 # Parse the Olson files loadFiles $inDir -if { $errorCount > 0 } { +if {$errorCount > 0} { exit 1 } # Check that all riles appearing in Zone and Link lines actually exist checkForwardRuleRefs -if { $errorCount > 0 } { +if {$errorCount > 0} { exit 1 } @@ -1431,10 +1361,10 @@ if { $errorCount > 0 } { writeZones $outDir writeLinks $outDir -if { $errorCount > 0 } { +if {$errorCount > 0} { exit 1 } # All done! -exit
\ No newline at end of file +exit diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 7e32b02..bb098c7 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.53.2.1 2004/12/08 18:24:37 kennykb Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.53.2.2 2005/04/25 21:37:30 kennykb Exp $ */ #include "tclInt.h" @@ -131,8 +131,19 @@ typedef struct LocaleTable { CONST char *encoding; } LocaleTable; +/* + * The table below is sorted for the sake of doing binary searches on it. + * The indenting reflects different categories of data. The leftmost + * data represent the encoding names directly implemented by data files + * in Tcl's default encoding directory. Indented by one TAB are the + * encoding names that are common alternative spellings. Indented by + * two TABs are the accumulated "bug fixes" that have been added to + * deal with the wide variability seen among existing platforms. + */ + static CONST LocaleTable localeTable[] = { - /* First list all the encoding files installed with Tcl */ + {"", "iso8859-1"}, + {"ansi_x3.4-1968", "iso8859-1"}, {"ascii", "ascii"}, {"big5", "big5"}, {"cp1250", "cp1250"}, @@ -169,13 +180,64 @@ static CONST LocaleTable localeTable[] = { {"euc-cn", "euc-cn"}, {"euc-jp", "euc-jp"}, {"euc-kr", "euc-kr"}, + {"eucjp", "euc-jp"}, + {"euckr", "euc-kr"}, + {"euctw", "euc-cn"}, {"gb12345", "gb12345"}, {"gb1988", "gb1988"}, - {"gb2312-raw", "gb2312-raw"}, {"gb2312", "gb2312"}, + {"gb2312-1980", "gb2312"}, + {"gb2312-raw", "gb2312-raw"}, + {"greek8", "cp869"}, + {"ibm1250", "cp1250"}, + {"ibm1251", "cp1251"}, + {"ibm1252", "cp1252"}, + {"ibm1253", "cp1253"}, + {"ibm1254", "cp1254"}, + {"ibm1255", "cp1255"}, + {"ibm1256", "cp1256"}, + {"ibm1257", "cp1257"}, + {"ibm1258", "cp1258"}, + {"ibm437", "cp437"}, + {"ibm737", "cp737"}, + {"ibm775", "cp775"}, + {"ibm850", "cp850"}, + {"ibm852", "cp852"}, + {"ibm855", "cp855"}, + {"ibm857", "cp857"}, + {"ibm860", "cp860"}, + {"ibm861", "cp861"}, + {"ibm862", "cp862"}, + {"ibm863", "cp863"}, + {"ibm864", "cp864"}, + {"ibm865", "cp865"}, + {"ibm866", "cp866"}, + {"ibm869", "cp869"}, + {"ibm874", "cp874"}, + {"ibm932", "cp932"}, + {"ibm936", "cp936"}, + {"ibm949", "cp949"}, + {"ibm950", "cp950"}, + {"iso-2022", "iso2022"}, + {"iso-2022-jp", "iso2022-jp"}, + {"iso-2022-kr", "iso2022-kr"}, + {"iso-8859-1", "iso8859-1"}, + {"iso-8859-10", "iso8859-10"}, + {"iso-8859-13", "iso8859-13"}, + {"iso-8859-14", "iso8859-14"}, + {"iso-8859-15", "iso8859-15"}, + {"iso-8859-16", "iso8859-16"}, + {"iso-8859-2", "iso8859-2"}, + {"iso-8859-3", "iso8859-3"}, + {"iso-8859-4", "iso8859-4"}, + {"iso-8859-5", "iso8859-5"}, + {"iso-8859-6", "iso8859-6"}, + {"iso-8859-7", "iso8859-7"}, + {"iso-8859-8", "iso8859-8"}, + {"iso-8859-9", "iso8859-9"}, + {"iso2022", "iso2022"}, {"iso2022-jp", "iso2022-jp"}, {"iso2022-kr", "iso2022-kr"}, - {"iso2022", "iso2022"}, {"iso8859-1", "iso8859-1"}, {"iso8859-10", "iso8859-10"}, {"iso8859-13", "iso8859-13"}, @@ -190,28 +252,48 @@ static CONST LocaleTable localeTable[] = { {"iso8859-7", "iso8859-7"}, {"iso8859-8", "iso8859-8"}, {"iso8859-9", "iso8859-9"}, + {"iso88591", "iso8859-1"}, + {"iso885915", "iso8859-15"}, + {"iso88592", "iso8859-2"}, + {"iso88595", "iso8859-5"}, + {"iso88596", "iso8859-6"}, + {"iso88597", "iso8859-7"}, + {"iso88598", "iso8859-8"}, + {"iso88599", "iso8859-9"}, +#ifdef hpux + {"ja", "shiftjis"}, +#else + {"ja", "euc-jp"}, +#endif + {"ja_jp", "euc-jp"}, + {"ja_jp.euc", "euc-jp"}, + {"ja_jp.eucjp", "euc-jp"}, + {"ja_jp.jis", "iso2022-jp"}, + {"ja_jp.mscode", "shiftjis"}, + {"ja_jp.sjis", "shiftjis"}, + {"ja_jp.ujis", "euc-jp"}, + {"japan", "euc-jp"}, +#ifdef hpux + {"japanese", "shiftjis"}, +#else + {"japanese", "euc-jp"}, +#endif + {"japanese-sjis", "shiftjis"}, + {"japanese-ujis", "euc-jp"}, + {"japanese.euc", "euc-jp"}, + {"japanese.sjis", "shiftjis"}, {"jis0201", "jis0201"}, {"jis0208", "jis0208"}, {"jis0212", "jis0212"}, + {"jp_jp", "shiftjis"}, + {"ko", "euc-kr"}, + {"ko_kr", "euc-kr"}, + {"ko_kr.euc", "euc-kr"}, + {"ko_kw.euckw", "euc-kr"}, {"koi8-r", "koi8-r"}, {"koi8-u", "koi8-u"}, + {"korean", "euc-kr"}, {"ksc5601", "ksc5601"}, - {"macCentEuro", "macCentEuro"}, - {"macCroatian", "macCroatian"}, - {"macCyrillic", "macCyrillic"}, - {"macDingbats", "macDingbats"}, - {"macGreek", "macGreek"}, - {"macIceland", "macIceland"}, - {"macJapan", "macJapan"}, - {"macRoman", "macRoman"}, - {"macRomania", "macRomania"}, - {"macThai", "macThai"}, - {"macTurkish", "macTurkish"}, - {"macUkraine", "macUkraine"}, - {"shiftjis", "shiftjis"}, - {"symbol", "symbol"}, - {"tis-620", "tis-620"}, - /* Next list a few common variants */ {"maccenteuro", "macCentEuro"}, {"maccroatian", "macCroatian"}, {"maccyrillic", "macCyrillic"}, @@ -224,119 +306,23 @@ static CONST LocaleTable localeTable[] = { {"macthai", "macThai"}, {"macturkish", "macTurkish"}, {"macukraine", "macUkraine"}, - {"iso-2022-jp", "iso2022-jp"}, - {"iso-2022-kr", "iso2022-kr"}, - {"iso-2022", "iso2022"}, - {"iso-8859-1", "iso8859-1"}, - {"iso-8859-10", "iso8859-10"}, - {"iso-8859-13", "iso8859-13"}, - {"iso-8859-14", "iso8859-14"}, - {"iso-8859-15", "iso8859-15"}, - {"iso-8859-16", "iso8859-16"}, - {"iso-8859-2", "iso8859-2"}, - {"iso-8859-3", "iso8859-3"}, - {"iso-8859-4", "iso8859-4"}, - {"iso-8859-5", "iso8859-5"}, - {"iso-8859-6", "iso8859-6"}, - {"iso-8859-7", "iso8859-7"}, - {"iso-8859-8", "iso8859-8"}, - {"iso-8859-9", "iso8859-9"}, - {"ibm1250", "cp1250"}, - {"ibm1251", "cp1251"}, - {"ibm1252", "cp1252"}, - {"ibm1253", "cp1253"}, - {"ibm1254", "cp1254"}, - {"ibm1255", "cp1255"}, - {"ibm1256", "cp1256"}, - {"ibm1257", "cp1257"}, - {"ibm1258", "cp1258"}, - {"ibm437", "cp437"}, - {"ibm737", "cp737"}, - {"ibm775", "cp775"}, - {"ibm850", "cp850"}, - {"ibm852", "cp852"}, - {"ibm855", "cp855"}, - {"ibm857", "cp857"}, - {"ibm860", "cp860"}, - {"ibm861", "cp861"}, - {"ibm862", "cp862"}, - {"ibm863", "cp863"}, - {"ibm864", "cp864"}, - {"ibm865", "cp865"}, - {"ibm866", "cp866"}, - {"ibm869", "cp869"}, - {"ibm874", "cp874"}, - {"ibm932", "cp932"}, - {"ibm936", "cp936"}, - {"ibm949", "cp949"}, - {"ibm950", "cp950"}, - {"", "iso8859-1"}, - {"ansi_x3.4-1968", "iso8859-1"}, - /* Finally, the accumulated bug fixes... */ -#ifdef HAVE_LANGINFO - {"gb2312-1980", "gb2312"}, -#ifdef __hpux - {"SJIS", "shiftjis"}, - {"eucjp", "euc-jp"}, - {"euckr", "euc-kr"}, - {"euctw", "euc-cn"}, - {"greek8", "cp869"}, - {"iso88591", "iso8859-1"}, - {"iso88592", "iso8859-2"}, - {"iso88595", "iso8859-5"}, - {"iso88596", "iso8859-6"}, - {"iso88597", "iso8859-7"}, - {"iso88598", "iso8859-8"}, - {"iso88599", "iso8859-9"}, - {"iso885915", "iso8859-15"}, - {"roman8", "iso8859-1"}, - {"tis620", "tis-620"}, - {"turkish8", "cp857"}, - {"utf8", "utf-8"}, -#endif /* __hpux */ -#endif /* HAVE_LANGINFO */ - - {"ja_JP.SJIS", "shiftjis"}, - {"ja_JP.EUC", "euc-jp"}, - {"ja_JP.eucJP", "euc-jp"}, - {"ja_JP.JIS", "iso2022-jp"}, - {"ja_JP.mscode", "shiftjis"}, - {"ja_JP.ujis", "euc-jp"}, - {"ja_JP", "euc-jp"}, - {"Ja_JP", "shiftjis"}, - {"Jp_JP", "shiftjis"}, - {"japan", "euc-jp"}, -#ifdef hpux - {"japanese", "shiftjis"}, - {"ja", "shiftjis"}, -#else - {"japanese", "euc-jp"}, - {"ja", "euc-jp"}, -#endif - {"japanese.sjis", "shiftjis"}, - {"japanese.euc", "euc-jp"}, - {"japanese-sjis", "shiftjis"}, - {"japanese-ujis", "euc-jp"}, - - {"ko", "euc-kr"}, - {"ko_KR", "euc-kr"}, - {"ko_KR.EUC", "euc-kr"}, - {"ko_KR.euc", "euc-kr"}, - {"ko_KR.eucKR", "euc-kr"}, - {"korean", "euc-kr"}, - - {"ru", "iso8859-5"}, - {"ru_RU", "iso8859-5"}, - {"ru_SU", "iso8859-5"}, - - {"zh", "cp936"}, - {"zh_CN.gb2312", "euc-cn"}, - {"zh_CN.GB2312", "euc-cn"}, - {"zh_CN.GBK", "euc-cn"}, - {"zh_TW.Big5", "big5"}, - {"zh_TW", "euc-tw"}, - - {NULL, NULL} + {"roman8", "iso8859-1"}, + {"ru", "iso8859-5"}, + {"ru_ru", "iso8859-5"}, + {"ru_su", "iso8859-5"}, + {"shiftjis", "shiftjis"}, + {"sjis", "shiftjis"}, + {"symbol", "symbol"}, + {"tis-620", "tis-620"}, + {"tis620", "tis-620"}, + {"turkish8", "cp857"}, + {"utf8", "utf-8"}, + {"zh", "cp936"}, + {"zh_cn.gb2312", "euc-cn"}, + {"zh_cn.gbk", "euc-cn"}, + {"zh_cz.gb2312", "euc-cn"}, + {"zh_tw", "euc-tw"}, + {"zh_tw.big5", "big5"}, }; #ifndef TCL_NO_STACK_CHECK @@ -589,12 +575,33 @@ TclpSetInterfaces() /* do nothing */ } +static CONST char * +SearchKnownEncodings(encoding) + CONST char *encoding; +{ + int left = 0; + int right = sizeof(localeTable)/sizeof(LocaleTable); + while (left <= right) { + int test = (left + right)/2; + int code = strcmp(localeTable[test].lang, encoding); + if (code == 0) { + return localeTable[test].encoding; + } + if (code < 0) { + left = test+1; + } else { + right = test-1; + } + } + return NULL; +} + CONST char * TclpGetEncodingNameFromEnvironment(bufPtr) Tcl_DString *bufPtr; { CONST char *encoding; - int i; + CONST char *knownEncoding; Tcl_DStringInit(bufPtr); @@ -611,16 +618,10 @@ TclpGetEncodingNameFromEnvironment(bufPtr) Tcl_DStringInit(&ds); encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); - /* Check whether it's a known encoding... */ - if (NULL == Tcl_GetEncoding(NULL, encoding)) { - /* ... or in the table if encodings we *should* know */ - for (i = 0; localeTable[i].lang != NULL; i++) { - if (strcmp(localeTable[i].lang, encoding) == 0) { - Tcl_DStringAppend(bufPtr, localeTable[i].encoding, -1); - break; - } - } - } else { + knownEncoding = SearchKnownEncodings(encoding); + if (knownEncoding != NULL) { + Tcl_DStringAppend(bufPtr, knownEncoding, -1); + } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } Tcl_DStringFree(&ds); @@ -648,20 +649,21 @@ TclpGetEncodingNameFromEnvironment(bufPtr) if (encoding != NULL) { CONST char *p; + Tcl_DString ds; - /* Check whether it's a known encoding... */ - if (NULL == Tcl_GetEncoding(NULL, encoding)) { - /* ... or in the table if encodings we *should* know */ - for (i = 0; localeTable[i].lang != NULL; i++) { - if (strcmp(localeTable[i].lang, encoding) == 0) { - Tcl_DStringAppend(bufPtr, localeTable[i].encoding, -1); - break; - } - } - } else { + Tcl_DStringInit(&ds); + p = encoding; + encoding = Tcl_DStringAppend(&ds, p, -1); + Tcl_UtfToLower(Tcl_DStringValue(&ds)); + + knownEncoding = SearchKnownEncodings(encoding); + if (knownEncoding != NULL) { + Tcl_DStringAppend(bufPtr, knownEncoding, -1); + } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } if (Tcl_DStringLength(bufPtr)) { + Tcl_DStringFree(&ds); return Tcl_DStringValue(bufPtr); } @@ -677,28 +679,16 @@ TclpGetEncodingNameFromEnvironment(bufPtr) } } if (*p != '\0') { - Tcl_DString ds; - Tcl_DStringInit(&ds); - encoding = Tcl_DStringAppend(&ds, p, -1); - Tcl_UtfToLower(Tcl_DStringValue(&ds)); - - /* Check whether it's a known encoding... */ - if (NULL == Tcl_GetEncoding(NULL, encoding)) { - /* ... or in the table if encodings we *should* know */ - for (i = 0; localeTable[i].lang != NULL; i++) { - if (strcmp(localeTable[i].lang, encoding) == 0) { - Tcl_DStringAppend(bufPtr, localeTable[i].encoding, -1); - break; - } - } - } else { - Tcl_DStringAppend(bufPtr, encoding, -1); - } - Tcl_DStringFree(&ds); - if (Tcl_DStringLength(bufPtr)) { - return Tcl_DStringValue(bufPtr); + knownEncoding = SearchKnownEncodings(p); + if (knownEncoding != NULL) { + Tcl_DStringAppend(bufPtr, knownEncoding, -1); + } else if (NULL != Tcl_GetEncoding(NULL, p)) { + Tcl_DStringAppend(bufPtr, p, -1); } - + } + Tcl_DStringFree(&ds); + if (Tcl_DStringLength(bufPtr)) { + return Tcl_DStringValue(bufPtr); } } return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1); diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index f163782..19e73c5 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -933,13 +933,16 @@ TclpFreeAllocMutex(mutex) void TclpFreeAllocCache(ptr) void *ptr; { - extern void TclFreeAllocCache(void *); - - TclFreeAllocCache(ptr); - /* - * Perform proper cleanup of things done in TclpGetAllocCache. - */ - if (initialized) { + if (ptr != NULL) { + /* + * Called by the pthread lib when a thread exits + */ + TclFreeAllocCache(ptr); + } else if (initialized) { + /* + * Called by us in TclFinalizeThreadAlloc() during + * the library finalization initiated from Tcl_Finalize() + */ pthread_key_delete(key); initialized = 0; } diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index c6438f1..01c7b5c 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinThrd.c,v 1.34 2004/10/27 20:53:38 davygrvy Exp $ + * RCS: @(#) $Id: tclWinThrd.c,v 1.34.2.1 2005/04/25 21:37:30 kennykb Exp $ */ #include "tclWinInt.h" @@ -683,13 +683,16 @@ TclpFinalizeThreadData(keyPtr) DWORD *indexPtr; BOOL success; -#ifdef USE_THREAD_ALLOC - TclWinFreeAllocCache(); -#endif if (*keyPtr != NULL) { indexPtr = *(DWORD **)keyPtr; result = (VOID *)TlsGetValue(*indexPtr); if (result != NULL) { +#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) + if (indexPtr == &key) { + TclpFreeAllocCache(result); + return; + } +#endif ckfree((char *)result); success = TlsSetValue(*indexPtr, (void *)NULL); if (!success) { @@ -1080,7 +1083,7 @@ TclpGetAllocCache(void) if (!once) { /* - * We need to make sure that TclWinFreeAllocCache is called + * We need to make sure that TclpFreeAllocCache is called * on each thread that calls this, but only on threads that * call this. */ @@ -1109,32 +1112,32 @@ TclpSetAllocCache(void *ptr) } void -TclWinFreeAllocCache(void) +TclpFreeAllocCache(void *ptr) { - void *ptr; BOOL success; - ptr = TlsGetValue(key); if (ptr != NULL) { - success = TlsSetValue(key, NULL); + /* + * Called by us in TclpFinalizeThreadData when a thread exits + * and destroys the tsd key which stores allocator caches. + */ + TclFreeAllocCache(ptr); + success = TlsSetValue(key, NULL); if (!success) { - Tcl_Panic("TlsSetValue failed from TclWinFreeAllocCache!"); + panic("TlsSetValue failed from TclpFreeAllocCache!"); } - TclFreeAllocCache(ptr); - } else { - if (GetLastError() != NO_ERROR) { - Tcl_Panic("TlsGetValue failed from TclWinFreeAllocCache!"); - } - } - - if (once) { + } else if (once) { + /* + * Called by us in TclFinalizeThreadAlloc() during + * the library finalization initiated from Tcl_Finalize() + */ success = TlsFree(key); if (!success) { - Tcl_Panic("TlsFree failed from TclWinFreeAllocCache!"); + Tcl_Panic("TlsFree failed from TclpFreeAllocCache!"); } - once = 0; /* reset for next time. */ } + } #endif /* USE_THREAD_ALLOC */ |