Tcl Source Code

Check-in [cb4d8a38a3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | gahr-ticket-e6f27aa56f
Files: files | file ages | folders
SHA1: cb4d8a38a37728eeda0d2672b808836924c6cec8
User & Date: gahr 2016-06-10 12:10:41
Context
2016-11-16
15:59
merge trunk Closed-Leaf check-in: ec44244e32 user: jan.nijtmans tags: gahr-ticket-e6f27aa56f
2016-06-10
12:10
Merge trunk check-in: cb4d8a38a3 user: gahr tags: gahr-ticket-e6f27aa56f
2016-06-02
12:24
tcltest 2.3.9 -> 2.4.0 check-in: e49dfc8538 user: jan.nijtmans tags: trunk
2016-03-13
17:23
[e6f27aa56f] Add files I missed in my previous commit check-in: 7625571c31 user: gahr tags: gahr-ticket-e6f27aa56f
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/clock.n.

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
...
209
210
211
212
213
214
215
216

217
218
219
220
221
222
223
exactly 86400 seconds.  Tcl responds to leap seconds by speeding or
slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
any unique prefix of such a word. Used in conjunction with \fIcount\fR
to identify an interval of time, for example, \fI3 seconds\fR or
\fI1 year\fR.
.SS "OPTIONS"
.TP
\fB\-base\fR time
Specifies that any relative times present in a \fBclock scan\fR command
are to be given relative to \fItime\fR.  \fItime\fR must be expressed as
a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC.
.TP
................................................................................
.PP
The \fBclock add\fR command performs clock arithmetic on a value
(expressed as nominal seconds from the epoch time of 1 January 1970, 00:00 UTC)
given as its first argument.  The remaining arguments (other than the
possible \fB\-timezone\fR, \fB\-locale\fR and \fB\-gmt\fR options)
are integers and keywords in alternation, where the keywords are chosen
from \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
any unique prefix of such a word.
.PP
Addition of seconds, minutes and hours is fairly straightforward;
the given time increment (times sixty for minutes, or 3600 for hours)
is simply added to the \fItimeVal\fR given
to the \fBclock add\fR command.  The result is interpreted as
a nominal number of seconds from the Epoch.
.PP
................................................................................
.CE
.PP
Adding and subtracting days and weeks is accomplished by converting
the given time to a calendar day and time of day in the appropriate
time zone and locale.  The requisite number of days (weeks are converted
to days by multiplying by seven) is added to the calendar day, and
the date and time are then converted back to a count of seconds from
the epoch time.

.PP
Adding and subtracting a given number of days across the point that
the time changes at the start or end of summer time (Daylight Saving Time)
results in the \fIsame local time\fR on the day in question.  For
instance, the following code sets the value of \fBx\fR to \fB05:00:00\fR.
.PP
.CS






|
|
|
<







 







|
<







 







|
>







85
86
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
...
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
...
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
exactly 86400 seconds.  Tcl responds to leap seconds by speeding or
slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
Used in conjunction with \fIcount\fR to identify an interval of time,
for example, \fI3 seconds\fR or \fI1 year\fR.

.SS "OPTIONS"
.TP
\fB\-base\fR time
Specifies that any relative times present in a \fBclock scan\fR command
are to be given relative to \fItime\fR.  \fItime\fR must be expressed as
a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC.
.TP
................................................................................
.PP
The \fBclock add\fR command performs clock arithmetic on a value
(expressed as nominal seconds from the epoch time of 1 January 1970, 00:00 UTC)
given as its first argument.  The remaining arguments (other than the
possible \fB\-timezone\fR, \fB\-locale\fR and \fB\-gmt\fR options)
are integers and keywords in alternation, where the keywords are chosen
from \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.

.PP
Addition of seconds, minutes and hours is fairly straightforward;
the given time increment (times sixty for minutes, or 3600 for hours)
is simply added to the \fItimeVal\fR given
to the \fBclock add\fR command.  The result is interpreted as
a nominal number of seconds from the Epoch.
.PP
................................................................................
.CE
.PP
Adding and subtracting days and weeks is accomplished by converting
the given time to a calendar day and time of day in the appropriate
time zone and locale.  The requisite number of days (weeks are converted
to days by multiplying by seven) is added to the calendar day, and
the date and time are then converted back to a count of seconds from
the epoch time.  The \fBweekdays\fR keyword is similar to \fBdays\fR,
with the only difference that weekends - Saturdays and Sundays - are skipped.
.PP
Adding and subtracting a given number of days across the point that
the time changes at the start or end of summer time (Daylight Saving Time)
results in the \fIsame local time\fR on the day in question.  For
instance, the following code sets the value of \fBx\fR to \fB05:00:00\fR.
.PP
.CS

Changes to doc/package.n.

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
.QW latest .
.PP
When passed any other value as an argument, raise an invalid argument
error.
.PP
When an interpreter is created, its initial selection mode value is set to
.QW stable
unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
is set.  If that environment variable is defined (with any value) then
the initial (and permanent) selection mode value is set to
.QW latest .
.RE
.SH "VERSION NUMBERS"
.PP
Version numbers consist of one or more decimal numbers separated
by dots, such as 2 or 1.162 or 3.1.13.1.






|
|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
.QW latest .
.PP
When passed any other value as an argument, raise an invalid argument
error.
.PP
When an interpreter is created, its initial selection mode value is set to
.QW stable
unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR is set
(to any value) or the Tcl package itself is unstable. Otherwise
the initial (and permanent) selection mode value is set to
.QW latest .
.RE
.SH "VERSION NUMBERS"
.PP
Version numbers consist of one or more decimal numbers separated
by dots, such as 2 or 1.162 or 3.1.13.1.

Changes to doc/tcltest.n.

868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
...
886
887
888
889
890
891
892










893
894
895
896
897
898
899
harness are doing.
.RE
.TP
\fB\-verbose \fIlevel\fR
.
Sets the type of output verbosity desired to \fIlevel\fR,
a list of zero or more of the elements \fBbody\fR, \fBpass\fR,
\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR.  Default value
is
.QW "\fBbody error\fR" .
Levels are defined as:
.RS
.IP "body (\fBb\fR)"
Display the body of failed tests
.IP "pass (\fBp\fR)"
Print output when a test passes
................................................................................
.IP "start (\fBt\fR)"
Print output whenever a test starts
.IP "error (\fBe\fR)"
Print errorInfo and errorCode, if they exist, when a test return code
does not match its expected return code
.IP "line (\fBl\fR)"
Print source file line information of failed tests










.PP
The single letter abbreviations noted above are also recognized
so that
.QW "\fBconfigure \-verbose pt\fR"
is the same as
.QW "\fBconfigure \-verbose {pass start}\fR" .
.RE






|
|







 







>
>
>
>
>
>
>
>
>
>







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
...
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
harness are doing.
.RE
.TP
\fB\-verbose \fIlevel\fR
.
Sets the type of output verbosity desired to \fIlevel\fR,
a list of zero or more of the elements \fBbody\fR, \fBpass\fR,
\fBskip\fR, \fBstart\fR, \fBerror\fR, \fBline\fR, \fBmsec\fR and \fBusec\fR.
Default value is
.QW "\fBbody error\fR" .
Levels are defined as:
.RS
.IP "body (\fBb\fR)"
Display the body of failed tests
.IP "pass (\fBp\fR)"
Print output when a test passes
................................................................................
.IP "start (\fBt\fR)"
Print output whenever a test starts
.IP "error (\fBe\fR)"
Print errorInfo and errorCode, if they exist, when a test return code
does not match its expected return code
.IP "line (\fBl\fR)"
Print source file line information of failed tests
.IP "msec (\fBm\fR)"
Print each test's execution time in milliseconds
.IP "usec (\fBu\fR)"
Print each test's execution time in microseconds
.PP
Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as
indicative measures only. They do not tackle the problem of repeatibility which
should be considered in performance tests or benchmarks. To use these verbosity
levels to thoroughly track performance degradations, consider wrapping your
test bodies with \fBtime\fR commands.
.PP
The single letter abbreviations noted above are also recognized
so that
.QW "\fBconfigure \-verbose pt\fR"
is the same as
.QW "\fBconfigure \-verbose {pass start}\fR" .
.RE

Changes to doc/tell.n.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
.SH NAME
tell \- Return current access position for an open channel
.SH SYNOPSIS
\fBtell \fIchannelId\fR
.BE
.SH DESCRIPTION
.PP
Returns an integer string giving the current access position in
\fIchannelId\fR.  This value returned is a byte offset that can be passed to
\fBseek\fR in order to set the channel to a particular position.  Note
that this value is in terms of bytes, not characters like \fBread\fR.
The value returned is -1 for channels that do not support
seeking.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a






|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
.SH NAME
tell \- Return current access position for an open channel
.SH SYNOPSIS
\fBtell \fIchannelId\fR
.BE
.SH DESCRIPTION
.PP
Returns an integer giving the current access position in
\fIchannelId\fR.  This value returned is a byte offset that can be passed to
\fBseek\fR in order to set the channel to a particular position.  Note
that this value is in terms of bytes, not characters like \fBread\fR.
The value returned is -1 for channels that do not support
seeking.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a

Changes to generic/regc_lex.c.

252
253
254
255
256
257
258













259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    CHR(':'), CHR(']'), CHR(']')
};
static const chr brbacks[] = {	/* \s within brackets */
    CHR('['), CHR(':'),
    CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
    CHR(':'), CHR(']')
};













static const chr backw[] = {	/* \w */
    CHR('['), CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
static const chr backW[] = {	/* \W */
    CHR('['), CHR('^'), CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), CHR('_'), CHR(']')
};
static const chr brbackw[] = {	/* \w within brackets */
    CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), CHR('_')
};
 
/*
 - lexword - interpolate a bracket expression for word characters
 * Possibly ought to inquire whether there is a "word" character class.
 ^ static void lexword(struct vars *);
 */






>
>
>
>
>
>
>
>
>
>
>
>
>



|




|




|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    CHR(':'), CHR(']'), CHR(']')
};
static const chr brbacks[] = {	/* \s within brackets */
    CHR('['), CHR(':'),
    CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
    CHR(':'), CHR(']')
};

#define PUNCT_CONN \
	CHR('_'), \
	0x203f /* UNDERTIE */, \
	0x2040 /* CHARACTER TIE */,\
	0x2054 /* INVERTED UNDERTIE */,\
	0xfe33 /* PRESENTATION FORM FOR VERTICAL LOW LINE */, \
	0xfe34 /* PRESENTATION FORM FOR VERTICAL WAVY LOW LINE */, \
	0xfe4d /* DASHED LOW LINE */, \
	0xfe4e /* CENTRELINE LOW LINE */, \
	0xfe4f /* WAVY LOW LINE */, \
	0xff3f /* FULLWIDTH LOW LINE */

static const chr backw[] = {	/* \w */
    CHR('['), CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr backW[] = {	/* \W */
    CHR('['), CHR('^'), CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), PUNCT_CONN, CHR(']')
};
static const chr brbackw[] = {	/* \w within brackets */
    CHR('['), CHR(':'),
    CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
    CHR(':'), CHR(']'), PUNCT_CONN
};
 
/*
 - lexword - interpolate a bracket expression for word characters
 * Possibly ought to inquire whether there is a "word" character class.
 ^ static void lexword(struct vars *);
 */

Changes to generic/tcl.h.

1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
	void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);

/*
 * This flag controls whether the hash table stores the hash of a key, or
 * recalculates it. There should be no reason for turning this flag off as it
 * is completely binary and source compatible unless you directly access the
 * bucketPtr member of the Tcl_HashTableEntry structure. This member has been
 * removed and the space used to store the hash value.
 */

#ifndef TCL_HASH_KEY_STORE_HASH
#   define TCL_HASH_KEY_STORE_HASH 1
#endif

/*
 * Structure definition for an entry in a hash table. No-one outside Tcl
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
#if TCL_HASH_KEY_STORE_HASH
    void *hash;			/* Hash value, stored as pointer to ensure
				 * that the offsets of the fields in this
				 * structure are not changed. */
#else
    Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to first
				 * entry in this entry's chain: used for
				 * deleting the entry. */
#endif
    ClientData clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this






<
<
<
<
<
<
<
<
<
<
<
<









<



<
<
<
<
<







1160
1161
1162
1163
1164
1165
1166












1167
1168
1169
1170
1171
1172
1173
1174
1175

1176
1177
1178





1179
1180
1181
1182
1183
1184
1185
typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
	void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);













/*
 * Structure definition for an entry in a hash table. No-one outside Tcl
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */

    void *hash;			/* Hash value, stored as pointer to ensure
				 * that the offsets of the fields in this
				 * structure are not changed. */





    ClientData clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this

Changes to generic/tclAssembly.c.

862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
...
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
....
3980
3981
3982
3983
3984
3985
3986

3987
3988
3989
3990

3991
3992
3993
3994
3995
3996
3997
....
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
	    return codePtr;
	}

	/*
	 * Not valid, so free it and regenerate.
	 */

	FreeAssembleCodeInternalRep(objPtr);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(objPtr, &sourceLen);
................................................................................
    /*
     * Add a "done" instruction as the last instruction and change the object
     * into a ByteCode object. Ownership of the literal objects and aux data
     * items is given to the ByteCode object.
     */

    TclEmitOpcode(INST_DONE, &compEnv);
    TclInitByteCodeObj(objPtr, &compEnv);
    objPtr->typePtr = &assembleCodeType;
    TclFreeCompileEnv(&compEnv);

    /*
     * Record the local variable context to which the bytecode pertains
     */

    codePtr = objPtr->internalRep.twoPtrValue.ptr1;
    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }

    /*
     * Report on what the assembler did.
................................................................................
    /*
     * Unstack any catches that are deeper than the nesting level of the basic
     * block being entered.
     */

    while (catchDepth > bbPtr->catchDepth) {
	--catchDepth;

	range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
	range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
	catches[catchDepth] = NULL;
	catchIndices[catchDepth] = -1;

    }

    /*
     * Unstack any catches that don't match the basic block being entered,
     * either because they are no longer part of the context, or because the
     * context has changed from INCATCH to CAUGHT.
     */
................................................................................

static void
FreeAssembleCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;

    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }
    objPtr->typePtr = NULL;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






|







 







|
<






<







 







>
|
|
|
|
>







 







<
<
|
<
<









862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
...
887
888
889
890
891
892
893
894

895
896
897
898
899
900

901
902
903
904
905
906
907
....
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
....
4309
4310
4311
4312
4313
4314
4315


4316


4317
4318
4319
4320
4321
4322
4323
4324
4325
	    return codePtr;
	}

	/*
	 * Not valid, so free it and regenerate.
	 */

	TclFreeIntRep(objPtr);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(objPtr, &sourceLen);
................................................................................
    /*
     * Add a "done" instruction as the last instruction and change the object
     * into a ByteCode object. Ownership of the literal objects and aux data
     * items is given to the ByteCode object.
     */

    TclEmitOpcode(INST_DONE, &compEnv);
    codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);

    TclFreeCompileEnv(&compEnv);

    /*
     * Record the local variable context to which the bytecode pertains
     */


    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }

    /*
     * Report on what the assembler did.
................................................................................
    /*
     * Unstack any catches that are deeper than the nesting level of the basic
     * block being entered.
     */

    while (catchDepth > bbPtr->catchDepth) {
	--catchDepth;
	if (catches[catchDepth] != NULL) {
	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
	    range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
	    catches[catchDepth] = NULL;
	    catchIndices[catchDepth] = -1;
	}
    }

    /*
     * Unstack any catches that don't match the basic block being entered,
     * either because they are no longer part of the context, or because the
     * context has changed from INCATCH to CAUGHT.
     */
................................................................................

static void
FreeAssembleCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;



    TclReleaseByteCode(codePtr);


}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclBasic.c.

576
577
578
579
580
581
582

583
584
585

586
587
588
589
590
591
592
593
594
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */

    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
	iPtr->packagePrefer = PKG_PREFER_STABLE;
    } else {

	iPtr->packagePrefer = PKG_PREFER_LATEST;
    }

    iPtr->cmdCount = 0;
    TclInitLiteralTable(&iPtr->literalTable);
    iPtr->compileEpoch = 0;
    iPtr->compiledProcPtr = NULL;
    iPtr->resolverPtr = NULL;
    iPtr->evalFlags = 0;






>


|
>

<







576
577
578
579
580
581
582
583
584
585
586
587
588

589
590
591
592
593
594
595
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
	iPtr->packagePrefer = PKG_PREFER_STABLE;
    } else
#endif
	iPtr->packagePrefer = PKG_PREFER_LATEST;


    iPtr->cmdCount = 0;
    TclInitLiteralTable(&iPtr->literalTable);
    iPtr->compileEpoch = 0;
    iPtr->compiledProcPtr = NULL;
    iPtr->resolverPtr = NULL;
    iPtr->evalFlags = 0;

Changes to generic/tclCmdIL.c.

2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
    /*
     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first >= listLen) && (listLen > 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list doesn't contain element %s", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
		NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {






|







2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
    /*
     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first > listLen) && (listLen > 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"list doesn't contain element %s", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
		NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {

Changes to generic/tclCompCmdsGR.c.

1484
1485
1486
1487
1488
1489
1490



















1491
1492
1493
1494
1495
1496
1497
1498
1499
....
1507
1508
1509
1510
1511
1512
1513



1514
1515
1516
1517
1518
1519
1520
....
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
....
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571




1572
1573
1574
1575
1576
1577





1578
1579
1580
1581
1582
1583
1584
....
1621
1622
1623
1624
1625
1626
1627




1628
1629





1630
1631
1632
1633





1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
....
2962
2963
2964
2965
2966
2967
2968
2969

2970
2971
2972

2973
2974
2975
2976
2977
2978
2979
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
	return TCL_ERROR;
    }




















    if(idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
	idx2 = idx1-1;
    }

    /*
     * Work out what this [lreplace] is actually doing.
     */

    tmpObj = NULL;
................................................................................
	    idx2 = INDEX_END;
	    goto dropEnd;
	} else if (idx2 == INDEX_END) {
	    idx2 = idx1 - 1;
	    idx1 = 0;
	    goto dropEnd;
	} else {



	    if (idx1 > 0) {
		tmpObj = Tcl_NewIntObj(idx1);
		Tcl_IncrRefCount(tmpObj);
	    }
	    goto dropRange;
	}
    }
................................................................................
	idx2 = INDEX_END;
	goto replaceHead;
    } else if (idx2 == INDEX_END) {
	idx2 = idx1 - 1;
	idx1 = 0;
	goto replaceTail;
    } else {
	if (idx1 > 0 && idx2 > 0 && idx2 < idx1) {
	    idx2 = idx1 - 1;
	} else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) {
	    idx2 = idx1 - 1;
	}
	if (idx1 > 0) {
	    tmpObj = Tcl_NewIntObj(idx1);
	    Tcl_IncrRefCount(tmpObj);
	}
	goto replaceRange;
................................................................................

    /*
     * Issue instructions to perform the operations relating to configurations
     * that just drop. The only argument pushed on the stack is the list to
     * operate on.
     */

  dropAll:
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr,	"");
    goto done;

  dropEnd:
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
    TclEmitInt4(			idx2,			envPtr);
    goto done;

  dropRange:
    if (tmpObj != NULL) {




	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GT,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);





	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
................................................................................
    TclEmitInt4(			idx2,			envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    goto done;

  replaceRange:
    if (tmpObj != NULL) {




	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);





	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GT,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);





	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
		envPtr->codeStart + offset + 1);
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
................................................................................
    TclNewObj(tailPtr);
    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
	full = 1;
	lastTokenPtr = varTokenPtr;
    } else {
	full = 0;
	lastTokenPtr = varTokenPtr + n;
	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {

	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}

    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName+len-1) == ')') {
	    /*






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|







 







>
>
>







 







|
<
<







 







|












>
>
>
>



|


>
>
>
>
>







 







>
>
>
>


>
>
>
>
>

|


>
>
>
>
>



|







 







|
>



>







1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
....
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
....
1556
1557
1558
1559
1560
1561
1562
1563


1564
1565
1566
1567
1568
1569
1570
....
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
....
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
....
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * idx1, idx2 are now in canonical form:
     *
     *  - integer:	[0,len+1]
     *  - end index:    INDEX_END
     *  - -ive offset:  INDEX_END-[len-1,0]
     *  - +ive offset:  INDEX_END+1
     */

    /*
     * Compilation fails when one index is end-based but the other isn't.
     * Fixing this will require more bytecodes, but this is a workaround for
     * now. [Bug 47ac84309b]
     */

    if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
	return TCL_ERROR;
    }

    if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
	idx2 = idx1 - 1;
    }

    /*
     * Work out what this [lreplace] is actually doing.
     */

    tmpObj = NULL;
................................................................................
	    idx2 = INDEX_END;
	    goto dropEnd;
	} else if (idx2 == INDEX_END) {
	    idx2 = idx1 - 1;
	    idx1 = 0;
	    goto dropEnd;
	} else {
	    if (idx2 < idx1) {
		idx2 = idx1 - 1;
	    }
	    if (idx1 > 0) {
		tmpObj = Tcl_NewIntObj(idx1);
		Tcl_IncrRefCount(tmpObj);
	    }
	    goto dropRange;
	}
    }
................................................................................
	idx2 = INDEX_END;
	goto replaceHead;
    } else if (idx2 == INDEX_END) {
	idx2 = idx1 - 1;
	idx1 = 0;
	goto replaceTail;
    } else {
	if (idx2 < idx1) {


	    idx2 = idx1 - 1;
	}
	if (idx1 > 0) {
	    tmpObj = Tcl_NewIntObj(idx1);
	    Tcl_IncrRefCount(tmpObj);
	}
	goto replaceRange;
................................................................................

    /*
     * Issue instructions to perform the operations relating to configurations
     * that just drop. The only argument pushed on the stack is the list to
     * operate on.
     */

  dropAll:			/* This just ensures the arg is a list. */
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr,	"");
    goto done;

  dropEnd:
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
    TclEmitInt4(			idx2,			envPtr);
    goto done;

  dropRange:
    if (tmpObj != NULL) {
	/*
	 * Emit bytecode to check the list length.
	 */

	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GE,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);

	/*
	 * Emit an error if we've been given an empty list.
	 */

	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
................................................................................
    TclEmitInt4(			idx2,			envPtr);
    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    goto done;

  replaceRange:
    if (tmpObj != NULL) {
	/*
	 * Emit bytecode to check the list length.
	 */

	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);

	/*
	 * Check the list length vs idx1.
	 */

	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
	TclEmitOpcode(		INST_GE,			envPtr);
	offset = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);

	/*
	 * Emit an error if we've been given an empty list.
	 */

	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	offset2 = CurrentOffset(envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
		"list doesn't contain element %d", idx1), NULL), envPtr);
	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
		envPtr->codeStart + offset + 1);
	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
................................................................................
    TclNewObj(tailPtr);
    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
	full = 1;
	lastTokenPtr = varTokenPtr;
    } else {
	full = 0;
	lastTokenPtr = varTokenPtr + n;

	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName+len-1) == ')') {
	    /*

Changes to generic/tclCompCmdsSZ.c.

2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
{
    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
    int *fixupTargetArray;	/* Array of places for fixups to point at. */
    int fixupCount;		/* Number of places to fix up. */
    int contFixIndex;		/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */
    int contFixCount;		/* Number of continuation bodies pointing to
				 * the current (or next) real body. */
    int nextArmFixupIndex;






|







2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
{
    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
    unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
    int fixupCount;		/* Number of places to fix up. */
    int contFixIndex;		/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */
    int contFixCount;		/* Number of continuation bodies pointing to
				 * the current (or next) real body. */
    int nextArmFixupIndex;

Changes to generic/tclCompExpr.c.

560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
...
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
....
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205

2206
2207
2208
2209
2210
2211
2212
				 * aim is just a parse, or whether it will go
				 * on to compile the expression. Different
				 * optimizations are appropriate for the two
				 * scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    int nodesAvailable = 64;	/* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    int nodesUsed = 0;		/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
................................................................................

	/*
	 * Each pass through this loop adds up to one more OpNode. Allocate
	 * space for one if required.
	 */

	if (nodesUsed >= nodesAvailable) {
	    int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
................................................................................
    OpNode *nodes,
    int index,
    Tcl_Obj *const **litObjvPtr)
{
    CompileEnv *envPtr;
    ByteCode *byteCodePtr;
    int code;
    Tcl_Obj *byteCodeObj = Tcl_NewObj();
    NRE_callback *rootPtr = TOP_CB(interp);

    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
    Tcl_DecrRefCount(byteCodeObj);

    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * CompileExprTree --






|





|







 







|







 







<













<
|


<


<
>







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
...
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
....
2177
2178
2179
2180
2181
2182
2183

2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196

2197
2198
2199

2200
2201

2202
2203
2204
2205
2206
2207
2208
2209
				 * aim is just a parse, or whether it will go
				 * on to compile the expression. Different
				 * optimizations are appropriate for the two
				 * scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
................................................................................

	/*
	 * Each pass through this loop adds up to one more OpNode. Allocate
	 * space for one if required.
	 */

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
................................................................................
    OpNode *nodes,
    int index,
    Tcl_Obj *const **litObjvPtr)
{
    CompileEnv *envPtr;
    ByteCode *byteCodePtr;
    int code;

    NRE_callback *rootPtr = TOP_CB(interp);

    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);

    byteCodePtr = TclInitByteCode(envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);

    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);

    TclReleaseByteCode(byteCodePtr);
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * CompileExprTree --

Changes to generic/tclCompile.c.

657
658
659
660
661
662
663

664
665
666
667
668
669
670
...
672
673
674
675
676
677
678

679
680
681
682
683
684
685
...
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
...
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
...
989
990
991
992
993
994
995



















996
997
998
999
1000
1001
1002
1003
....
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
....
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
....
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
....
2693
2694
2695
2696
2697
2698
2699
2700
































2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
....
2748
2749
2750
2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
....
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
....
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866



























2867
2868
2869
2870
2871
2872
2873
....
3356
3357
3358
3359
3360
3361
3362
3363

3364
3365
3366

3367
3368
3369
3370
3371
3372
3373
3374


3375
3376
3377
3378
3379
3380
3381
3382

3383
3384
3385
3386
3387
3388
3389
    {NULL, 0, 0, 0, {OPERAND_NONE}}
};
 
/*
 * Prototypes for procedures defined later in this file:
 */


static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
................................................................................
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);

#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		StartExpanding(CompileEnv *envPtr);

................................................................................
     */

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/

    if (result == TCL_OK) {
	TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 2) {
	    TclPrintByteCodeObj(interp, objPtr);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */
    }
................................................................................

static void
FreeByteCodeInternalRep(
    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (codePtr->refCount-- <= 1) {
	TclCleanupByteCode(codePtr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCleanupByteCode --
 *
 *	This procedure does all the real work of freeing up a bytecode
 *	object's ByteCode structure. It's called only when the structure's
 *	reference count becomes zero.
 *
 * Results:
 *	None.
................................................................................
 *	Frees objPtr's bytecode internal representation and sets its type NULL
 *	Also releases its literals and frees its auxiliary data items.
 *
 *----------------------------------------------------------------------
 */

void



















TclCleanupByteCode(
    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    register Tcl_Obj **objArrayPtr, *objPtr;
................................................................................
 * CompileSubstObj --
 *
 *	Compile a Tcl value into ByteCode implementing its substitution, as
 *	governed by flags.
 *
 * Results:
 *	A (ByteCode *) is returned pointing to the resulting ByteCode.
 *	The caller must manage its refCount and arrange for a call to
 *	TclCleanupByteCode() when the last reference disappears.
 *
 * Side effects:
 *	The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
 *	ByteCode and governing flags value are kept in the internal rep for
 *	faster operations the next time CompileSubstObj is called on the same
 *	value.
 *
................................................................................
	if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    FreeSubstCodeInternalRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;
	int numBytes;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
	TclInitByteCodeObj(objPtr, &compEnv);
	objPtr->typePtr = &substCodeType;
	TclFreeCompileEnv(&compEnv);

	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
	objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
................................................................................

static void
FreeSubstCodeInternalRep(
    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (codePtr->refCount-- <= 1) {
	TclCleanupByteCode(codePtr);
    }
}

static void
ReleaseCmdWordData(
    ExtCmdLoc *eclPtr)
{
    int i;
................................................................................
 *	"ownership" (i.e., the pointers to) the Tcl objects and aux data items
 *	will be handed over to the new ByteCode structure from the CompileEnv
 *	structure.
 *
 *----------------------------------------------------------------------
 */

void
































TclInitByteCodeObj(
    Tcl_Obj *objPtr,		/* Points object that should be initialized,
				 * and whose string rep contains the source
				 * code. */
    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    register ByteCode *codePtr;
    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
    size_t auxDataArrayBytes, structureSize;
    register unsigned char *p;
................................................................................

    p = ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 1;

    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
    } else {
	codePtr->flags = 0;
    }
    codePtr->source = envPtr->source;
    codePtr->procPtr = envPtr->procPtr;
................................................................................
    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);

	if (objPtr == fetched) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
	    TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
	} else {
	    codePtr->objArrayPtr[i] = fetched;
	}
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
    } else {
................................................................................
    codePtr->structureSize = structureSize
	    - (sizeof(size_t) + sizeof(Tcl_Time));
    Tcl_GetTime(&codePtr->createTime);

    RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */

    /*
     * Free the old internal rep then convert the object to a bytecode object
     * by making its internal rep point to the just compiled ByteCode.
     */

    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
    objPtr->typePtr = &tclByteCodeType;

    /*
     * TIP #280. Associate the extended per-word line information with the
     * byte code object (internal rep), for use with the bc compiler.
     */

    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
	    &isNew), envPtr->extCmdMapPtr);
    envPtr->extCmdMapPtr = NULL;

    /* We've used up the CompileEnv.  Mark as uninitialized. */
    envPtr->iPtr = NULL;

    codePtr->localCachePtr = NULL;



























}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFindCompiledLocal --
 *
................................................................................

ExceptionRange *
TclGetInnermostExceptionRange(
    CompileEnv *envPtr,
    int returnCode,
    ExceptionAux **auxPtrPtr)
{
    int exnIdx = -1, i;


    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];


	if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
		(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
			rangePtr->codeOffset+rangePtr->numCodeBytes) &&
		(returnCode != TCL_CONTINUE ||
			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
	    exnIdx = i;
	}


    }
    if (exnIdx == -1) {
	return NULL;
    }
    if (auxPtrPtr) {
	*auxPtrPtr = &envPtr->exceptAuxArrayPtr[exnIdx];
    }
    return &envPtr->exceptArrayPtr[exnIdx];

}
 
/*
 * ---------------------------------------------------------------------
 *
 * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
 *






>







 







>







 







|







 







<
<
|
<





|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







 







<
<







 







|













|
<


<







 







<
<
|
<







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<







 







|
>







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>

<
|
>






<
|
>
>
|
<
|
|
<
<

<
>







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
...
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
...
965
966
967
968
969
970
971


972

973
974
975
976
977
978
979
980
981
982
983
984
985
...
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
....
1274
1275
1276
1277
1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
....
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325

1326
1327

1328
1329
1330
1331
1332
1333
1334
....
1363
1364
1365
1366
1367
1368
1369


1370

1371
1372
1373
1374
1375
1376
1377
....
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744



2745
2746
2747
2748
2749
2750
2751
....
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
....
2815
2816
2817
2818
2819
2820
2821
2822






















2823
2824
2825
2826
2827
2828
2829
....
2857
2858
2859
2860
2861
2862
2863









2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
....
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402

3403
3404
3405
3406
3407
3408
3409
3410

3411
3412
3413
3414

3415
3416


3417

3418
3419
3420
3421
3422
3423
3424
3425
    {NULL, 0, 0, 0, {OPERAND_NONE}}
};
 
/*
 * Prototypes for procedures defined later in this file:
 */

static void		CleanupByteCode(ByteCode *codePtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
................................................................................
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
static void		PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		StartExpanding(CompileEnv *envPtr);

................................................................................
     */

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/

    if (result == TCL_OK) {
	(void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv);
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 2) {
	    TclPrintByteCodeObj(interp, objPtr);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */
    }
................................................................................

static void
FreeByteCodeInternalRep(
    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;



    TclReleaseByteCode(codePtr);

}
 
/*
 *----------------------------------------------------------------------
 *
 * TclReleaseByteCode --
 *
 *	This procedure does all the real work of freeing up a bytecode
 *	object's ByteCode structure. It's called only when the structure's
 *	reference count becomes zero.
 *
 * Results:
 *	None.
................................................................................
 *	Frees objPtr's bytecode internal representation and sets its type NULL
 *	Also releases its literals and frees its auxiliary data items.
 *
 *----------------------------------------------------------------------
 */

void
TclPreserveByteCode(
    register ByteCode *codePtr)
{
    codePtr->refCount++;
}

void
TclReleaseByteCode(
    register ByteCode *codePtr)
{
    if (--codePtr->refCount) {
	return;
    }

    /* Just dropped to refcount==0.  Clean up. */
    CleanupByteCode(codePtr);
}

static void
CleanupByteCode(
    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    register Tcl_Obj **objArrayPtr, *objPtr;
................................................................................
 * CompileSubstObj --
 *
 *	Compile a Tcl value into ByteCode implementing its substitution, as
 *	governed by flags.
 *
 * Results:
 *	A (ByteCode *) is returned pointing to the resulting ByteCode.


 *
 * Side effects:
 *	The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
 *	ByteCode and governing flags value are kept in the internal rep for
 *	faster operations the next time CompileSubstObj is called on the same
 *	value.
 *
................................................................................
	if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;
	int numBytes;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
	codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);

	TclFreeCompileEnv(&compEnv);


	objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
................................................................................

static void
FreeSubstCodeInternalRep(
    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;



    TclReleaseByteCode(codePtr);

}

static void
ReleaseCmdWordData(
    ExtCmdLoc *eclPtr)
{
    int i;
................................................................................
 *	"ownership" (i.e., the pointers to) the Tcl objects and aux data items
 *	will be handed over to the new ByteCode structure from the CompileEnv
 *	structure.
 *
 *----------------------------------------------------------------------
 */

static void
PreventCycle(
    Tcl_Obj *objPtr,
    CompileEnv *envPtr)
{
    int i;

    for (i = 0;  i < envPtr->literalArrayNext; i++) {
	if (objPtr == TclFetchLiteral(envPtr, i)) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
    }
}

ByteCode *
TclInitByteCode(



    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    register ByteCode *codePtr;
    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
    size_t auxDataArrayBytes, structureSize;
    register unsigned char *p;
................................................................................

    p = ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
    } else {
	codePtr->flags = 0;
    }
    codePtr->source = envPtr->source;
    codePtr->procPtr = envPtr->procPtr;
................................................................................
    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);






















    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
    } else {
................................................................................
    codePtr->structureSize = structureSize
	    - (sizeof(size_t) + sizeof(Tcl_Time));
    Tcl_GetTime(&codePtr->createTime);

    RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */










    /*
     * TIP #280. Associate the extended per-word line information with the
     * byte code object (internal rep), for use with the bc compiler.
     */

    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
	    &isNew), envPtr->extCmdMapPtr);
    envPtr->extCmdMapPtr = NULL;

    /* We've used up the CompileEnv.  Mark as uninitialized. */
    envPtr->iPtr = NULL;

    codePtr->localCachePtr = NULL;
    return codePtr;
}

ByteCode *
TclInitByteCodeObj(
    Tcl_Obj *objPtr,		/* Points object that should be initialized,
				 * and whose string rep contains the source
				 * code. */
    const Tcl_ObjType *typePtr,
    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    ByteCode *codePtr;

    PreventCycle(objPtr, envPtr);

    codePtr = TclInitByteCode(envPtr);

    /*
     * Free the old internal rep then convert the object to a bytecode object
     * by making its internal rep point to the just compiled ByteCode.
     */

    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
    objPtr->typePtr = typePtr;
    return codePtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFindCompiledLocal --
 *
................................................................................

ExceptionRange *
TclGetInnermostExceptionRange(
    CompileEnv *envPtr,
    int returnCode,
    ExceptionAux **auxPtrPtr)
{
    int i = envPtr->exceptArrayNext;
    ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;


    while (i > 0) {
	rangePtr--; i--;

	if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
		(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
			rangePtr->codeOffset+rangePtr->numCodeBytes) &&
		(returnCode != TCL_CONTINUE ||
			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {


	    if (auxPtrPtr) {
		*auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
	    }

	    return rangePtr;
	}


    }

    return NULL;
}
 
/*
 * ---------------------------------------------------------------------
 *
 * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
 *

Changes to generic/tclCompile.h.

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
...
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
....
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
....
1115
1116
1117
1118
1119
1120
1121

1122
1123
1124
1125
1126
1127
1128
1129
1130
....
1153
1154
1155
1156
1157
1158
1159


1160
1161
1162
1163
1164
1165
1166
				 * expansion within the loop. Not meaningful
				 * if there are no open expansions between the
				 * looping level and the point of jump
				 * issue. */
    int numBreakTargets;	/* The number of [break]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    int *breakTargets;		/* The offsets of the INST_JUMP4 instructions
				 * issued by the [break]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numBreakTargets==0, this is NULL. */
    int allocBreakTargets;	/* The size of the breakTargets array. */
    int numContinueTargets;	/* The number of [continue]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    int *continueTargets;	/* The offsets of the INST_JUMP4 instructions
				 * issued by the [continue]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numContinueTargets==0, this is NULL. */
    int allocContinueTargets;	/* The size of the continueTargets array. */
} ExceptionAux;
................................................................................
    TCL_UNCONDITIONAL_JUMP,
    TCL_TRUE_JUMP,
    TCL_FALSE_JUMP
} TclJumpType;

typedef struct JumpFixup {
    TclJumpType jumpType;	/* Indicates the kind of jump. */
    int codeOffset;		/* Offset of the first byte of the one-byte
				 * forward jump's code. */
    int cmdIndex;		/* Index of the first command after the one
				 * for which the jump was emitted. Used to
				 * update the code offsets for subsequent
				 * commands if the two-byte jump at jumpPc
				 * must be replaced with a five-byte one. */
    int exceptIndex;		/* Index of the first range entry in the
................................................................................
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    int numBytes, CompileEnv *envPtr, int optimize);
................................................................................
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);

MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
................................................................................
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);


MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,






|









|







 







|







 







<







 







>
|
|







 







>
>







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
...
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
....
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074
1075
1076
....
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
....
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
				 * expansion within the loop. Not meaningful
				 * if there are no open expansions between the
				 * looping level and the point of jump
				 * issue. */
    int numBreakTargets;	/* The number of [break]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    unsigned int *breakTargets;	/* The offsets of the INST_JUMP4 instructions
				 * issued by the [break]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numBreakTargets==0, this is NULL. */
    int allocBreakTargets;	/* The size of the breakTargets array. */
    int numContinueTargets;	/* The number of [continue]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
				 * issued by the [continue]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numContinueTargets==0, this is NULL. */
    int allocContinueTargets;	/* The size of the continueTargets array. */
} ExceptionAux;
................................................................................
    TCL_UNCONDITIONAL_JUMP,
    TCL_TRUE_JUMP,
    TCL_FALSE_JUMP
} TclJumpType;

typedef struct JumpFixup {
    TclJumpType jumpType;	/* Indicates the kind of jump. */
    unsigned int codeOffset;	/* Offset of the first byte of the one-byte
				 * forward jump's code. */
    int cmdIndex;		/* Index of the first command after the one
				 * for which the jump was emitted. Used to
				 * update the code offsets for subsequent
				 * commands if the two-byte jump at jumpPc
				 * must be replaced with a five-byte one. */
    int exceptIndex;		/* Index of the first range entry in the
................................................................................
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
			    CompileEnv *envPtr);

MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    int numBytes, CompileEnv *envPtr, int optimize);
................................................................................
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
................................................................................
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,

Changes to generic/tclEncoding.c.

351
352
353
354
355
356
357

358
359
360
361
362
363
364
static void
DupEncodingIntRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);

}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingSearchPath --
 *






>







351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
static void
DupEncodingIntRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
    dupPtr->typePtr = &encodingType;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingSearchPath --
 *

Changes to generic/tclEnsemble.c.

3078
3079
3080
3081
3082
3083
3084





3085
3086
3087
3088
3089
3090
3091
....
3125
3126
3127
3128
3129
3130
3131
3132






3133
































3134
3135
3136
3137
3138
3139
3140
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int result, i;
    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;





    DefineLineInformation;

    if (cmdPtr->compileProc == NULL) {
	return TCL_ERROR;
    }

    /*
................................................................................
    parsePtr->tokenPtr = saveTokenPtr;

    /*
     * If our target failed to compile, revert any data from failed partial
     * compiles.  Note that envPtr->numCommands need not be checked because
     * we avoid compiling subcommands that recursively call TclCompileScript().
     */







    if (result != TCL_OK) {
































	envPtr->currStackDepth = savedStackDepth;
	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
#ifdef TCL_COMPILE_DEBUG
    } else {
	/*
	 * Confirm that the command compiler generated a single value on
	 * the stack as its result. This is only done in debugging mode,






>
>
>
>
>







 








>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
....
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int result, i;
    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
    int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
    int savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
    int savedExceptDepth = envPtr->exceptDepth;
#endif
    DefineLineInformation;

    if (cmdPtr->compileProc == NULL) {
	return TCL_ERROR;
    }

    /*
................................................................................
    parsePtr->tokenPtr = saveTokenPtr;

    /*
     * If our target failed to compile, revert any data from failed partial
     * compiles.  Note that envPtr->numCommands need not be checked because
     * we avoid compiling subcommands that recursively call TclCompileScript().
     */

#ifdef TCL_COMPILE_DEBUG
    if (envPtr->exceptDepth != savedExceptDepth) {
	Tcl_Panic("ExceptionRange Starts and Ends do not balance");
    }
#endif

    if (result != TCL_OK) {
	ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;

	for (i = 0; i < savedExceptArrayNext; i++) {
	    while (auxPtr->numBreakTargets > 0
		    && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
		    >= savedCodeNext) {
		auxPtr->numBreakTargets--;
	    }
	    while (auxPtr->numContinueTargets > 0
		    && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
		    >= savedCodeNext) {
		auxPtr->numContinueTargets--;
	    }
	    auxPtr++;
	}
	envPtr->exceptArrayNext = savedExceptArrayNext;

	if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
	    AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
	    AuxData *auxDataEnd = auxDataPtr;

	    auxDataPtr += savedAuxDataArrayNext;
	    auxDataEnd += envPtr->auxDataArrayNext;

	    while (auxDataPtr < auxDataEnd) {
		if (auxDataPtr->type->freeProc != NULL) {
		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
		}
		auxDataPtr++;
	    }
	    envPtr->auxDataArrayNext = savedAuxDataArrayNext;
	}
	envPtr->currStackDepth = savedStackDepth;
	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
#ifdef TCL_COMPILE_DEBUG
    } else {
	/*
	 * Confirm that the command compiler generated a single value on
	 * the stack as its result. This is only done in debugging mode,

Changes to generic/tclEvent.c.

1038
1039
1040
1041
1042
1043
1044



1045
1046
1047
1048
1049
1050
1051
	     * implementation of self-initializing locks.
	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */



#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for






>
>
>







1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
	     * implementation of self-initializing locks.
	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
	    TclpInitAllocCache();
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for

Changes to generic/tclExecute.c.

15
16
17
18
19
20
21

22
23
24
25
26
27
28
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
....
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
....
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
....
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
....
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
....
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
....
2110
2111
2112
2113
2114
2115
2116

2117
2118





2119
2120
2121
2122
2123
2124
2125
....
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318

2319
2320
2321
2322
2323
2324
2325
2326
....
5733
5734
5735
5736
5737
5738
5739










5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762

5763
5764
5765
5766
5767
5768
5769
....
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789

5790
5791
5792
5793
5794
5795
5796
....
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"

#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
................................................................................
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#define IEEE_FLOATING_POINT
#endif

/*
 * A mask (should be 2**n-1) that is used to work out when the bytecode engine
 * should call Tcl_AsyncReady() to see whether there is a signal that needs
 * handling.
 */

#ifndef ASYNC_CHECK_COUNT_MASK
#   define ASYNC_CHECK_COUNT_MASK	63
#endif /* !ASYNC_CHECK_COUNT_MASK */

/*
 * Boolean flag indicating whether the Tcl bytecode interpreter has been
 * initialized.
 */

static int execInitialized = 0;
................................................................................
 *----------------------------------------------------------------------
 *
 * CompileExprObj --
 *	Compile a Tcl expression value into ByteCode.
 *
 * Results:
 *	A (ByteCode *) is returned pointing to the resulting ByteCode.
 *	The caller must manage its refCount and arrange for a call to
 *	TclCleanupByteCode() when the last reference disappears.
 *
 * Side effects:
 *	The Tcl_ObjType of objPtr is changed to the "bytecode" type,
 *	and the ByteCode is kept in the internal rep (along with context
 *	data for checking validity) for faster operations the next time
 *	CompileExprObj is called on the same value.
 *
 *----------------------------------------------------------------------
 */

................................................................................

	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
	    FreeExprCodeInternalRep(objPtr);
	}
    }
    if (objPtr->typePtr != &exprCodeType) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

................................................................................
	/*
	 * Add a "done" instruction as the last instruction and change the
	 * object into a ByteCode object. Ownership of the literal objects and
	 * aux data items is given to the ByteCode object.
	 */

	TclEmitOpcode(INST_DONE, &compEnv);
	TclInitByteCodeObj(objPtr, &compEnv);
	objPtr->typePtr = &exprCodeType;
	TclFreeCompileEnv(&compEnv);
	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile == 2) {
	    TclPrintByteCodeObj(interp, objPtr);
................................................................................

static void
FreeExprCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (codePtr->refCount-- <= 1) {
	TclCleanupByteCode(codePtr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileObj --
 *
................................................................................
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;
    int size = sizeof(TEBCdata) - 1
	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
		* sizeof(void *);
    int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);

    codePtr->refCount++;

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately
     * above it a CmdFrame, then the catch stack, then the execution stack.
     *
................................................................................
     */

    /*
     * Constants: variables that do not change during the execution, used
     * sporadically: no special need for speed.
     */


    int instructionCount = 0;	/* Counter that is used to work out when to
				 * call Tcl_AsyncReady() */





    const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
    int traceInstructions;	/* Whether we are doing instruction-level
				 * tracing or not. */
#endif

    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
................................................................................

	break;
    }
  cleanup0:

    /*
     * Check for asynchronous handlers [Bug 746722]; we do the check every
     * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
     */


    if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
	DECACHE_STACK_INFO();
	if (TclAsyncReady(iPtr)) {
	    result = Tcl_AsyncInvoke(interp, result);
	    if (result == TCL_ERROR) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
................................................................................
	 * characters being replaced is the same as the number of characters
	 * in the string to be inserted.
	 */

	if (length3 - 1 == toIdx - fromIdx) {
	    unsigned char *bytes1, *bytes2;











	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_DuplicateObj(valuePtr);
		if (TclIsPureByteArray(objResultPtr)
			&& TclIsPureByteArray(value3Ptr)) {
		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));

		    /*
		     * Magic! Flush the info in the string internal rep that
		     * refers to the about-to-be-invalidated UTF-8 rep. This
		     * sets the 'allocated' field of the String structure to 0
		     * to indicate that a new buffer needs to be allocated.
		     * This is safe; we know we've got a tclStringTypePtr set
		     * at this point (post Tcl_GetUnicodeFromObj).
		     */

		    ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0;

		}
		Tcl_InvalidateStringRep(objResultPtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    } else {
		if (TclIsPureByteArray(valuePtr)
................................................................................
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));

		    /*
		     * Magic! Flush the info in the string internal rep that
		     * refers to the about-to-be-invalidated UTF-8 rep. This
		     * sets the 'allocated' field of the String structure to 0
		     * to indicate that a new buffer needs to be allocated.
		     * This is safe; we know we've got a tclStringTypePtr set
		     * at this point (post Tcl_GetUnicodeFromObj).
		     */

		    ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0;

		}
		Tcl_InvalidateStringRep(valuePtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	}
................................................................................
		    (unsigned) CURR_DEPTH, (unsigned) 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    if (codePtr->refCount-- <= 1) {
	TclCleanupByteCode(codePtr);
    }
    TclStackFree(interp, TD);	/* free my stack */

    return result;

    /*
     * INST_START_CMD failure case removed where it doesn't bother that much
     *






>







 







|
|
|


|
|
|







 







<
<


|







 







|







 







|
<

<







 







<
<
|
<







 







|







 







>
|
|
>
>
>
>
>







 







|


>
|







 







>
>
>
>
>
>
>
>
>
>












<
<
<
<
<
<
<
<
<
<
<
>







 







<
<
<
<
<
<
<
<
<
<
<
>







 







<
|
<







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
..
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
....
1495
1496
1497
1498
1499
1500
1501


1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
....
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
....
1561
1562
1563
1564
1565
1566
1567
1568

1569

1570
1571
1572
1573
1574
1575
1576
....
1636
1637
1638
1639
1640
1641
1642


1643

1644
1645
1646
1647
1648
1649
1650
....
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
....
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
....
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
....
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762











5763
5764
5765
5766
5767
5768
5769
5770
....
5773
5774
5775
5776
5777
5778
5779











5780
5781
5782
5783
5784
5785
5786
5787
....
8178
8179
8180
8181
8182
8183
8184

8185

8186
8187
8188
8189
8190
8191
8192
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"
#include "tclStringRep.h"
#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
................................................................................
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#define IEEE_FLOATING_POINT
#endif

/*
 * A counter that is used to work out when the bytecode engine should call
 * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
 * other expensive periodic operations.
 */

#ifndef ASYNC_CHECK_COUNT
#   define ASYNC_CHECK_COUNT	64
#endif /* !ASYNC_CHECK_COUNT */

/*
 * Boolean flag indicating whether the Tcl bytecode interpreter has been
 * initialized.
 */

static int execInitialized = 0;
................................................................................
 *----------------------------------------------------------------------
 *
 * CompileExprObj --
 *	Compile a Tcl expression value into ByteCode.
 *
 * Results:
 *	A (ByteCode *) is returned pointing to the resulting ByteCode.


 *
 * Side effects:
 *	The Tcl_ObjType of objPtr is changed to the "exprcode" type,
 *	and the ByteCode is kept in the internal rep (along with context
 *	data for checking validity) for faster operations the next time
 *	CompileExprObj is called on the same value.
 *
 *----------------------------------------------------------------------
 */

................................................................................

	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &exprCodeType) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

................................................................................
	/*
	 * Add a "done" instruction as the last instruction and change the
	 * object into a ByteCode object. Ownership of the literal objects and
	 * aux data items is given to the ByteCode object.
	 */

	TclEmitOpcode(INST_DONE, &compEnv);
	codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);

	TclFreeCompileEnv(&compEnv);

	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile == 2) {
	    TclPrintByteCodeObj(interp, objPtr);
................................................................................

static void
FreeExprCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;



    TclReleaseByteCode(codePtr);

}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileObj --
 *
................................................................................
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;
    int size = sizeof(TEBCdata) - 1
	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
		* sizeof(void *);
    int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);

    TclPreserveByteCode(codePtr);

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately
     * above it a CmdFrame, then the catch stack, then the execution stack.
     *
................................................................................
     */

    /*
     * Constants: variables that do not change during the execution, used
     * sporadically: no special need for speed.
     */

    unsigned interruptCounter = 1;
				/* Counter that is used to work out when to
				 * call Tcl_AsyncReady(). This must be 1
				 * initially so that we call the async-check
				 * stanza early, otherwise there are command
				 * sequences that can make the interpreter
				 * busy-loop without an opportunity to
				 * recognise an interrupt. */
    const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
    int traceInstructions;	/* Whether we are doing instruction-level
				 * tracing or not. */
#endif

    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
................................................................................

	break;
    }
  cleanup0:

    /*
     * Check for asynchronous handlers [Bug 746722]; we do the check every
     * ASYNC_CHECK_COUNT instructions.
     */

    if ((--interruptCounter) == 0) {
	interruptCounter = ASYNC_CHECK_COUNT;
	DECACHE_STACK_INFO();
	if (TclAsyncReady(iPtr)) {
	    result = Tcl_AsyncInvoke(interp, result);
	    if (result == TCL_ERROR) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
................................................................................
	 * characters being replaced is the same as the number of characters
	 * in the string to be inserted.
	 */

	if (length3 - 1 == toIdx - fromIdx) {
	    unsigned char *bytes1, *bytes2;

	    /*
	     * Flush the info in the string internal rep that refers to the
	     * about-to-be-invalidated UTF-8 rep. This indicates that a new
	     * buffer needs to be allocated, and assumes that the value is
	     * already of tclStringTypePtr type, which should be true provided
	     * we call it after Tcl_GetUnicodeFromObj.
	     */
#define MarkStringInternalRepForFlush(objPtr) \
	    (GET_STRING(objPtr)->allocated = 0)

	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_DuplicateObj(valuePtr);
		if (TclIsPureByteArray(objResultPtr)
			&& TclIsPureByteArray(value3Ptr)) {
		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));











		    MarkStringInternalRepForFlush(objResultPtr);
		}
		Tcl_InvalidateStringRep(objResultPtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    } else {
		if (TclIsPureByteArray(valuePtr)
................................................................................
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));











		    MarkStringInternalRepForFlush(valuePtr);
		}
		Tcl_InvalidateStringRep(valuePtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	}
................................................................................
		    (unsigned) CURR_DEPTH, (unsigned) 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;

    TclReleaseByteCode(codePtr);

    TclStackFree(interp, TD);	/* free my stack */

    return result;

    /*
     * INST_START_CMD failure case removed where it doesn't bother that much
     *

Changes to generic/tclHash.c.

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
...
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
...
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
....
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }
#endif
	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }
#endif
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
................................................................................
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
#if TCL_HASH_KEY_STORE_HASH
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
#else
    hPtr->bucketPtr = &tablePtr->buckets[index];
    hPtr->nextPtr = *hPtr->bucketPtr;
    *hPtr->bucketPtr = hPtr;
#endif
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.
     */

................................................................................
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
#if TCL_HASH_KEY_STORE_HASH
    int index;
#endif

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
................................................................................
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

#if TCL_HASH_KEY_STORE_HASH
    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
    } else {
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];
#else
    bucketPtr = entryPtr->bucketPtr;
#endif

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {
	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
................................................................................
    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
#if TCL_HASH_KEY_STORE_HASH
	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
	    } else {
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
#else
	    void *key = Tcl_GetHashKey(tablePtr, hPtr);

	    if (typePtr->hashKeyProc) {
		unsigned int hash;

		hash = typePtr->hashKeyProc(tablePtr, key);
		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		    index = RANDOM_INDEX(tablePtr, hash);
		} else {
		    index = hash & tablePtr->mask;
		}
	    } else {
		index = RANDOM_INDEX(tablePtr, key);
	    }

	    hPtr->bucketPtr = &tablePtr->buckets[index];
	    hPtr->nextPtr = *hPtr->bucketPtr;
	    *hPtr->bucketPtr = hPtr;
#endif
	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */







<



<










<



<







 







<



<
<
<
<
<







 







<

<







 







<








<
<
<







 







<








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







317
318
319
320
321
322
323

324
325
326

327
328
329
330
331
332
333
334
335
336

337
338
339

340
341
342
343
344
345
346
...
360
361
362
363
364
365
366

367
368
369





370
371
372
373
374
375
376
...
402
403
404
405
406
407
408

409

410
411
412
413
414
415
416
...
417
418
419
420
421
422
423

424
425
426
427
428
429
430
431



432
433
434
435
436
437
438
....
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056




















1057
1058
1059
1060
1061
1062
1063
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {

	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }

	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {

	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }

	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
................................................................................
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;

    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;





    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.
     */

................................................................................
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;

    int index;


    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
................................................................................
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }


    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
    } else {
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];




    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {
	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
................................................................................
    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;

	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
	    } else {
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;




















	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

Changes to generic/tclIOCmd.c.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
....
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378

1379
1380








1381
1382

1383
1384

1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
....
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
....
1481
1482
1483
1484
1485
1486
1487
1488

1489
1490
1491
1492
1493
1494
1495
....
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
....
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct AcceptCallback {
    char *script;		/* Script to invoke. */
    Tcl_Interp *interp;		/* Interpreter in which to run it. */
} AcceptCallback;

/*
 * Thread local storage used to maintain a per-thread stdout channel obj.
 * It must be per-thread because of std channel limitations.
 */
................................................................................
static Tcl_ThreadDataKey dataKey;

/*
 * Static functions for this file:
 */

static void		FinalizeIOCmdTSD(ClientData clientData);
static void		AcceptCallbackProc(ClientData callbackData,
			    Tcl_Channel chan, char *address, int port);
static int		ChanPendingObjCmd(ClientData unused,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ChanTruncateObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
................................................................................
    /*
     * Check if the callback is still valid; the interpreter may have gone
     * away, this is signalled by setting the interp field of the callback
     * data to NULL.
     */

    if (acceptCallbackPtr->interp != NULL) {
	char portBuf[TCL_INTEGER_SPACE];
	char *script = acceptCallbackPtr->script;
	Tcl_Interp *interp = acceptCallbackPtr->interp;

	int result;









	Tcl_Preserve(script);
	Tcl_Preserve(interp);


	TclFormatInt(portBuf, port);

	Tcl_RegisterChannel(interp, chan);

	/*
	 * Artificially bump the refcount to protect the channel from being
	 * deleted while the script is being evaluated.
	 */

	Tcl_RegisterChannel(NULL, chan);

	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
		" ", address, " ", portBuf, NULL);

	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	    Tcl_UnregisterChannel(interp, chan);
	}

	/*
	 * Decrement the artificially bumped refcount. After this it is not
	 * safe anymore to use "chan", because it may now be deleted.
	 */

	Tcl_UnregisterChannel(NULL, chan);

	Tcl_Release(interp);
	Tcl_Release(script);
    } else {
	/*
	 * The interpreter has been deleted, so there is no useful way to use
	 * the client socket - just close it.
	 */

	Tcl_Close(NULL, chan);
................................................................................
    AcceptCallback *acceptCallbackPtr = callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
    ckfree(acceptCallbackPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
................................................................................
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-server", NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
    };
    int optionIndex, a, server = 0, port, myport = 0, async = 0;
    const char *host, *script = NULL, *myaddr = NULL;

    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
................................................................................
	    server = 1;
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -server option", -1));
		return TCL_ERROR;
	    }
	    script = TclGetString(objv[a]);
	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */
................................................................................
    } else {
	goto wrongNumArgs;
    }

    if (server) {
	AcceptCallback *acceptCallbackPtr =
		ckalloc(sizeof(AcceptCallback));
	unsigned len = strlen(script) + 1;
	char *copyScript = ckalloc(len);

	memcpy(copyScript, script, len);

	acceptCallbackPtr->script = copyScript;
	acceptCallbackPtr->interp = interp;
	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
		acceptCallbackPtr);
	if (chan == NULL) {
	    ckfree(copyScript);
	    ckfree(acceptCallbackPtr);
	    return TCL_ERROR;
	}

	/*
	 * Register with the interpreter to let us know when the interpreter
	 * is deleted (by having the callback set the interp field of the






|







 







|
<







 







<
<

>
|

>
>
>
>
>
>
>
>
|
<
>

<
>









|
|
>













<







 







|







 







|
>







 







|







 







<
<

<
>
|




|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
....
1368
1369
1370
1371
1372
1373
1374


1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387

1388
1389

1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415

1416
1417
1418
1419
1420
1421
1422
....
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
....
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
....
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
....
1592
1593
1594
1595
1596
1597
1598


1599

1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct AcceptCallback {
    Tcl_Obj *script;		/* Script to invoke. */
    Tcl_Interp *interp;		/* Interpreter in which to run it. */
} AcceptCallback;

/*
 * Thread local storage used to maintain a per-thread stdout channel obj.
 * It must be per-thread because of std channel limitations.
 */
................................................................................
static Tcl_ThreadDataKey dataKey;

/*
 * Static functions for this file:
 */

static void		FinalizeIOCmdTSD(ClientData clientData);
static Tcl_TcpAcceptProc AcceptCallbackProc;

static int		ChanPendingObjCmd(ClientData unused,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ChanTruncateObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
................................................................................
    /*
     * Check if the callback is still valid; the interpreter may have gone
     * away, this is signalled by setting the interp field of the callback
     * data to NULL.
     */

    if (acceptCallbackPtr->interp != NULL) {


	Tcl_Interp *interp = acceptCallbackPtr->interp;
	Tcl_Obj *script, *objv[2];
	int result = TCL_OK;

	objv[0] = acceptCallbackPtr->script;
	objv[1] = Tcl_NewListObj(3, NULL);
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(
		Tcl_GetChannelName(chan), -1));
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1));
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewIntObj(port));

	script = Tcl_ConcatObj(2, objv);
	Tcl_IncrRefCount(script);

	Tcl_DecrRefCount(objv[1]);


	Tcl_Preserve(interp);
	Tcl_RegisterChannel(interp, chan);

	/*
	 * Artificially bump the refcount to protect the channel from being
	 * deleted while the script is being evaluated.
	 */

	Tcl_RegisterChannel(NULL, chan);

	result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(script);

	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	    Tcl_UnregisterChannel(interp, chan);
	}

	/*
	 * Decrement the artificially bumped refcount. After this it is not
	 * safe anymore to use "chan", because it may now be deleted.
	 */

	Tcl_UnregisterChannel(NULL, chan);

	Tcl_Release(interp);

    } else {
	/*
	 * The interpreter has been deleted, so there is no useful way to use
	 * the client socket - just close it.
	 */

	Tcl_Close(NULL, chan);
................................................................................
    AcceptCallback *acceptCallbackPtr = callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    ckfree(acceptCallbackPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
................................................................................
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-server", NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
    };
    int optionIndex, a, server = 0, port, myport = 0, async = 0;
    const char *host, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
................................................................................
	    server = 1;
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -server option", -1));
		return TCL_ERROR;
	    }
	    script = objv[a];
	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */
................................................................................
    } else {
	goto wrongNumArgs;
    }

    if (server) {
	AcceptCallback *acceptCallbackPtr =
		ckalloc(sizeof(AcceptCallback));




	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;
	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
		acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    ckfree(acceptCallbackPtr);
	    return TCL_ERROR;
	}

	/*
	 * Register with the interpreter to let us know when the interpreter
	 * is deleted (by having the callback set the interp field of the

Changes to generic/tclInt.h.

3129
3130
3131
3132
3133
3134
3135

3136
3137
3138
3139
3140
3141
3142
....
4080
4081
4082
4083
4084
4085
4086

4087
4088
4089
4090
4091
4092
4093
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);

MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
................................................................................
MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);

MODULE_SCOPE void	TclpFreeAllocCache(void *);

/*
 * These macros need to be kept in sync with the code of TclThreadAllocObj()
 * and TclThreadFreeObj().
 *
 * Note that the optimiser should resolve the case (interp==NULL) at compile






>







 







>







3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
....
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
................................................................................
MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclpInitAllocCache(void);
MODULE_SCOPE void	TclpFreeAllocCache(void *);

/*
 * These macros need to be kept in sync with the code of TclThreadAllocObj()
 * and TclThreadFreeObj().
 *
 * Note that the optimiser should resolve the case (interp==NULL) at compile

Changes to generic/tclNamesp.c.

1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
....
1117
1118
1119
1120
1121
1122
1123



1124
1125
1126
1127
1128






1129
1130
1131

1132




1133




1134
1135
1136
1137
1138
1139
1140
....
1171
1172
1173
1174
1175
1176
1177
1178



1179
1180

1181
1182
1183






1184
1185
1186

1187




1188

1189


1190
1191






1192
1193
1194

1195




1196



1197
1198
1199
1200
1201
1202
1203
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Namespace *childNsPtr;
    Tcl_Command cmd;
    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */
................................................................................

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the



     * command table.
     *
     * Don't optimize to Tcl_NextHashEntry() because of traces.
     */







    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {

	cmd = Tcl_GetHashValue(entryPtr);




	Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);




    }
    Tcl_DeleteHashTable(&nsPtr->cmdTable);
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Remove the namespace from its parent's child hashtable.
     */
................................................................................
    }

    /*
     * Delete all the child namespaces.
     *
     * BE CAREFUL: When each child is deleted, it will divorce itself from its
     * parent. You can't traverse a hash table properly if its elements are
     * being deleted. We use only the Tcl_FirstHashEntry function to be safe.



     *
     * Don't optimize to Tcl_NextHashEntry() because of traces.

     */

#ifndef BREAK_NAMESPACE_COMPAT






    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entryPtr != NULL;
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {

	childNsPtr = Tcl_GetHashValue(entryPtr);




	Tcl_DeleteNamespace(childNsPtr);

    }


#else
    if (nsPtr->childTablePtr != NULL) {






	for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		entryPtr != NULL;
		entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {

	    childNsPtr = Tcl_GetHashValue(entryPtr);




	    Tcl_DeleteNamespace(childNsPtr);



	}
    }
#endif

    /*
     * Free the namespace's export pattern array.
     */






<
<







 







>
>
>
|
|
<
<

>
>
>
>
>
>
|
|
<
>
|
>
>
>
>
|
>
>
>
>







 







|
>
>
>

<
>



>
>
>
>
>
>
|
|
<
>
|
>
>
>
>
|
>
|
>
>


>
>
>
>
>
>
|
|
<
>
|
>
>
>
>
|
>
>
>







1101
1102
1103
1104
1105
1106
1107


1108
1109
1110
1111
1112
1113
1114
....
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126


1127
1128
1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
....
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;


    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */
................................................................................

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */



    while (nsPtr->cmdTable.numEntries > 0) {
	int length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;

		entryPtr = Tcl_NextHashEntry(&search)) {
	    cmds[i] = Tcl_GetHashValue(entryPtr);
	    cmds[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmds[i]);
	    TclCleanupCommandMacro(cmds[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, cmds);
    }
    Tcl_DeleteHashTable(&nsPtr->cmdTable);
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Remove the namespace from its parent's child hashtable.
     */
................................................................................
    }

    /*
     * Delete all the child namespaces.
     *
     * BE CAREFUL: When each child is deleted, it will divorce itself from its
     * parent. You can't traverse a hash table properly if its elements are
     * being deleted.  Because of traces (and the desire to avoid the
     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * namespaces.
     *

     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;

		entryPtr = Tcl_NextHashEntry(&search)) {
	    children[i] = Tcl_GetHashValue(entryPtr);
	    children[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
	    TclNsDecrRefCount(children[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, children);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	while (nsPtr->childTablePtr->numEntries > 0) {
	    int length = nsPtr->childTablePtr->numEntries;
	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		    entryPtr != NULL;

		    entryPtr = Tcl_NextHashEntry(&search)) {
		children[i] = Tcl_GetHashValue(entryPtr);
		children[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
		TclNsDecrRefCount(children[i]);
	    }
	    TclStackFree((Tcl_Interp *) iPtr, children);
	}
    }
#endif

    /*
     * Free the namespace's export pattern array.
     */

Changes to generic/tclObj.c.

316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
....
4172
4173
4174
4175
4176
4177
4178

4179
4180
4181
4182
4183
4184
4185
4186
 * own purposes.
 *
 * TRICKY POINT! Some extensions update this structure! (Notably, these
 * include TclBlend and TCom). This is highly ill-advised on their part, but
 * does allow them to delete a command when references to it are gone, which
 * is fragile but useful given their somewhat-OO style. Because of this, this
 * structure MUST NOT be const so that the C compiler puts the data in
 * writable memory. [Bug 2558422]
 * TODO: Provide a better API for those extensions so that they can coexist...
 */

Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
................................................................................
    }

    /*
     * OK, must create a new internal representation (or fail) as any cache we
     * had is invalid one way or another.
     */


    if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
        return NULL;
    }
    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}
 
/*






|







 







>
|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
....
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
 * own purposes.
 *
 * TRICKY POINT! Some extensions update this structure! (Notably, these
 * include TclBlend and TCom). This is highly ill-advised on their part, but
 * does allow them to delete a command when references to it are gone, which
 * is fragile but useful given their somewhat-OO style. Because of this, this
 * structure MUST NOT be const so that the C compiler puts the data in
 * writable memory. [Bug 2558422] [Bug 07d13d99b0a9]
 * TODO: Provide a better API for those extensions so that they can coexist...
 */

Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
................................................................................
    }

    /*
     * OK, must create a new internal representation (or fail) as any cache we
     * had is invalid one way or another.
     */

    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
        return NULL;
    }
    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}
 
/*

Changes to generic/tclProc.c.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
...
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
...
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822




823
824






825
826
827

828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852

853
854
855
856
857
858
859



860
861

862
863


864

865
866
867
868
869
870
871
872
873
874
875
876
877


878
879

880
881
882
883
884
885



886
887
888
889


890
891

892
893

894
895
896
897
898

899
900
901
902
903
904
905
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
};

/*
 * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
 * encoding the type of level reference in ptr and the actual parsed out
 * offset in ptr2.
 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
    "levelReference",
................................................................................
 *	Given a description of a procedure frame, such as the first argument
 *	to an "uplevel" or "upvar" command, locate the call frame for the
 *	appropriate level of procedure.
 *
 * Results:
 *	The return value is -1 if an error occurred in finding the frame (in
 *	this case an error message is left in the interp's result). 1 is
 *	returned if objPtr was either a number or a number preceded by "#" and
 *	it specified a valid frame. 0 is returned if objPtr isn't one of the
 *	two things above (in this case, the lookup acts as if objPtr were
 *	"1"). The variable pointed to by framePtrPtr is filled in with the
 *	address of the desired frame (unless an error occurs, in which case it
 *	isn't modified).
 *
 * Side effects:
................................................................................
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    CallFrame *framePtr;
    const char *name;

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 1;
    curLevel = iPtr->varFramePtr->level;
    if (objPtr == NULL) {
	name = "1";
	goto haveLevel1;
    }





    name = TclGetString(objPtr);






    if (objPtr->typePtr == &levelReferenceType) {
	if (objPtr->internalRep.twoPtrValue.ptr1) {
	    level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);

	} else {
	    level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
	}
	if (level < 0) {
	    goto levelError;
	}
	/* TODO: Consider skipping the typePtr checks */
    } else if (objPtr->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
	    || objPtr->typePtr == &tclWideIntType
#endif
	    ) {
	if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
	    goto levelError;
	}
	level = curLevel - level;
    } else if (*name == '#') {
	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
	    goto levelError;
	}

	/*
	 * Cache for future reference.
	 */


	TclFreeIntRep(objPtr);
	objPtr->typePtr = &levelReferenceType;
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
	    return -1;



	}


	/*
	 * Cache for future reference.


	 */


	TclFreeIntRep(objPtr);
	objPtr->typePtr = &levelReferenceType;
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
	level = curLevel - level;
    } else {
	/*
	 * Don't cache as the object *isn't* a level reference (might even be
	 * NULL...)
	 */

    haveLevel1:


	level = curLevel - 1;
	result = 0;

    }

    /*
     * Figure out which frame to use, and return it to the caller.
     */




    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
	    framePtr = framePtr->callerVarPtr) {
	if (framePtr->level == level) {
	    break;


	}
    }

    if (framePtr == NULL) {
	goto levelError;

    }
    *framePtrPtr = framePtr;
    return result;

  levelError:

    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}
 
/*
 *----------------------------------------------------------------------






|
|
<







 







|







 







<
|





|

<
<
<
|
>
>
>
>

<
>
>
>
>
>
>
|
|
<
>
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
>
|
|
|
<
<
<
<
>
>
>
|
<
>
|
<
>
>
|
>
|
<
<
<
<
<
<
<
<
<
<
|
<
>
>

<
>

<
<
<
<
<
>
>
>
|
|
|
<
>
>
|
|
>
|
<
>
|
<
<
|
<
>







65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
...
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
...
802
803
804
805
806
807
808

809
810
811
812
813
814
815
816



817
818
819
820
821
822

823
824
825
826
827
828
829
830

831
832






833








834








835
836
837
838




839
840
841
842

843
844

845
846
847
848
849










850

851
852
853

854
855





856
857
858
859
860
861

862
863
864
865
866
867

868
869


870

871
872
873
874
875
876
877
878
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
};

/*
 * The [upvar]/[uplevel] level reference type. Uses the longValue field
 * to remember the integer value of a parsed #<integer> format.

 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
    "levelReference",
................................................................................
 *	Given a description of a procedure frame, such as the first argument
 *	to an "uplevel" or "upvar" command, locate the call frame for the
 *	appropriate level of procedure.
 *
 * Results:
 *	The return value is -1 if an error occurred in finding the frame (in
 *	this case an error message is left in the interp's result). 1 is
 *	returned if objPtr was either an int or an int preceded by "#" and
 *	it specified a valid frame. 0 is returned if objPtr isn't one of the
 *	two things above (in this case, the lookup acts as if objPtr were
 *	"1"). The variable pointed to by framePtrPtr is filled in with the
 *	address of the desired frame (unless an error occurs, in which case it
 *	isn't modified).
 *
 * Side effects:
................................................................................
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;

    const char *name = NULL;

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 0;
    curLevel = iPtr->varFramePtr->level;




    /*
     * Check for integer first, since that has potential to spare us
     * a generation of a stringrep.
     */


    if (objPtr == NULL) {
	/* Do nothing */
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
	    && (level >= 0)) {
	level = curLevel - level;
	result = 1;
    } else if (objPtr->typePtr == &levelReferenceType) {
	level = (int) objPtr->internalRep.longValue;

	result = 1;
    } else {






	name = TclGetString(objPtr);








	if (name[0] == '#') {








	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &levelReferenceType;
		objPtr->internalRep.longValue = level;




		result = 1;
	    } else {
		result = -1;
	    }

	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
	    /*

	     * If this were an integer, we'd have succeeded already.
	     * Docs say we have to treat this as a 'bad level'  error.
	     */
	    result = -1;
	}










    }


    if (result == 0) {
	level = curLevel - 1;

	name = "1";
    }





    if (result != -1) {
	if (level >= 0) {
	    CallFrame *framePtr;
	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
		    framePtr = framePtr->callerVarPtr) {
		if (framePtr->level == level) {

		    *framePtrPtr = framePtr;
		    return result;
		}
	    }
	}
	if (name == NULL) {

	    name = TclGetString(objPtr);
	}


    }


    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}
 
/*
 *----------------------------------------------------------------------

Changes to generic/tclStringObj.c.

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
..
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
...
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
....
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
....
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
....
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
....
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
....
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
....
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
....
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
....
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
 * This is an escape hatch in case the changes have some unexpected unwelcome
 * impact on performance. If things go well, this mechanism can go away when
 * post-8.6 development begins.
 */

#define COMPAT 0


/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
................................................................................
const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny		/* setFromAnyProc */
};

/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the Unicode and UTF string to enable growing and shrinking of the UTF and
 * Unicode reps of the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * characters (same of UTF and Unicode!) once that value has been computed.
 *
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct String {
    int numChars;		/* The number of chars in the string. -1 means
				 * this value has not been calculated. >= 0
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_MAXCHARS \
	(int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
	(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		STRING_MAXCHARS); \
    }
#define stringAttemptAlloc(numChars) \
	(String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
#define stringAlloc(numChars) \
	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \
	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
	((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
 
/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
 *
................................................................................
    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;

#if COMPAT
	if (numChars < objPtr->length) {
	    /*
	     * Since we've just computed the number of chars, and not all UTF
	     * chars are 1-byte long, go ahead and populate the unicode
	     * string.
	     */

	    FillUnicodeRep(objPtr);
	}
#endif
    }
    return numChars;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    /*
     * If objPtr has a valid Unicode rep, then append the "unicode" to the
     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
     * objPtr's string rep.
     */

    if (stringPtr->hasUnicode
#if COMPAT
		&& stringPtr->numChars > 0
#endif
	    ) {
	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}
 
/*
................................................................................
    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    if (stringPtr->hasUnicode
#if COMPAT
		&& stringPtr->numChars > 0
#endif
	    ) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (appendObjPtr->typePtr == &tclStringType) {
	    Tcl_UniChar *unicode =
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
................................................................................
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0
#if COMPAT
		&& appendNumChars == length
#endif
	    ) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }

#if COMPAT
    /*
     * Invalidate the unicode rep.
     */

    stringPtr->hasUnicode = 0;
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUnicodeRep --
 *
................................................................................
				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;

#if COMPAT==0
    if (srcStringPtr->numChars == -1) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

................................................................................
    /*
     * Tricky point: the string value was copied by generic object management
     * code, so it doesn't contain any extra bytes that might exist in the
     * source object.
     */

    copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
#else /* COMPAT!=0 */
    /*
     * If the src obj is a string of 1-byte Utf chars, then copy the string
     * rep of the source object and create an "empty" Unicode internal rep for
     * the new object. Otherwise, copy Unicode internal rep, and invalidate
     * the string rep of the new object.
     */

    if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
	/*
	 * Copy the full allocation for the Unicode buffer.
	 */

	copyStringPtr = stringAlloc(srcStringPtr->maxChars);
	copyStringPtr->maxChars = srcStringPtr->maxChars;
	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
		srcStringPtr->numChars * sizeof(Tcl_UniChar));
	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
	copyStringPtr->allocated = 0;
    } else {
	copyStringPtr = stringAlloc(0);
	copyStringPtr->unicode[0] = 0;
	copyStringPtr->maxChars = 0;

	/*
	 * Tricky point: the string value was copied by generic object
	 * management code, so it doesn't contain any extra bytes that might
	 * exist in the source object.
	 */

	copyStringPtr->allocated = copyPtr->length;
    }
    copyStringPtr->numChars = srcStringPtr->numChars;
    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
#endif /* COMPAT==0 */

    SET_STRING(copyPtr, copyStringPtr);
    copyPtr->typePtr = &tclStringType;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    int numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst, buf[TCL_UTF_MAX];
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
................................................................................

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars && size >= 0; i++) {
	size += Tcl_UniCharToUtf((int) unicode[i], buf);
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    /*
     * Grow space if needed.






<
<
<
<
<
<
<
<
<
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<







 







|
<
<
<
<







 







|
<
<
<
<







 







|
<
<
<
<







 







<
<
<
<
<
<
<
<







 







<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|







32
33
34
35
36
37
38









39
40
41
42
43
44
45
46
..
77
78
79
80
81
82
83






















































84
85
86
87
88
89
90
...
432
433
434
435
436
437
438












439
440
441
442
443
444
445
....
1148
1149
1150
1151
1152
1153
1154
1155




1156
1157
1158
1159
1160
1161
1162
....
1252
1253
1254
1255
1256
1257
1258
1259




1260
1261
1262
1263
1264
1265
1266
....
1285
1286
1287
1288
1289
1290
1291
1292




1293
1294
1295
1296
1297
1298
1299
....
1409
1410
1411
1412
1413
1414
1415








1416
1417
1418
1419
1420
1421
1422
....
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
....
2868
2869
2870
2871
2872
2873
2874



































2875
2876
2877
2878
2879
2880
2881
....
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
....
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"









#include "tclStringRep.h"

/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
................................................................................
const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny		/* setFromAnyProc */
};






















































 
/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
 *
................................................................................
    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;












    }
    return numChars;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    /*
     * If objPtr has a valid Unicode rep, then append the "unicode" to the
     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
     * objPtr's string rep.
     */

    if (stringPtr->hasUnicode) {




	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}
 
/*
................................................................................
    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    if (stringPtr->hasUnicode) {




	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (appendObjPtr->typePtr == &tclStringType) {
	    Tcl_UniChar *unicode =
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
................................................................................
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {




	stringPtr->numChars = numChars + appendNumChars;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }








}
 
/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUnicodeRep --
 *
................................................................................
				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;


    if (srcStringPtr->numChars == -1) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

................................................................................
    /*
     * Tricky point: the string value was copied by generic object management
     * code, so it doesn't contain any extra bytes that might exist in the
     * source object.
     */

    copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;




































    SET_STRING(copyPtr, copyStringPtr);
    copyPtr->typePtr = &tclStringType;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    int numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
................................................................................

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars && size >= 0; i++) {
	size += TclUtfCount(unicode[i]);
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    /*
     * Grow space if needed.

Added generic/tclStringRep.h.


































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
/*
 * tclStringRep.h --
 *
 *	This file contains the definition of the Unicode string internal
 *	representation and macros to access it.
 *
 *	A Unicode string is an internationalized string. Conceptually, a
 *	Unicode string is an array of 16-bit quantities organized as a
 *	sequence of properly formed UTF-8 characters. There is a one-to-one
 *	map between Unicode and UTF characters. Because Unicode characters
 *	have a fixed width, operations such as indexing operate on Unicode
 *	data. The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
 *	is explicitly called).
 *
 *	The String object type stores one or both formats. The default
 *	behavior is to store UTF. Once Unicode is calculated by a function, it
 *	is stored in the internal rep for future access (without an additional
 *	O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly
 *	reallocating the space for the string or Unicode representation, we
 *	allocate double the space for the string or Unicode and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 
/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the Unicode and UTF string to enable growing and shrinking of the UTF and
 * Unicode reps of the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * characters (same of UTF and Unicode!) once that value has been computed.
 *
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct String {
    int numChars;		/* The number of chars in the string. -1 means
				 * this value has not been calculated. >= 0
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_MAXCHARS \
    (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
    (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    do {								\
	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		      STRING_MAXCHARS);					\
	}								\
    } while (0)
#define stringAttemptAlloc(numChars) \
    (String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) ckalloc((unsigned) STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclTest.c.

318
319
320
321
322
323
324



325
326
327
328
329
330
331
...
648
649
650
651
652
653
654


655
656
657
658
659
660
661
....
3786
3787
3788
3789
3790
3791
3792






























3793
3794
3795
3796
3797
3798
3799
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarnameObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,



			    Tcl_Obj *const objv[]);
static int		TestregexpObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestreturnObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,


	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
	    NULL, NULL);
#ifndef TCL_NO_DEPRECATED
    Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
................................................................................
    parse.commentSize = 0;
    parse.commandStart = script + parse.tokenPtr->size;
    parse.commandSize = 0;
    PrintParse(interp, &parse);
    Tcl_FreeParse(&parse);
    return TCL_OK;
}






























 
/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --
 *
 *	This procedure implements the "testregexp" command. It is used to give






>
>
>







 







>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
...
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
....
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarnameObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestpreferstableObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestregexpObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestreturnObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
	    NULL, NULL);
#ifndef TCL_NO_DEPRECATED
    Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
................................................................................
    parse.commentSize = 0;
    parse.commandStart = script + parse.tokenPtr->size;
    parse.commandSize = 0;
    PrintParse(interp, &parse);
    Tcl_FreeParse(&parse);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestpreferstableObjCmd --
 *
 *	This procedure implements the "testpreferstable" command.  It is
 *	used for being able to test the "package" command even when the
 *  environment variable TCL_PKG_PREFER_LATEST is set in your environment.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpreferstableObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    iPtr->packagePrefer = PKG_PREFER_STABLE;
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --
 *
 *	This procedure implements the "testregexp" command. It is used to give

Changes to generic/tclUtf.c.

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
...
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
...
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
#endif
#if TCL_UTF_MAX > 5
    6,6,6,6
#else
    1,1,1,1
#endif
};

/*
 * Functions used only in this module.
 */

static int		UtfCount(int ch);
 
/*
 *---------------------------------------------------------------------------
 *
 * UtfCount --
 *
 *	Find the number of bytes in the Utf character "ch".
 *
 * Results:
 *	The return values is the number of bytes in the Utf character "ch".
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

INLINE static int
UtfCount(
    int ch)			/* The Tcl_UniChar whose size is returned. */
{
    if ((ch > 0) && (ch < UNICODE_SELF)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
................................................................................
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

INLINE int
Tcl_UniCharToUtf(
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most TCL_UTF_MAX bytes). */
................................................................................

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the upper case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < UtfCount(upChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(upChar, dst);
	}
	src += bytes;
    }
................................................................................

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the lower case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < UtfCount(lowChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }
................................................................................

    src = dst = str;

    if (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	titleChar = Tcl_UniCharToTitle(ch);

	if (bytes < UtfCount(titleChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(titleChar, dst);
	}
	src += bytes;
    }
    while (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	lowChar = Tcl_UniCharToLower(ch);

	if (bytes < UtfCount(lowChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }






<
<
<
<
<
<




|












|
|







 







|







 







|







 







|







 







|











|







80
81
82
83
84
85
86






87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
...
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
...
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
#endif
#if TCL_UTF_MAX > 5
    6,6,6,6
#else
    1,1,1,1
#endif
};






 
/*
 *---------------------------------------------------------------------------
 *
 * TclUtfCount --
 *
 *	Find the number of bytes in the Utf character "ch".
 *
 * Results:
 *	The return values is the number of bytes in the Utf character "ch".
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Tcl_UniChar whose size is returned. */
{
    if ((ch > 0) && (ch < UNICODE_SELF)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
................................................................................
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharToUtf(
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most TCL_UTF_MAX bytes). */
................................................................................

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the upper case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < TclUtfCount(upChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(upChar, dst);
	}
	src += bytes;
    }
................................................................................

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the lower case
	 * char to dst if its size is <= the original char.
	 */

	if (bytes < TclUtfCount(lowChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }
................................................................................

    src = dst = str;

    if (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	titleChar = Tcl_UniCharToTitle(ch);

	if (bytes < TclUtfCount(titleChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(titleChar, dst);
	}
	src += bytes;
    }
    while (*src) {
	bytes = TclUtfToUniChar(src, &ch);
	lowChar = Tcl_UniCharToLower(ch);

	if (bytes < TclUtfCount(lowChar)) {
	    memcpy(dst, src, (size_t) bytes);
	    dst += bytes;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += bytes;
    }

Changes to generic/tclVar.c.

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
...
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
...
654
655
656
657
658
659
660

661
662
663
664
665
666
667
668
...
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
...
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
....
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
....
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
			    Tcl_Obj *varNamePtr, int flags, const int create,
			    const char **errMsgPtr, int *indexPtr);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;
static Tcl_UpdateStringProc	PanicOnUpdateVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;
static Tcl_UpdateStringProc	UpdateParsedVarName;

static Tcl_UpdateStringProc	PanicOnUpdateVarName;
static Tcl_SetFromAnyProc	PanicOnSetVarName;

/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
................................................................................
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
};

/*
 * Type of Tcl_Objs used to speed up array searches.
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:	searchIdNumber (cast to pointer)
................................................................................
    int index, len1, len2;
    int parsed = 0;
    Tcl_Obj *objPtr;
    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
    const char *errMsg = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
    char *newPart2 = NULL;
    *arrayPtrPtr = NULL;

    if (typePtr == &localVarNameType) {
	int localIndex;

    localVarNameTypeHandling:
	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
................................................................................
		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
	    if (newPart2) {
		part2Ptr = Tcl_NewStringObj(newPart2, -1);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}
	    }
	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    typePtr = part1Ptr->typePtr;
	    if (typePtr == &localVarNameType) {
................................................................................
		 * name to a new string part2.
		 */

		part2 = part1 + i + 1;
		len2 = len1 - i - 2;
		len1 = i;

		newPart2 = ckalloc(len2 + 1);
		memcpy(newPart2, part2, (unsigned) len2);
		*(newPart2+len2) = '\0';
		part2 = newPart2;
		part2Ptr = Tcl_NewStringObj(newPart2, -1);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}

		/*
		 * Free the internal rep of the original part1Ptr, now renamed
		 * objPtr, and set it to tclParsedVarNameType.
................................................................................
		 * name.
		 */

		TclNewStringObj(part1Ptr, part1, len1);
		Tcl_IncrRefCount(part1Ptr);

		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;

		objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;

		typePtr = part1Ptr->typePtr;
		part1 = TclGetString(part1Ptr);
		break;
	    }
	}
    }
................................................................................
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
	}
	if (newPart2) {
	    Tcl_DecrRefCount(part2Ptr);
	}
	return NULL;
    }

    /*
     * Cache the newly found variable if possible.
     */

................................................................................
	/*
	 * Array element sought: look it up.
	 */

	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);
	if (newPart2) {
	    Tcl_DecrRefCount(part2Ptr);
	}
    }
    return varPtr;
}
 
/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
................................................................................
 *----------------------------------------------------------------------
 *
 * Internal functions for variable name object types --
 *
 *----------------------------------------------------------------------
 */

/*
 * Panic functions that should never be called in normal operation.
 */

static void
PanicOnUpdateVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Panic("%s of type %s should not be called", "updateStringProc",
	    objPtr->typePtr->name);
}

static int
PanicOnSetVarName(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
	    objPtr->typePtr->name);
    return TCL_ERROR;
}

/*
 * localVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
................................................................................
 */

static void
FreeParsedVarName(
    Tcl_Obj *objPtr)
{
    register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
    register char *elem = objPtr->internalRep.twoPtrValue.ptr2;

    if (arrayPtr != NULL) {
	TclDecrRefCount(arrayPtr);
	ckfree(elem);
    }
    objPtr->typePtr = NULL;
}

static void
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
    char *elemCopy;
    unsigned elemLen;

    if (arrayPtr != NULL) {
	Tcl_IncrRefCount(arrayPtr);
	elemLen = strlen(elem);
	elemCopy = ckalloc(elemLen + 1);
	memcpy(elemCopy, elem, elemLen);
	*(elemCopy + elemLen) = '\0';
	elem = elemCopy;
    }

    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
    dupPtr->typePtr = &tclParsedVarNameType;
}

static void
UpdateParsedVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
    char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
    const char *part1;
    char *p;
    int len1, len2, totalLen;

    if (arrayPtr == NULL) {
	/*
	 * This is a parsed scalar name: what is it doing here?
	 */

	Tcl_Panic("scalar parsedVarName without a string rep");
    }

    part1 = TclGetStringFromObj(arrayPtr, &len1);
    len2 = strlen(part2);

    totalLen = len1 + len2 + 2;
    p = ckalloc(totalLen + 1);
    objPtr->bytes = p;
    objPtr->length = totalLen;

    memcpy(p, part1, (unsigned) len1);
    p += len1;
    *p++ = '(';
    memcpy(p, part2, (unsigned) len2);
    p += len2;
    *p++ = ')';
    *p = '\0';
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
 *
 *	Searches for a namespace variable, a variable not local to a






<



<
<
<
<







 







|




|







 







<







 







|
<
<







 







<
<
<
<
|







 







>
|







 







<
<
<







 







<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|



|










|
<
<



|
<
<
<
<






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







198
199
200
201
202
203
204

205
206
207




208
209
210
211
212
213
214
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
...
527
528
529
530
531
532
533

534
535
536
537
538
539
540
...
573
574
575
576
577
578
579
580


581
582
583
584
585
586
587
...
617
618
619
620
621
622
623




624
625
626
627
628
629
630
631
...
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
...
668
669
670
671
672
673
674



675
676
677
678
679
680
681
...
716
717
718
719
720
721
722



723
724
725
726
727
728
729
....
5496
5497
5498
5499
5500
5501
5502






















5503
5504
5505
5506
5507
5508
5509
....
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571


5572
5573
5574
5575




5576
5577
5578
5579
5580
5581



































5582
5583
5584
5585
5586
5587
5588
MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
			    Tcl_Obj *varNamePtr, int flags, const int create,
			    const char **errMsgPtr, int *indexPtr);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;


static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;





/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
................................................................................
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL
};

static const Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};

/*
 * Type of Tcl_Objs used to speed up array searches.
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:	searchIdNumber (cast to pointer)
................................................................................
    int index, len1, len2;
    int parsed = 0;
    Tcl_Obj *objPtr;
    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
    const char *errMsg = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;

    *arrayPtrPtr = NULL;

    if (typePtr == &localVarNameType) {
	int localIndex;

    localVarNameTypeHandling:
	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
................................................................................
		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    if ((part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2)) {


		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}
	    }
	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    typePtr = part1Ptr->typePtr;
	    if (typePtr == &localVarNameType) {
................................................................................
		 * name to a new string part2.
		 */

		part2 = part1 + i + 1;
		len2 = len1 - i - 2;
		len1 = i;





		part2Ptr = Tcl_NewStringObj(part2, len2);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}

		/*
		 * Free the internal rep of the original part1Ptr, now renamed
		 * objPtr, and set it to tclParsedVarNameType.
................................................................................
		 * name.
		 */

		TclNewStringObj(part1Ptr, part1, len1);
		Tcl_IncrRefCount(part1Ptr);

		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
		Tcl_IncrRefCount(part2Ptr);
		objPtr->internalRep.twoPtrValue.ptr2 = part2Ptr;

		typePtr = part1Ptr->typePtr;
		part1 = TclGetString(part1Ptr);
		break;
	    }
	}
    }
................................................................................
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
	}



	return NULL;
    }

    /*
     * Cache the newly found variable if possible.
     */

................................................................................
	/*
	 * Array element sought: look it up.
	 */

	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);



    }
    return varPtr;
}
 
/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
................................................................................
 *----------------------------------------------------------------------
 *
 * Internal functions for variable name object types --
 *
 *----------------------------------------------------------------------
 */























/*
 * localVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
................................................................................
 */

static void
FreeParsedVarName(
    Tcl_Obj *objPtr)
{
    register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2;

    if (arrayPtr != NULL) {
	TclDecrRefCount(arrayPtr);
	TclDecrRefCount(elem);
    }
    objPtr->typePtr = NULL;
}

static void
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2;



    if (arrayPtr != NULL) {
	Tcl_IncrRefCount(arrayPtr);
	Tcl_IncrRefCount(elem);




    }

    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
    dupPtr->typePtr = &tclParsedVarNameType;
}



































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
 *
 *	Searches for a namespace variable, a variable not local to a

Changes to generic/tclZlib.c.

1190
1191
1192
1193
1194
1195
1196
1197
1198
1199

1200
1201

1202
1203
1204
1205
1206
1207
1208
	outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
	zshPtr->stream.avail_out = outSize;
	dataTmp = ckalloc(zshPtr->stream.avail_out);
	zshPtr->stream.next_out = (Bytef *) dataTmp;

	e = deflate(&zshPtr->stream, flush);
	while (e == Z_BUF_ERROR) {
	    /*
	     * Output buffer too small to hold the data being generated; so

	     * put a new buffer into place after saving the old generated
	     * data to the outData list.

	     */

	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);

	    if (outSize < 0xFFFF) {
		outSize = 0xFFFF;	/* There may be *lots* of data left to






|

|
>
|
<
>







1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1209
	outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
	zshPtr->stream.avail_out = outSize;
	dataTmp = ckalloc(zshPtr->stream.avail_out);
	zshPtr->stream.next_out = (Bytef *) dataTmp;

	e = deflate(&zshPtr->stream, flush);
	while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after

	     * saving the old generated data to the outData list.
	     */

	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);

	    if (outSize < 0xFFFF) {
		outSize = 0xFFFF;	/* There may be *lots* of data left to

Changes to library/clock.tcl.

4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
....
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
....
4321
4322
4323
4324
4325
4326
4327





4328
4329
4330
4331
4332
4333
4334
....
4418
4419
4420
4421
4422
4423
4424


















































4425
4426
4427
4428
4429
4430
4431
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName clockval ?number units?...\
             ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

................................................................................
    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($clockval) } } result] } {
	return -code error "expected integer but got \"$clockval\""
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale
................................................................................
		    set clockval [AddDays [expr { 7 * $quantity }] \
			    $clockval $timezone $changeover]
		}
		days - day {
		    set clockval [AddDays $quantity $clockval $timezone \
			    $changeover]
		}






		hours - hour {
		    set clockval [expr { 3600 * $quantity + $clockval }]
		}
		minutes - minute {
		    set clockval [expr { 60 * $quantity + $clockval }]
		}
................................................................................
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}



















































#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
#	zone.






|







 







<
<
<







 







>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
....
4283
4284
4285
4286
4287
4288
4289



4290
4291
4292
4293
4294
4295
4296
....
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
....
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName clockval ?number units?...\
             ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error "expected integer but got \"$clockval\""
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

................................................................................
    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }



    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale
................................................................................
		    set clockval [AddDays [expr { 7 * $quantity }] \
			    $clockval $timezone $changeover]
		}
		days - day {
		    set clockval [AddDays $quantity $clockval $timezone \
			    $changeover]
		}

		weekdays - weekday {
		    set clockval [AddWeekDays $quantity $clockval $timezone \
			    $changeover]
		}

		hours - hour {
		    set clockval [expr { 3600 * $quantity + $clockval }]
		}
		minutes - minute {
		    set clockval [expr { 60 * $quantity + $clockval }]
		}
................................................................................
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddWeekDays --
#
#	Add a given number of week days (skipping Saturdays and Sundays)
#	to a given clock value in a given time zone.
#
# Parameters:
#	days - Number of days to add (may be negative)
#	clockval - Seconds since the epoch before the operation
#	timezone - Time zone in which the operation is to be performed
#	changeover - Julian Day on which the Gregorian calendar was adopted
#		     in the target locale.
#
# Results:
#	Returns the new clock value as a number of seconds since the epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AddWeekDays { days clockval timezone changeover } {

    if {$days == 0} {
        return $clockval
    }

    set day [format $clockval -format %u]

    set weeks  [expr {$days / 5}]
    set rdays  [expr {$days % 5}]
    set toAdd  [expr {7 * $weeks + $rdays}]
    set resDay [expr {$day + ($toAdd % 7)}]

    # Adjust if we start from a weekend
    if {$day > 5} {
	set adj [expr {5 - $day}]
	incr toAdd  $adj
	incr resDay $adj
    }

    # Adjust if we end up on a weekend
    if {$resDay > 5} {
	incr toAdd 2
    }

    AddDays $toAdd $clockval $timezone $changeover
}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
#	zone.

Changes to library/reg/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.1 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.1 \
            [list load [file join $dir tclreg13.dll] registry]
}


|


|


1
2
3
4
5
6
7
8
9
if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.2 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.2 \
            [list load [file join $dir tclreg13.dll] registry]
}

Changes to library/tcltest/pkgIndex.tcl.

5
6
7
8
9
10
11
12
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]]






|
5
6
7
8
9
10
11
12
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]

Changes to library/tcltest/tcltest.tcl.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
607
608
609
610
611
612
613












614
615

616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
....
1967
1968
1969
1970
1971
1972
1973





1974
1975
1976
1977
1978
1979
1980
....
2071
2072
2073
2074
2075
2076
2077










2078
2079
2080
2081
2082
2083
2084
package require Tcl 8.5		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
    # and the install directory in the Makefiles.  When the minor version
    # changes (new feature) be sure to update the man page as well.
    variable Version 2.3.8

    # Compatibility support for dumb variables defined in tcltest 1
    # Do not use these.  Call [package provide Tcl] and [info patchlevel]
    # yourself.  You don't need tcltest to wrap it for you.
    variable version [package provide Tcl]
    variable patchLevel [info patchlevel]

................................................................................
	}
	set code [catch {Configure {*}$args} msg]
	return -code $code $msg
    }

    proc AcceptVerbose { level } {
	set level [AcceptList $level]












	if {[llength $level] == 1} {
	    if {![regexp {^(pass|body|skip|start|error|line)$} $level]} {

		# translate single characters abbreviations to expanded list
		set level [string map {p pass b body s skip t start e error l line} \
			[split $level {}]]
	    }
	}
	set valid [list]
	foreach v $level {
	    if {[regexp {^(pass|body|skip|start|error|line)$} $v]} {
		lappend valid $v
	    }
	}
	return $valid
    }

    proc IsVerbose {level} {
................................................................................
	set errorInfo(setup) $::errorInfo
	set errorCode(setup) $::errorCode
    }
    set setupFailure [expr {$code != 0}]

    # Only run the test body if the setup was successful
    if {!$setupFailure} {






	# Verbose notification of $body start
	if {[IsVerbose start]} {
	    puts [outputChannel] "---- $name start"
	    flush [outputChannel]
	}

................................................................................
		if {$msg ne {}} {
		    append coreMsg "\nError:\
			Problem renaming core file: $msg"
		}
	    }
	}
    }











    # if we didn't experience any failures, then we passed
    variable numTests
    if {!($setupFailure || $cleanupFailure || $coreFailure
	    || $outputFailure || $errorFailure || $codeFailure
	    || $scriptFailure)} {
	if {$testLevel == 1} {






|







 







>
>
>
>
>
>
>
>
>
>
>
>

<
>

<
|




|







 







>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626

627
628

629
630
631
632
633
634
635
636
637
638
639
640
641
....
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
....
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
package require Tcl 8.5		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
    # and the install directory in the Makefiles.  When the minor version
    # changes (new feature) be sure to update the man page as well.
    variable Version 2.4.0

    # Compatibility support for dumb variables defined in tcltest 1
    # Do not use these.  Call [package provide Tcl] and [info patchlevel]
    # yourself.  You don't need tcltest to wrap it for you.
    variable version [package provide Tcl]
    variable patchLevel [info patchlevel]

................................................................................
	}
	set code [catch {Configure {*}$args} msg]
	return -code $code $msg
    }

    proc AcceptVerbose { level } {
	set level [AcceptList $level]
	set levelMap {
	    l list
	    p pass
	    b body
	    s skip
	    t start
	    e error
	    l line
	    m msec
	    u usec
	}
	set levelRegexp "^([join [dict values $levelMap] |])\$"
	if {[llength $level] == 1} {

	    if {![regexp $levelRegexp $level]} {
		# translate single characters abbreviations to expanded list

		set level [string map $levelMap [split $level {}]]
	    }
	}
	set valid [list]
	foreach v $level {
	    if {[regexp $levelRegexp $v]} {
		lappend valid $v
	    }
	}
	return $valid
    }

    proc IsVerbose {level} {
................................................................................
	set errorInfo(setup) $::errorInfo
	set errorCode(setup) $::errorCode
    }
    set setupFailure [expr {$code != 0}]

    # Only run the test body if the setup was successful
    if {!$setupFailure} {

	# Register startup time
	if {[IsVerbose msec] || [IsVerbose usec]} {
	    set timeStart [clock microseconds]
	}

	# Verbose notification of $body start
	if {[IsVerbose start]} {
	    puts [outputChannel] "---- $name start"
	    flush [outputChannel]
	}

................................................................................
		if {$msg ne {}} {
		    append coreMsg "\nError:\
			Problem renaming core file: $msg"
		}
	    }
	}
    }

    if {[IsVerbose msec] || [IsVerbose usec]} {
	set t [expr {[clock microseconds] - $timeStart}]
	if {[IsVerbose usec]} {
	    puts [outputChannel] "++++ $name took $t μs"
	}
	if {[IsVerbose msec]} {
	    puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms"
	}
    }

    # if we didn't experience any failures, then we passed
    variable numTests
    if {!($setupFailure || $cleanupFailure || $coreFailure
	    || $outputFailure || $errorFailure || $codeFailure
	    || $scriptFailure)} {
	if {$testLevel == 1} {

Changes to library/tzdata/America/Caracas.

2
3
4
5
6
7
8

9
set TZData(:America/Caracas) {
    {-9223372036854775808 -16064 0 LMT}
    {-2524505536 -16060 0 CMT}
    {-1826739140 -16200 0 VET}
    {-157750200 -14400 0 VET}
    {1197183600 -16200 0 VET}

}






>

2
3
4
5
6
7
8
9
10
set TZData(:America/Caracas) {
    {-9223372036854775808 -16064 0 LMT}
    {-2524505536 -16060 0 CMT}
    {-1826739140 -16200 0 VET}
    {-157750200 -14400 0 VET}
    {1197183600 -16200 0 VET}
    {1462086000 -14400 0 VET}
}

Changes to library/tzdata/America/Port-au-Prince.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

42
43
44
45
46
47
48








































































































































































49
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}








































































































































































}

Changes to library/tzdata/America/Santiago.

114
115
116
117
118
119
120















































121
























































































































122
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1367118000 -14400 0 CLT}
    {1378612800 -10800 1 CLST}
    {1398567600 -14400 0 CLT}
    {1410062400 -10800 1 CLST}















































    {1430017200 -10800 0 CLT}
























































































































}






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1367118000 -14400 0 CLT}
    {1378612800 -10800 1 CLST}
    {1398567600 -14400 0 CLT}
    {1410062400 -10800 1 CLST}
    {1463281200 -14400 0 CLT}
    {1471147200 -10800 1 CLST}
    {1494730800 -14400 0 CLT}
    {1502596800 -10800 1 CLST}
    {1526180400 -14400 0 CLT}
    {1534046400 -10800 1 CLST}
    {1557630000 -14400 0 CLT}
    {1565496000 -10800 1 CLST}
    {1589079600 -14400 0 CLT}
    {1596945600 -10800 1 CLST}
    {1620529200 -14400 0 CLT}
    {1629000000 -10800 1 CLST}
    {1652583600 -14400 0 CLT}
    {1660449600 -10800 1 CLST}
    {1684033200 -14400 0 CLT}
    {1691899200 -10800 1 CLST}
    {1715482800 -14400 0 CLT}
    {1723348800 -10800 1 CLST}
    {1746932400 -14400 0 CLT}
    {1754798400 -10800 1 CLST}
    {1778382000 -14400 0 CLT}
    {1786248000 -10800 1 CLST}
    {1809831600 -14400 0 CLT}
    {1818302400 -10800 1 CLST}
    {1841886000 -14400 0 CLT}
    {1849752000 -10800 1 CLST}
    {1873335600 -14400 0 CLT}
    {1881201600 -10800 1 CLST}
    {1904785200 -14400 0 CLT}
    {1912651200 -10800 1 CLST}
    {1936234800 -14400 0 CLT}
    {1944100800 -10800 1 CLST}
    {1967684400 -14400 0 CLT}
    {1976155200 -10800 1 CLST}
    {1999738800 -14400 0 CLT}
    {2007604800 -10800 1 CLST}
    {2031188400 -14400 0 CLT}
    {2039054400 -10800 1 CLST}
    {2062638000 -14400 0 CLT}
    {2070504000 -10800 1 CLST}
    {2094087600 -14400 0 CLT}
    {2101953600 -10800 1 CLST}
    {2125537200 -14400 0 CLT}
    {2133403200 -10800 1 CLST}
    {2156986800 -14400 0 CLT}
    {2165457600 -10800 1 CLST}
    {2189041200 -14400 0 CLT}
    {2196907200 -10800 1 CLST}
    {2220490800 -14400 0 CLT}
    {2228356800 -10800 1 CLST}
    {2251940400 -14400 0 CLT}
    {2259806400 -10800 1 CLST}
    {2283390000 -14400 0 CLT}
    {2291256000 -10800 1 CLST}
    {2314839600 -14400 0 CLT}
    {2322705600 -10800 1 CLST}
    {2346894000 -14400 0 CLT}
    {2354760000 -10800 1 CLST}
    {2378343600 -14400 0 CLT}
    {2386209600 -10800 1 CLST}
    {2409793200 -14400 0 CLT}
    {2417659200 -10800 1 CLST}
    {2441242800 -14400 0 CLT}
    {2449108800 -10800 1 CLST}
    {2472692400 -14400 0 CLT}
    {2480558400 -10800 1 CLST}
    {2504142000 -14400 0 CLT}
    {2512612800 -10800 1 CLST}
    {2536196400 -14400 0 CLT}
    {2544062400 -10800 1 CLST}
    {2567646000 -14400 0 CLT}
    {2575512000 -10800 1 CLST}
    {2599095600 -14400 0 CLT}
    {2606961600 -10800 1 CLST}
    {2630545200 -14400 0 CLT}
    {2638411200 -10800 1 CLST}
    {2661994800 -14400 0 CLT}
    {2669860800 -10800 1 CLST}
    {2693444400 -14400 0 CLT}
    {2701915200 -10800 1 CLST}
    {2725498800 -14400 0 CLT}
    {2733364800 -10800 1 CLST}
    {2756948400 -14400 0 CLT}
    {2764814400 -10800 1 CLST}
    {2788398000 -14400 0 CLT}
    {2796264000 -10800 1 CLST}
    {2819847600 -14400 0 CLT}
    {2827713600 -10800 1 CLST}
    {2851297200 -14400 0 CLT}
    {2859768000 -10800 1 CLST}
    {2883351600 -14400 0 CLT}
    {2891217600 -10800 1 CLST}
    {2914801200 -14400 0 CLT}
    {2922667200 -10800 1 CLST}
    {2946250800 -14400 0 CLT}
    {2954116800 -10800 1 CLST}
    {2977700400 -14400 0 CLT}
    {2985566400 -10800 1 CLST}
    {3009150000 -14400 0 CLT}
    {3017016000 -10800 1 CLST}
    {3040599600 -14400 0 CLT}
    {3049070400 -10800 1 CLST}
    {3072654000 -14400 0 CLT}
    {3080520000 -10800 1 CLST}
    {3104103600 -14400 0 CLT}
    {3111969600 -10800 1 CLST}
    {3135553200 -14400 0 CLT}
    {3143419200 -10800 1 CLST}
    {3167002800 -14400 0 CLT}
    {3174868800 -10800 1 CLST}
    {3198452400 -14400 0 CLT}
    {3206318400 -10800 1 CLST}
    {3230506800 -14400 0 CLT}
    {3238372800 -10800 1 CLST}
    {3261956400 -14400 0 CLT}
    {3269822400 -10800 1 CLST}
    {3293406000 -14400 0 CLT}
    {3301272000 -10800 1 CLST}
    {3324855600 -14400 0 CLT}
    {3332721600 -10800 1 CLST}
    {3356305200 -14400 0 CLT}
    {3364171200 -10800 1 CLST}
    {3387754800 -14400 0 CLT}
    {3396225600 -10800 1 CLST}
    {3419809200 -14400 0 CLT}
    {3427675200 -10800 1 CLST}
    {3451258800 -14400 0 CLT}
    {3459124800 -10800 1 CLST}
    {3482708400 -14400 0 CLT}
    {3490574400 -10800 1 CLST}
    {3514158000 -14400 0 CLT}
    {3522024000 -10800 1 CLST}
    {3545607600 -14400 0 CLT}
    {3553473600 -10800 1 CLST}
    {3577057200 -14400 0 CLT}
    {3585528000 -10800 1 CLST}
    {3609111600 -14400 0 CLT}
    {3616977600 -10800 1 CLST}
    {3640561200 -14400 0 CLT}
    {3648427200 -10800 1 CLST}
    {3672010800 -14400 0 CLT}
    {3679876800 -10800 1 CLST}
    {3703460400 -14400 0 CLT}
    {3711326400 -10800 1 CLST}
    {3734910000 -14400 0 CLT}
    {3743380800 -10800 1 CLST}
    {3766964400 -14400 0 CLT}
    {3774830400 -10800 1 CLST}
    {3798414000 -14400 0 CLT}
    {3806280000 -10800 1 CLST}
    {3829863600 -14400 0 CLT}
    {3837729600 -10800 1 CLST}
    {3861313200 -14400 0 CLT}
    {3869179200 -10800 1 CLST}
    {3892762800 -14400 0 CLT}
    {3900628800 -10800 1 CLST}
    {3924212400 -14400 0 CLT}
    {3932683200 -10800 1 CLST}
    {3956266800 -14400 0 CLT}
    {3964132800 -10800 1 CLST}
    {3987716400 -14400 0 CLT}
    {3995582400 -10800 1 CLST}
    {4019166000 -14400 0 CLT}
    {4027032000 -10800 1 CLST}
    {4050615600 -14400 0 CLT}
    {4058481600 -10800 1 CLST}
    {4082065200 -14400 0 CLT}
    {4089931200 -10800 1 CLST}
}

Changes to library/tzdata/Antarctica/Palmer.

77
78
79
80
81
82
83















































84
























































































































85
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1367118000 -14400 0 CLT}
    {1378612800 -10800 1 CLST}
    {1398567600 -14400 0 CLT}
    {1410062400 -10800 1 CLST}















































    {1430017200 -10800 0 CLT}
























































































































}






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1367118000 -14400 0 CLT}
    {1378612800 -10800 1 CLST}
    {1398567600 -14400 0 CLT}
    {1410062400 -10800 1 CLST}
    {1463281200 -14400 0 CLT}
    {1471147200 -10800 1 CLST}
    {1494730800 -14400 0 CLT}
    {1502596800 -10800 1 CLST}
    {1526180400 -14400 0 CLT}
    {1534046400 -10800 1 CLST}
    {1557630000 -14400 0 CLT}
    {1565496000 -10800 1 CLST}
    {1589079600 -14400 0 CLT}
    {1596945600 -10800 1 CLST}
    {1620529200 -14400 0 CLT}
    {1629000000 -10800 1 CLST}
    {1652583600 -14400 0 CLT}
    {1660449600 -10800 1 CLST}
    {1684033200 -14400 0 CLT}
    {1691899200 -10800 1 CLST}
    {1715482800 -14400 0 CLT}
    {1723348800 -10800 1 CLST}
    {1746932400 -14400 0 CLT}
    {1754798400 -10800 1 CLST}
    {1778382000 -14400 0 CLT}
    {1786248000 -10800 1 CLST}
    {1809831600 -14400 0 CLT}
    {1818302400 -10800 1 CLST}
    {1841886000 -14400 0 CLT}
    {1849752000 -10800 1 CLST}
    {1873335600 -14400 0 CLT}
    {1881201600 -10800 1 CLST}
    {1904785200 -14400 0 CLT}
    {1912651200 -10800 1 CLST}
    {1936234800 -14400 0 CLT}
    {1944100800 -10800 1 CLST}
    {1967684400 -14400 0 CLT}
    {1976155200 -10800 1 CLST}
    {1999738800 -14400 0 CLT}
    {2007604800 -10800 1 CLST}
    {2031188400 -14400 0 CLT}
    {2039054400 -10800 1 CLST}
    {2062638000 -14400 0 CLT}
    {2070504000 -10800 1 CLST}
    {2094087600 -14400 0 CLT}
    {2101953600 -10800 1 CLST}
    {2125537200 -14400 0 CLT}
    {2133403200 -10800 1 CLST}
    {2156986800 -14400 0 CLT}
    {2165457600 -10800 1 CLST}
    {2189041200 -14400 0 CLT}
    {2196907200 -10800 1 CLST}
    {2220490800 -14400 0 CLT}
    {2228356800 -10800 1 CLST}
    {2251940400 -14400 0 CLT}
    {2259806400 -10800 1 CLST}
    {2283390000 -14400 0 CLT}
    {2291256000 -10800 1 CLST}
    {2314839600 -14400 0 CLT}
    {2322705600 -10800 1 CLST}
    {2346894000 -14400 0 CLT}
    {2354760000 -10800 1 CLST}
    {2378343600 -14400 0 CLT}
    {2386209600 -10800 1 CLST}
    {2409793200 -14400 0 CLT}
    {2417659200 -10800 1 CLST}
    {2441242800 -14400 0 CLT}
    {2449108800 -10800 1 CLST}
    {2472692400 -14400 0 CLT}
    {2480558400 -10800 1 CLST}
    {2504142000 -14400 0 CLT}
    {2512612800 -10800 1 CLST}
    {2536196400 -14400 0 CLT}
    {2544062400 -10800 1 CLST}
    {2567646000 -14400 0 CLT}
    {2575512000 -10800 1 CLST}
    {2599095600 -14400 0 CLT}
    {2606961600 -10800 1 CLST}
    {2630545200 -14400 0 CLT}
    {2638411200 -10800 1 CLST}
    {2661994800 -14400 0 CLT}
    {2669860800 -10800 1 CLST}
    {2693444400 -14400 0 CLT}
    {2701915200 -10800 1 CLST}
    {2725498800 -14400 0 CLT}
    {2733364800 -10800 1 CLST}
    {2756948400 -14400 0 CLT}
    {2764814400 -10800 1 CLST}
    {2788398000 -14400 0 CLT}
    {2796264000 -10800 1 CLST}
    {2819847600 -14400 0 CLT}
    {2827713600 -10800 1 CLST}
    {2851297200 -14400 0 CLT}
    {2859768000 -10800 1 CLST}
    {2883351600 -14400 0 CLT}
    {2891217600 -10800 1 CLST}
    {2914801200 -14400 0 CLT}
    {2922667200 -10800 1 CLST}
    {2946250800 -14400 0 CLT}
    {2954116800 -10800 1 CLST}
    {2977700400 -14400 0 CLT}
    {2985566400 -10800 1 CLST}
    {3009150000 -14400 0 CLT}
    {3017016000 -10800 1 CLST}
    {3040599600 -14400 0 CLT}
    {3049070400 -10800 1 CLST}
    {3072654000 -14400 0 CLT}
    {3080520000 -10800 1 CLST}
    {3104103600 -14400 0 CLT}
    {3111969600 -10800 1 CLST}
    {3135553200 -14400 0 CLT}
    {3143419200 -10800 1 CLST}
    {3167002800 -14400 0 CLT}
    {3174868800 -10800 1 CLST}
    {3198452400 -14400 0 CLT}
    {3206318400 -10800 1 CLST}
    {3230506800 -14400 0 CLT}
    {3238372800 -10800 1 CLST}
    {3261956400 -14400 0 CLT}
    {3269822400 -10800 1 CLST}
    {3293406000 -14400 0 CLT}
    {3301272000 -10800 1 CLST}
    {3324855600 -14400 0 CLT}
    {3332721600 -10800 1 CLST}
    {3356305200 -14400 0 CLT}
    {3364171200 -10800 1 CLST}
    {3387754800 -14400 0 CLT}
    {3396225600 -10800 1 CLST}
    {3419809200 -14400 0 CLT}
    {3427675200 -10800 1 CLST}
    {3451258800 -14400 0 CLT}
    {3459124800 -10800 1 CLST}
    {3482708400 -14400 0 CLT}
    {3490574400 -10800 1 CLST}
    {3514158000 -14400 0 CLT}
    {3522024000 -10800 1 CLST}
    {3545607600 -14400 0 CLT}
    {3553473600 -10800 1 CLST}
    {3577057200 -14400 0 CLT}
    {3585528000 -10800 1 CLST}
    {3609111600 -14400 0 CLT}
    {3616977600 -10800 1 CLST}
    {3640561200 -14400 0 CLT}
    {3648427200 -10800 1 CLST}
    {3672010800 -14400 0 CLT}
    {3679876800 -10800 1 CLST}
    {3703460400 -14400 0 CLT}
    {3711326400 -10800 1 CLST}
    {3734910000 -14400 0 CLT}
    {3743380800 -10800 1 CLST}
    {3766964400 -14400 0 CLT}
    {3774830400 -10800 1 CLST}
    {3798414000 -14400 0 CLT}
    {3806280000 -10800 1 CLST}
    {3829863600 -14400 0 CLT}
    {3837729600 -10800 1 CLST}
    {3861313200 -14400 0 CLT}
    {3869179200 -10800 1 CLST}
    {3892762800 -14400 0 CLT}
    {3900628800 -10800 1 CLST}
    {3924212400 -14400 0 CLT}
    {3932683200 -10800 1 CLST}
    {3956266800 -14400 0 CLT}
    {3964132800 -10800 1 CLST}
    {3987716400 -14400 0 CLT}
    {3995582400 -10800 1 CLST}
    {4019166000 -14400 0 CLT}
    {4027032000 -10800 1 CLST}
    {4050615600 -14400 0 CLT}
    {4058481600 -10800 1 CLST}
    {4082065200 -14400 0 CLT}
    {4089931200 -10800 1 CLST}
}

Changes to library/tzdata/Asia/Almaty.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27


28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Almaty) {
    {-9223372036854775808 18468 0 LMT}
    {-1441170468 18000 0 ALMT}
    {-1247547600 21600 0 ALMT}
    {354909600 25200 1 ALMST}
    {370717200 21600 0 ALMT}
    {386445600 25200 1 ALMST}
    {402253200 21600 0 ALMT}
    {417981600 25200 1 ALMST}
    {433789200 21600 0 ALMT}
    {449604000 25200 1 ALMST}
    {465336000 21600 0 ALMT}
    {481060800 25200 1 ALMST}
    {496785600 21600 0 ALMT}
    {512510400 25200 1 ALMST}
    {528235200 21600 0 ALMT}
    {543960000 25200 1 ALMST}
    {559684800 21600 0 ALMT}
    {575409600 25200 1 ALMST}
    {591134400 21600 0 ALMT}
    {606859200 25200 1 ALMST}
    {622584000 21600 0 ALMT}
    {638308800 25200 1 ALMST}
    {654638400 21600 0 ALMT}
    {662666400 21600 0 ALMT}


    {694202400 21600 0 ALMT}
    {701802000 25200 1 ALMST}
    {717523200 21600 0 ALMT}
    {733262400 25200 1 ALMST}
    {748987200 21600 0 ALMT}
    {764712000 25200 1 ALMST}
    {780436800 21600 0 ALMT}
    {796161600 25200 1 ALMST}
    {811886400 21600 0 ALMT}
    {828216000 25200 1 ALMST}
    {846360000 21600 0 ALMT}
    {859665600 25200 1 ALMST}
    {877809600 21600 0 ALMT}
    {891115200 25200 1 ALMST}
    {909259200 21600 0 ALMT}
    {922564800 25200 1 ALMST}
    {941313600 21600 0 ALMT}
    {954014400 25200 1 ALMST}
    {972763200 21600 0 ALMT}
    {985464000 25200 1 ALMST}
    {1004212800 21600 0 ALMT}
    {1017518400 25200 1 ALMST}
    {1035662400 21600 0 ALMT}
    {1048968000 25200 1 ALMST}
    {1067112000 21600 0 ALMT}
    {1080417600 25200 1 ALMST}
    {1099166400 21600 0 ALMT}
    {1110823200 21600 0 ALMT}
}



|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

57
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Almaty) {
    {-9223372036854775808 18468 0 LMT}
    {-1441170468 18000 0 +05}
    {-1247547600 21600 0 +06}
    {354909600 25200 1 +07}
    {370717200 21600 0 +06}
    {386445600 25200 1 +07}
    {402253200 21600 0 +06}
    {417981600 25200 1 +07}
    {433789200 21600 0 +06}
    {449604000 25200 1 +07}
    {465336000 21600 0 +06}
    {481060800 25200 1 +07}
    {496785600 21600 0 +06}
    {512510400 25200 1 +07}
    {528235200 21600 0 +06}
    {543960000 25200 1 +07}
    {559684800 21600 0 +06}
    {575409600 25200 1 +07}
    {591134400 21600 0 +06}
    {606859200 25200 1 +07}
    {622584000 21600 0 +06}
    {638308800 25200 1 +07}
    {654638400 21600 0 +06}
    {670363200 18000 0 +05}
    {670366800 21600 1 +06}
    {686091600 18000 0 +05}
    {695768400 21600 0 +06}
    {701812800 25200 1 +07}
    {717537600 21600 0 +06}
    {733262400 25200 1 +07}
    {748987200 21600 0 +06}
    {764712000 25200 1 +07}
    {780436800 21600 0 +06}
    {796161600 25200 1 +07}
    {811886400 21600 0 +06}
    {828216000 25200 1 +07}
    {846360000 21600 0 +06}
    {859665600 25200 1 +07}
    {877809600 21600 0 +06}
    {891115200 25200 1 +07}
    {909259200 21600 0 +06}
    {922564800 25200 1 +07}
    {941313600 21600 0 +06}
    {954014400 25200 1 +07}
    {972763200 21600 0 +06}
    {985464000 25200 1 +07}
    {1004212800 21600 0 +06}
    {1017518400 25200 1 +07}
    {1035662400 21600 0 +06}
    {1048968000 25200 1 +07}
    {1067112000 21600 0 +06}
    {1080417600 25200 1 +07}
    {1099166400 21600 0 +06}

}

Changes to library/tzdata/Asia/Anadyr.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622562400 43200 0 ANAT}
    {638287200 46800 1 ANAST}
    {654616800 43200 0 ANAT}
    {670341600 39600 0 ANAMMTT}
    {670345200 43200 1 ANAST}
    {686070000 39600 0 ANAT}
    {695746800 43200 0 ANAMMTT}
    {701780400 46800 1 ANAST}
    {717501600 43200 0 ANAT}
    {733240800 46800 1 ANAST}
    {748965600 43200 0 ANAT}
    {764690400 46800 1 ANAST}
    {780415200 43200 0 ANAT}
    {796140000 46800 1 ANAST}
    {811864800 43200 0 ANAT}
    {828194400 46800 1 ANAST}






|
|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622562400 43200 0 ANAT}
    {638287200 46800 1 ANAST}
    {654616800 43200 0 ANAT}
    {670341600 39600 0 ANAMMTT}
    {670345200 43200 1 ANAST}
    {686070000 39600 0 ANAT}
    {695746800 43200 0 ANAMMTT}
    {701791200 46800 1 ANAST}
    {717516000 43200 0 ANAT}
    {733240800 46800 1 ANAST}
    {748965600 43200 0 ANAT}
    {764690400 46800 1 ANAST}
    {780415200 43200 0 ANAT}
    {796140000 46800 1 ANAST}
    {811864800 43200 0 ANAT}
    {828194400 46800 1 ANAST}

Changes to library/tzdata/Asia/Aqtau.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtau) {
    {-9223372036854775808 12064 0 LMT}
    {-1441164064 14400 0 FORT}
    {-1247544000 18000 0 FORT}
    {-220942800 18000 0 SHET}
    {370724400 21600 0 SHET}
    {386445600 18000 0 SHET}
    {386449200 21600 1 SHEST}
    {402256800 18000 0 SHET}
    {417985200 21600 1 SHEST}
    {433792800 18000 0 SHET}
    {449607600 21600 1 SHEST}
    {465339600 18000 0 SHET}
    {481064400 21600 1 SHEST}
    {496789200 18000 0 SHET}
    {512514000 21600 1 SHEST}
    {528238800 18000 0 SHET}
    {543963600 21600 1 SHEST}
    {559688400 18000 0 SHET}
    {575413200 21600 1 SHEST}
    {591138000 18000 0 SHET}
    {606862800 21600 1 SHEST}
    {622587600 18000 0 SHET}
    {638312400 21600 1 SHEST}
    {654642000 18000 0 SHET}
    {662670000 18000 0 SHET}


    {692823600 18000 0 AQTT}
    {701805600 21600 1 AQTST}
    {717526800 18000 0 AQTT}
    {733266000 21600 1 AQTST}
    {748990800 18000 0 AQTT}
    {764715600 21600 1 AQTST}
    {780440400 18000 0 AQTT}
    {796165200 14400 0 AQTT}
    {796168800 18000 1 AQTST}
    {811893600 14400 0 AQTT}
    {828223200 18000 1 AQTST}
    {846367200 14400 0 AQTT}
    {859672800 18000 1 AQTST}
    {877816800 14400 0 AQTT}
    {891122400 18000 1 AQTST}
    {909266400 14400 0 AQTT}
    {922572000 18000 1 AQTST}
    {941320800 14400 0 AQTT}
    {954021600 18000 1 AQTST}
    {972770400 14400 0 AQTT}
    {985471200 18000 1 AQTST}
    {1004220000 14400 0 AQTT}
    {1017525600 18000 1 AQTST}
    {1035669600 14400 0 AQTT}
    {1048975200 18000 1 AQTST}
    {1067119200 14400 0 AQTT}
    {1080424800 18000 1 AQTST}
    {1099173600 14400 0 AQTT}
    {1110830400 18000 0 AQTT}
}



|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

59
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtau) {
    {-9223372036854775808 12064 0 LMT}
    {-1441164064 14400 0 +04}
    {-1247544000 18000 0 +05}
    {-220942800 18000 0 +05}
    {370724400 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
    {701816400 21600 1 +06}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {780440400 18000 0 +05}
    {780444000 14400 0 +04}
    {796168800 18000 1 +05}
    {811893600 14400 0 +04}
    {828223200 18000 1 +05}
    {846367200 14400 0 +04}
    {859672800 18000 1 +05}
    {877816800 14400 0 +04}
    {891122400 18000 1 +05}
    {909266400 14400 0 +04}
    {922572000 18000 1 +05}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1099173600 18000 0 +05}

}

Changes to library/tzdata/Asia/Aqtobe.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtobe) {
    {-9223372036854775808 13720 0 LMT}
    {-1441165720 14400 0 AKTT}
    {-1247544000 18000 0 AKTT}
    {354913200 21600 1 AKTST}
    {370720800 21600 0 AKTT}
    {386445600 18000 0 AKTT}
    {386449200 21600 1 AKTST}
    {402256800 18000 0 AKTT}
    {417985200 21600 1 AKTST}
    {433792800 18000 0 AKTT}
    {449607600 21600 1 AKTST}
    {465339600 18000 0 AKTT}
    {481064400 21600 1 AKTST}
    {496789200 18000 0 AKTT}
    {512514000 21600 1 AKTST}
    {528238800 18000 0 AKTT}
    {543963600 21600 1 AKTST}
    {559688400 18000 0 AKTT}
    {575413200 21600 1 AKTST}
    {591138000 18000 0 AKTT}
    {606862800 21600 1 AKTST}
    {622587600 18000 0 AKTT}
    {638312400 21600 1 AKTST}
    {654642000 18000 0 AKTT}
    {662670000 18000 0 AKTT}


    {692823600 18000 0 AQTT}
    {701805600 21600 1 AQTST}
    {717526800 18000 0 AQTT}
    {733266000 21600 1 AQTST}
    {748990800 18000 0 AQTT}
    {764715600 21600 1 AQTST}
    {780440400 18000 0 AQTT}
    {796165200 21600 1 AQTST}
    {811890000 18000 0 AQTT}
    {828219600 21600 1 AQTST}
    {846363600 18000 0 AQTT}
    {859669200 21600 1 AQTST}
    {877813200 18000 0 AQTT}
    {891118800 21600 1 AQTST}
    {909262800 18000 0 AQTT}
    {922568400 21600 1 AQTST}
    {941317200 18000 0 AQTT}
    {954018000 21600 1 AQTST}
    {972766800 18000 0 AQTT}
    {985467600 21600 1 AQTST}
    {1004216400 18000 0 AQTT}
    {1017522000 21600 1 AQTST}
    {1035666000 18000 0 AQTT}
    {1048971600 21600 1 AQTST}
    {1067115600 18000 0 AQTT}
    {1080421200 21600 1 AQTST}
    {1099170000 18000 0 AQTT}
    {1110826800 18000 0 AQTT}
}



|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Aqtobe) {
    {-9223372036854775808 13720 0 LMT}
    {-1441165720 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {686095200 14400 0 +04}
    {695772000 18000 0 +05}
    {701816400 21600 1 +06}
    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {780440400 18000 0 +05}
    {796165200 21600 1 +06}
    {811890000 18000 0 +05}
    {828219600 21600 1 +06}
    {846363600 18000 0 +05}
    {859669200 21600 1 +06}
    {877813200 18000 0 +05}
    {891118800 21600 1 +06}
    {909262800 18000 0 +05}
    {922568400 21600 1 +06}
    {941317200 18000 0 +05}
    {954018000 21600 1 +06}
    {972766800 18000 0 +05}
    {985467600 21600 1 +06}
    {1004216400 18000 0 +05}
    {1017522000 21600 1 +06}
    {1035666000 18000 0 +05}
    {1048971600 21600 1 +06}
    {1067115600 18000 0 +05}
    {1080421200 21600 1 +06}
    {1099170000 18000 0 +05}

}

Changes to library/tzdata/Asia/Baku.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    {606866400 18000 1 BAKST}
    {622591200 14400 0 BAKT}
    {638316000 18000 1 BAKST}
    {654645600 14400 0 BAKT}
    {670370400 14400 1 BAKST}
    {683496000 14400 0 AZST}
    {686098800 10800 0 AZT}
    {701812800 14400 1 AZST}
    {717537600 14400 0 AZT}
    {820440000 14400 0 AZT}
    {828234000 18000 1 AZST}
    {846378000 14400 0 AZT}
    {852062400 14400 0 AZT}
    {859680000 18000 1 AZST}
    {877824000 14400 0 AZT}
................................................................................
    {1351382400 14400 0 AZT}
    {1364688000 18000 1 AZST}
    {1382832000 14400 0 AZT}
    {1396137600 18000 1 AZST}
    {1414281600 14400 0 AZT}
    {1427587200 18000 1 AZST}
    {1445731200 14400 0 AZT}
    {1459036800 18000 1 AZST}
    {1477785600 14400 0 AZT}
    {1490486400 18000 1 AZST}
    {1509235200 14400 0 AZT}
    {1521936000 18000 1 AZST}
    {1540684800 14400 0 AZT}
    {1553990400 18000 1 AZST}
    {1572134400 14400 0 AZT}
    {1585440000 18000 1 AZST}
    {1603584000 14400 0 AZT}
    {1616889600 18000 1 AZST}
    {1635638400 14400 0 AZT}
    {1648339200 18000 1 AZST}
    {1667088000 14400 0 AZT}
    {1679788800 18000 1 AZST}
    {1698537600 14400 0 AZT}
    {1711843200 18000 1 AZST}
    {1729987200 14400 0 AZT}
    {1743292800 18000 1 AZST}
    {1761436800 14400 0 AZT}
    {1774742400 18000 1 AZST}
    {1792886400 14400 0 AZT}
    {1806192000 18000 1 AZST}
    {1824940800 14400 0 AZT}
    {1837641600 18000 1 AZST}
    {1856390400 14400 0 AZT}
    {1869091200 18000 1 AZST}
    {1887840000 14400 0 AZT}
    {1901145600 18000 1 AZST}
    {1919289600 14400 0 AZT}
    {1932595200 18000 1 AZST}
    {1950739200 14400 0 AZT}
    {1964044800 18000 1 AZST}
    {1982793600 14400 0 AZT}
    {1995494400 18000 1 AZST}
    {2014243200 14400 0 AZT}
    {2026944000 18000 1 AZST}
    {2045692800 14400 0 AZT}
    {2058393600 18000 1 AZST}
    {2077142400 14400 0 AZT}
    {2090448000 18000 1 AZST}
    {2108592000 14400 0 AZT}
    {2121897600 18000 1 AZST}
    {2140041600 14400 0 AZT}
    {2153347200 18000 1 AZST}
    {2172096000 14400 0 AZT}
    {2184796800 18000 1 AZST}
    {2203545600 14400 0 AZT}
    {2216246400 18000 1 AZST}
    {2234995200 14400 0 AZT}
    {2248300800 18000 1 AZST}
    {2266444800 14400 0 AZT}
    {2279750400 18000 1 AZST}
    {2297894400 14400 0 AZT}
    {2311200000 18000 1 AZST}
    {2329344000 14400 0 AZT}
    {2342649600 18000 1 AZST}
    {2361398400 14400 0 AZT}
    {2374099200 18000 1 AZST}
    {2392848000 14400 0 AZT}
    {2405548800 18000 1 AZST}
    {2424297600 14400 0 AZT}
    {2437603200 18000 1 AZST}
    {2455747200 14400 0 AZT}
    {2469052800 18000 1 AZST}
    {2487196800 14400 0 AZT}
    {2500502400 18000 1 AZST}
    {2519251200 14400 0 AZT}
    {2531952000 18000 1 AZST}
    {2550700800 14400 0 AZT}
    {2563401600 18000 1 AZST}
    {2582150400 14400 0 AZT}
    {2595456000 18000 1 AZST}
    {2613600000 14400 0 AZT}
    {2626905600 18000 1 AZST}
    {2645049600 14400 0 AZT}
    {2658355200 18000 1 AZST}
    {2676499200 14400 0 AZT}
    {2689804800 18000 1 AZST}
    {2708553600 14400 0 AZT}
    {2721254400 18000 1 AZST}
    {2740003200 14400 0 AZT}
    {2752704000 18000 1 AZST}
    {2771452800 14400 0 AZT}
    {2784758400 18000 1 AZST}
    {2802902400 14400 0 AZT}
    {2816208000 18000 1 AZST}
    {2834352000 14400 0 AZT}
    {2847657600 18000 1 AZST}
    {2866406400 14400 0 AZT}
    {2879107200 18000 1 AZST}
    {2897856000 14400 0 AZT}
    {2910556800 18000 1 AZST}
    {2929305600 14400 0 AZT}
    {2942006400 18000 1 AZST}
    {2960755200 14400 0 AZT}
    {2974060800 18000 1 AZST}
    {2992204800 14400 0 AZT}
    {3005510400 18000 1 AZST}
    {3023654400 14400 0 AZT}
    {3036960000 18000 1 AZST}
    {3055708800 14400 0 AZT}
    {3068409600 18000 1 AZST}
    {3087158400 14400 0 AZT}
    {3099859200 18000 1 AZST}
    {3118608000 14400 0 AZT}
    {3131913600 18000 1 AZST}
    {3150057600 14400 0 AZT}
    {3163363200 18000 1 AZST}
    {3181507200 14400 0 AZT}
    {3194812800 18000 1 AZST}
    {3212956800 14400 0 AZT}
    {3226262400 18000 1 AZST}
    {3245011200 14400 0 AZT}
    {3257712000 18000 1 AZST}
    {3276460800 14400 0 AZT}
    {3289161600 18000 1 AZST}
    {3307910400 14400 0 AZT}
    {3321216000 18000 1 AZST}
    {3339360000 14400 0 AZT}
    {3352665600 18000 1 AZST}
    {3370809600 14400 0 AZT}
    {3384115200 18000 1 AZST}
    {3402864000 14400 0 AZT}
    {3415564800 18000 1 AZST}
    {3434313600 14400 0 AZT}
    {3447014400 18000 1 AZST}
    {3465763200 14400 0 AZT}
    {3479068800 18000 1 AZST}
    {3497212800 14400 0 AZT}
    {3510518400 18000 1 AZST}
    {3528662400 14400 0 AZT}
    {3541968000 18000 1 AZST}
    {3560112000 14400 0 AZT}
    {3573417600 18000 1 AZST}
    {3592166400 14400 0 AZT}
    {3604867200 18000 1 AZST}
    {3623616000 14400 0 AZT}
    {3636316800 18000 1 AZST}
    {3655065600 14400 0 AZT}
    {3668371200 18000 1 AZST}
    {3686515200 14400 0 AZT}
    {3699820800 18000 1 AZST}
    {3717964800 14400 0 AZT}
    {3731270400 18000 1 AZST}
    {3750019200 14400 0 AZT}
    {3762720000 18000 1 AZST}
    {3781468800 14400 0 AZT}
    {3794169600 18000 1 AZST}
    {3812918400 14400 0 AZT}
    {3825619200 18000 1 AZST}
    {3844368000 14400 0 AZT}
    {3857673600 18000 1 AZST}
    {3875817600 14400 0 AZT}
    {3889123200 18000 1 AZST}
    {3907267200 14400 0 AZT}
    {3920572800 18000 1 AZST}
    {3939321600 14400 0 AZT}
    {3952022400 18000 1 AZST}
    {3970771200 14400 0 AZT}
    {3983472000 18000 1 AZST}
    {4002220800 14400 0 AZT}
    {4015526400 18000 1 AZST}
    {4033670400 14400 0 AZT}
    {4046976000 18000 1 AZST}
    {4065120000 14400 0 AZT}
    {4078425600 18000 1 AZST}
    {4096569600 14400 0 AZT}
}






|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
67
68
69
70
71
72
73








































































































































































74
    {606866400 18000 1 BAKST}
    {622591200 14400 0 BAKT}
    {638316000 18000 1 BAKST}
    {654645600 14400 0 BAKT}
    {670370400 14400 1 BAKST}
    {683496000 14400 0 AZST}
    {686098800 10800 0 AZT}
    {701823600 14400 1 AZST}
    {717537600 14400 0 AZT}
    {820440000 14400 0 AZT}
    {828234000 18000 1 AZST}
    {846378000 14400 0 AZT}
    {852062400 14400 0 AZT}
    {859680000 18000 1 AZST}
    {877824000 14400 0 AZT}
................................................................................
    {1351382400 14400 0 AZT}
    {1364688000 18000 1 AZST}
    {1382832000 14400 0 AZT}
    {1396137600 18000 1 AZST}
    {1414281600 14400 0 AZT}
    {1427587200 18000 1 AZST}
    {1445731200 14400 0 AZT}








































































































































































}

Added library/tzdata/Asia/Barnaul.


















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Barnaul) {
    {-9223372036854775808 20100 0 LMT}
    {-1579844100 21600 0 +06}
    {-1247551200 25200 0 +08}
    {354906000 28800 1 +08}
    {370713600 25200 0 +07}
    {386442000 28800 1 +08}
    {402249600 25200 0 +07}
    {417978000 28800 1 +08}
    {433785600 25200 0 +07}
    {449600400 28800 1 +08}
    {465332400 25200 0 +07}
    {481057200 28800 1 +08}
    {496782000 25200 0 +07}
    {512506800 28800 1 +08}
    {528231600 25200 0 +07}
    {543956400 28800 1 +08}
    {559681200 25200 0 +07}
    {575406000 28800 1 +08}
    {591130800 25200 0 +07}
    {606855600 28800 1 +08}
    {622580400 25200 0 +07}
    {638305200 28800 1 +08}
    {654634800 25200 0 +07}
    {670359600 21600 0 +07}
    {670363200 25200 1 +07}
    {686088000 21600 0 +06}
    {695764800 25200 0 +08}
    {701809200 28800 1 +08}
    {717534000 25200 0 +07}
    {733258800 28800 1 +08}
    {748983600 25200 0 +07}
    {764708400 28800 1 +08}
    {780433200 25200 0 +07}
    {796158000 28800 1 +08}
    {801594000 25200 0 +07}
    {811886400 21600 0 +06}
    {828216000 25200 1 +07}
    {846360000 21600 0 +06}
    {859665600 25200 1 +07}
    {877809600 21600 0 +06}
    {891115200 25200 1 +07}
    {909259200 21600 0 +06}
    {922564800 25200 1 +07}
    {941313600 21600 0 +06}
    {954014400 25200 1 +07}
    {972763200 21600 0 +06}
    {985464000 25200 1 +07}
    {1004212800 21600 0 +06}
    {1017518400 25200 1 +07}
    {1035662400 21600 0 +06}
    {1048968000 25200 1 +07}
    {1067112000 21600 0 +06}
    {1080417600 25200 1 +07}
    {1099166400 21600 0 +06}
    {1111867200 25200 1 +07}
    {1130616000 21600 0 +06}
    {1143316800 25200 1 +07}
    {1162065600 21600 0 +06}
    {1174766400 25200 1 +07}
    {1193515200 21600 0 +06}
    {1206820800 25200 1 +07}
    {1224964800 21600 0 +06}
    {1238270400 25200 1 +07}
    {1256414400 21600 0 +06}
    {1269720000 25200 1 +07}
    {1288468800 21600 0 +06}
    {1301169600 25200 0 +07}
    {1414263600 21600 0 +06}
    {1459022400 25200 0 +07}
}

Changes to library/tzdata/Asia/Chita.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701791200 36000 1 YAKST}
    {717512400 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701802000 36000 1 YAKST}
    {717526800 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}

Changes to library/tzdata/Asia/Gaza.

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458943200 10800 1 EEST}
    {1476997200 7200 0 EET}
    {1490997600 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522447200 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1553896800 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603400400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1634850000 7200 0 EET}
    {1648245600 10800 1 EEST}
    {1666299600 7200 0 EET}
    {1680300000 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1711749600 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743199200 10800 1 EEST}
    {1761253200 7200 0 EET}
    {1774648800 10800 1 EEST}
    {1792702800 7200 0 EET}
    {1806098400 10800 1 EEST}
    {1824152400 7200 0 EET}
    {1838152800 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1869602400 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1901052000 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1932501600 10800 1 EEST}
    {1950555600 7200 0 EET}
    {1963951200 10800 1 EEST}
    {1982005200 7200 0 EET}
    {1995400800 10800 1 EEST}
    {2013454800 7200 0 EET}
    {2027455200 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2058904800 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090354400 10800 1 EEST}
    {2108408400 7200 0 EET}
    {2121804000 10800 1 EEST}
    {2139858000 7200 0 EET}
    {2153253600 10800 1 EEST}
    {2171307600 7200 0 EET}
    {2184703200 10800 1 EEST}
    {2202757200 7200 0 EET}
    {2216757600 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248207200 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2279656800 10800 1 EEST}
    {2297710800 7200 0 EET}
    {2311106400 10800 1 EEST}
    {2329160400 7200 0 EET}
    {2342556000 10800 1 EEST}
    {2360610000 7200 0 EET}
    {2374610400 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2406060000 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2437509600 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2468959200 10800 1 EEST}
    {2487013200 7200 0 EET}
    {2500408800 10800 1 EEST}
    {2518462800 7200 0 EET}
    {2531858400 10800 1 EEST}
    {2549912400 7200 0 EET}
    {2563912800 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595362400 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2626812000 10800 1 EEST}
    {2644866000 7200 0 EET}
    {2658261600 10800 1 EEST}
    {2676315600 7200 0 EET}
    {2689711200 10800 1 EEST}
    {2707765200 7200 0 EET}
    {2721765600 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753215200 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2784664800 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816114400 10800 1 EEST}
    {2834168400 7200 0 EET}
    {2847564000 10800 1 EEST}
    {2865618000 7200 0 EET}
    {2879013600 10800 1 EEST}
    {2897067600 7200 0 EET}
    {2911068000 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2942517600 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2973967200 10800 1 EEST}
    {2992021200 7200 0 EET}
    {3005416800 10800 1 EEST}
    {3023470800 7200 0 EET}
    {3036866400 10800 1 EEST}
    {3054920400 7200 0 EET}
    {3068316000 10800 1 EEST}
    {3086370000 7200 0 EET}
    {3100370400 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3131820000 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163269600 10800 1 EEST}
    {3181323600 7200 0 EET}
    {3194719200 10800 1 EEST}
    {3212773200 7200 0 EET}
    {3226168800 10800 1 EEST}
    {3244222800 7200 0 EET}
    {3258223200 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3289672800 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321122400 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3352572000 10800 1 EEST}
    {3370626000 7200 0 EET}
    {3384021600 10800 1 EEST}
    {3402075600 7200 0 EET}
    {3415471200 10800 1 EEST}
    {3433525200 7200 0 EET}
    {3447525600 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3478975200 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510424800 10800 1 EEST}
    {3528478800 7200 0 EET}
    {3541874400 10800 1 EEST}
    {3559928400 7200 0 EET}
    {3573324000 10800 1 EEST}
    {3591378000 7200 0 EET}
    {3605378400 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3636828000 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668277600 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3699727200 10800 1 EEST}
    {3717781200 7200 0 EET}
    {3731176800 10800 1 EEST}
    {3749230800 7200 0 EET}
    {3762626400 10800 1 EEST}
    {3780680400 7200 0 EET}
    {3794680800 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826130400 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3857580000 10800 1 EEST}
    {3875634000 7200 0 EET}
    {3889029600 10800 1 EEST}
    {3907083600 7200 0 EET}
    {3920479200 10800 1 EEST}
    {3938533200 7200 0 EET}
    {3951928800 10800 1 EEST}
    {3969982800 7200 0 EET}
    {3983983200 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015432800 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4046882400 10800 1 EEST}
    {4064936400 7200 0 EET}
    {4078332000 10800 1 EEST}
    {4096386000 7200 0 EET}
}






|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|


103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1476997200 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522450800 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1553900400 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585350000 10800 1 EEST}
    {1603400400 7200 0 EET}
    {1616799600 10800 1 EEST}
    {1634850000 7200 0 EET}
    {1648249200 10800 1 EEST}
    {1666299600 7200 0 EET}
    {1679698800 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1711753200 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743202800 10800 1 EEST}
    {1761253200 7200 0 EET}
    {1774652400 10800 1 EEST}
    {1792702800 7200 0 EET}
    {1806102000 10800 1 EEST}
    {1824152400 7200 0 EET}
    {1837551600 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1869606000 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1901055600 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1932505200 10800 1 EEST}
    {1950555600 7200 0 EET}
    {1963954800 10800 1 EEST}
    {1982005200 7200 0 EET}
    {1995404400 10800 1 EEST}
    {2013454800 7200 0 EET}
    {2026854000 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2058908400 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090358000 10800 1 EEST}
    {2108408400 7200 0 EET}
    {2121807600 10800 1 EEST}
    {2139858000 7200 0 EET}
    {2153257200 10800 1 EEST}
    {2171307600 7200 0 EET}
    {2184706800 10800 1 EEST}
    {2202757200 7200 0 EET}
    {2216761200 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248210800 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2279660400 10800 1 EEST}
    {2297710800 7200 0 EET}
    {2311110000 10800 1 EEST}
    {2329160400 7200 0 EET}
    {2342559600 10800 1 EEST}
    {2360610000 7200 0 EET}
    {2374009200 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2406063600 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2437513200 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2468962800 10800 1 EEST}
    {2487013200 7200 0 EET}
    {2500412400 10800 1 EEST}
    {2518462800 7200 0 EET}
    {2531862000 10800 1 EEST}
    {2549912400 7200 0 EET}
    {2563311600 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595366000 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2626815600 10800 1 EEST}
    {2644866000 7200 0 EET}
    {2658265200 10800 1 EEST}
    {2676315600 7200 0 EET}
    {2689714800 10800 1 EEST}
    {2707765200 7200 0 EET}
    {2721164400 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753218800 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2784668400 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816118000 10800 1 EEST}
    {2834168400 7200 0 EET}
    {2847567600 10800 1 EEST}
    {2865618000 7200 0 EET}
    {2879017200 10800 1 EEST}
    {2897067600 7200 0 EET}
    {2910466800 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2942521200 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2973970800 10800 1 EEST}
    {2992021200 7200 0 EET}
    {3005420400 10800 1 EEST}
    {3023470800 7200 0 EET}
    {3036870000 10800 1 EEST}
    {3054920400 7200 0 EET}
    {3068319600 10800 1 EEST}
    {3086370000 7200 0 EET}
    {3100374000 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3131823600 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163273200 10800 1 EEST}
    {3181323600 7200 0 EET}
    {3194722800 10800 1 EEST}
    {3212773200 7200 0 EET}
    {3226172400 10800 1 EEST}
    {3244222800 7200 0 EET}
    {3257622000 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3289676400 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321126000 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3352575600 10800 1 EEST}
    {3370626000 7200 0 EET}
    {3384025200 10800 1 EEST}
    {3402075600 7200 0 EET}
    {3415474800 10800 1 EEST}
    {3433525200 7200 0 EET}
    {3446924400 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3478978800 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510428400 10800 1 EEST}
    {3528478800 7200 0 EET}
    {3541878000 10800 1 EEST}
    {3559928400 7200 0 EET}
    {3573327600 10800 1 EEST}
    {3591378000 7200 0 EET}
    {3604777200 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3636831600 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668281200 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3699730800 10800 1 EEST}
    {3717781200 7200 0 EET}
    {3731180400 10800 1 EEST}
    {3749230800 7200 0 EET}
    {3762630000 10800 1 EEST}
    {3780680400 7200 0 EET}
    {3794079600 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826134000 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3857583600 10800 1 EEST}
    {3875634000 7200 0 EET}
    {3889033200 10800 1 EEST}
    {3907083600 7200 0 EET}
    {3920482800 10800 1 EEST}
    {3938533200 7200 0 EET}
    {3951932400 10800 1 EEST}
    {3969982800 7200 0 EET}
    {3983986800 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015436400 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4046886000 10800 1 EEST}
    {4064936400 7200 0 EET}
    {4078335600 10800 1 EEST}
    {4096386000 7200 0 EET}
}

Changes to library/tzdata/Asia/Hebron.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458943200 10800 1 EEST}
    {1476997200 7200 0 EET}
    {1490997600 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522447200 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1553896800 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603400400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1634850000 7200 0 EET}
    {1648245600 10800 1 EEST}
    {1666299600 7200 0 EET}
    {1680300000 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1711749600 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743199200 10800 1 EEST}
    {1761253200 7200 0 EET}
    {1774648800 10800 1 EEST}
    {1792702800 7200 0 EET}
    {1806098400 10800 1 EEST}
    {1824152400 7200 0 EET}
    {1838152800 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1869602400 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1901052000 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1932501600 10800 1 EEST}
    {1950555600 7200 0 EET}
    {1963951200 10800 1 EEST}
    {1982005200 7200 0 EET}
    {1995400800 10800 1 EEST}
    {2013454800 7200 0 EET}
    {2027455200 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2058904800 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090354400 10800 1 EEST}
    {2108408400 7200 0 EET}
    {2121804000 10800 1 EEST}
    {2139858000 7200 0 EET}
    {2153253600 10800 1 EEST}
    {2171307600 7200 0 EET}
    {2184703200 10800 1 EEST}
    {2202757200 7200 0 EET}
    {2216757600 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248207200 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2279656800 10800 1 EEST}
    {2297710800 7200 0 EET}
    {2311106400 10800 1 EEST}
    {2329160400 7200 0 EET}
    {2342556000 10800 1 EEST}
    {2360610000 7200 0 EET}
    {2374610400 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2406060000 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2437509600 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2468959200 10800 1 EEST}
    {2487013200 7200 0 EET}
    {2500408800 10800 1 EEST}
    {2518462800 7200 0 EET}
    {2531858400 10800 1 EEST}
    {2549912400 7200 0 EET}
    {2563912800 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595362400 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2626812000 10800 1 EEST}
    {2644866000 7200 0 EET}
    {2658261600 10800 1 EEST}
    {2676315600 7200 0 EET}
    {2689711200 10800 1 EEST}
    {2707765200 7200 0 EET}
    {2721765600 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753215200 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2784664800 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816114400 10800 1 EEST}
    {2834168400 7200 0 EET}
    {2847564000 10800 1 EEST}
    {2865618000 7200 0 EET}
    {2879013600 10800 1 EEST}
    {2897067600 7200 0 EET}
    {2911068000 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2942517600 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2973967200 10800 1 EEST}
    {2992021200 7200 0 EET}
    {3005416800 10800 1 EEST}
    {3023470800 7200 0 EET}
    {3036866400 10800 1 EEST}
    {3054920400 7200 0 EET}
    {3068316000 10800 1 EEST}
    {3086370000 7200 0 EET}
    {3100370400 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3131820000 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163269600 10800 1 EEST}
    {3181323600 7200 0 EET}
    {3194719200 10800 1 EEST}
    {3212773200 7200 0 EET}
    {3226168800 10800 1 EEST}
    {3244222800 7200 0 EET}
    {3258223200 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3289672800 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321122400 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3352572000 10800 1 EEST}
    {3370626000 7200 0 EET}
    {3384021600 10800 1 EEST}
    {3402075600 7200 0 EET}
    {3415471200 10800 1 EEST}
    {3433525200 7200 0 EET}
    {3447525600 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3478975200 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510424800 10800 1 EEST}
    {3528478800 7200 0 EET}
    {3541874400 10800 1 EEST}
    {3559928400 7200 0 EET}
    {3573324000 10800 1 EEST}
    {3591378000 7200 0 EET}
    {3605378400 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3636828000 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668277600 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3699727200 10800 1 EEST}
    {3717781200 7200 0 EET}
    {3731176800 10800 1 EEST}
    {3749230800 7200 0 EET}
    {3762626400 10800 1 EEST}
    {3780680400 7200 0 EET}
    {3794680800 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826130400 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3857580000 10800 1 EEST}
    {3875634000 7200 0 EET}
    {3889029600 10800 1 EEST}
    {3907083600 7200 0 EET}
    {3920479200 10800 1 EEST}
    {3938533200 7200 0 EET}
    {3951928800 10800 1 EEST}
    {3969982800 7200 0 EET}
    {3983983200 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015432800 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4046882400 10800 1 EEST}
    {4064936400 7200 0 EET}
    {4078332000 10800 1 EEST}
    {4096386000 7200 0 EET}
}






|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|


102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1476997200 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522450800 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1553900400 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585350000 10800 1 EEST}
    {1603400400 7200 0 EET}
    {1616799600 10800 1 EEST}
    {1634850000 7200 0 EET}
    {1648249200 10800 1 EEST}
    {1666299600 7200 0 EET}
    {1679698800 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1711753200 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743202800 10800 1 EEST}
    {1761253200 7200 0 EET}
    {1774652400 10800 1 EEST}
    {1792702800 7200 0 EET}
    {1806102000 10800 1 EEST}
    {1824152400 7200 0 EET}
    {1837551600 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1869606000 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1901055600 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1932505200 10800 1 EEST}
    {1950555600 7200 0 EET}
    {1963954800 10800 1 EEST}
    {1982005200 7200 0 EET}
    {1995404400 10800 1 EEST}
    {2013454800 7200 0 EET}
    {2026854000 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2058908400 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090358000 10800 1 EEST}
    {2108408400 7200 0 EET}
    {2121807600 10800 1 EEST}
    {2139858000 7200 0 EET}
    {2153257200 10800 1 EEST}
    {2171307600 7200 0 EET}
    {2184706800 10800 1 EEST}
    {2202757200 7200 0 EET}
    {2216761200 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248210800 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2279660400 10800 1 EEST}
    {2297710800 7200 0 EET}
    {2311110000 10800 1 EEST}
    {2329160400 7200 0 EET}
    {2342559600 10800 1 EEST}
    {2360610000 7200 0 EET}
    {2374009200 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2406063600 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2437513200 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2468962800 10800 1 EEST}
    {2487013200 7200 0 EET}
    {2500412400 10800 1 EEST}
    {2518462800 7200 0 EET}
    {2531862000 10800 1 EEST}
    {2549912400 7200 0 EET}
    {2563311600 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595366000 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2626815600 10800 1 EEST}
    {2644866000 7200 0 EET}
    {2658265200 10800 1 EEST}
    {2676315600 7200 0 EET}
    {2689714800 10800 1 EEST}
    {2707765200 7200 0 EET}
    {2721164400 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753218800 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2784668400 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816118000 10800 1 EEST}
    {2834168400 7200 0 EET}
    {2847567600 10800 1 EEST}
    {2865618000 7200 0 EET}
    {2879017200 10800 1 EEST}
    {2897067600 7200 0 EET}
    {2910466800 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2942521200 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2973970800 10800 1 EEST}
    {2992021200 7200 0 EET}
    {3005420400 10800 1 EEST}
    {3023470800 7200 0 EET}
    {3036870000 10800 1 EEST}
    {3054920400 7200 0 EET}
    {3068319600 10800 1 EEST}
    {3086370000 7200 0 EET}
    {3100374000 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3131823600 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163273200 10800 1 EEST}
    {3181323600 7200 0 EET}
    {3194722800 10800 1 EEST}
    {3212773200 7200 0 EET}
    {3226172400 10800 1 EEST}
    {3244222800 7200 0 EET}
    {3257622000 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3289676400 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321126000 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3352575600 10800 1 EEST}
    {3370626000 7200 0 EET}
    {3384025200 10800 1 EEST}
    {3402075600 7200 0 EET}
    {3415474800 10800 1 EEST}
    {3433525200 7200 0 EET}
    {3446924400 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3478978800 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510428400 10800 1 EEST}
    {3528478800 7200 0 EET}
    {3541878000 10800 1 EEST}
    {3559928400 7200 0 EET}
    {3573327600 10800 1 EEST}
    {3591378000 7200 0 EET}
    {3604777200 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3636831600 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668281200 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3699730800 10800 1 EEST}
    {3717781200 7200 0 EET}
    {3731180400 10800 1 EEST}
    {3749230800 7200 0 EET}
    {3762630000 10800 1 EEST}
    {3780680400 7200 0 EET}
    {3794079600 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826134000 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3857583600 10800 1 EEST}
    {3875634000 7200 0 EET}
    {3889033200 10800 1 EEST}
    {3907083600 7200 0 EET}
    {3920482800 10800 1 EEST}
    {3938533200 7200 0 EET}
    {3951932400 10800 1 EEST}
    {3969982800 7200 0 EET}
    {3983986800 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015436400 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4046886000 10800 1 EEST}
    {4064936400 7200 0 EET}
    {4078335600 10800 1 EEST}
    {4096386000 7200 0 EET}
}

Changes to library/tzdata/Asia/Irkutsk.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622576800 28800 0 IRKT}
    {638301600 32400 1 IRKST}
    {654631200 28800 0 IRKT}
    {670356000 25200 0 IRKMMTT}
    {670359600 28800 1 IRKST}
    {686084400 25200 0 IRKT}
    {695761200 28800 0 IRKMMTT}
    {701794800 32400 1 IRKST}
    {717516000 28800 0 IRKT}
    {733255200 32400 1 IRKST}
    {748980000 28800 0 IRKT}
    {764704800 32400 1 IRKST}
    {780429600 28800 0 IRKT}
    {796154400 32400 1 IRKST}
    {811879200 28800 0 IRKT}
    {828208800 32400 1 IRKST}






|
|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622576800 28800 0 IRKT}
    {638301600 32400 1 IRKST}
    {654631200 28800 0 IRKT}
    {670356000 25200 0 IRKMMTT}
    {670359600 28800 1 IRKST}
    {686084400 25200 0 IRKT}
    {695761200 28800 0 IRKMMTT}
    {701805600 32400 1 IRKST}
    {717530400 28800 0 IRKT}
    {733255200 32400 1 IRKST}
    {748980000 28800 0 IRKT}
    {764704800 32400 1 IRKST}
    {780429600 28800 0 IRKT}
    {796154400 32400 1 IRKST}
    {811879200 28800 0 IRKT}
    {828208800 32400 1 IRKST}

Changes to library/tzdata/Asia/Kamchatka.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622562400 43200 0 PETT}
    {638287200 46800 1 PETST}
    {654616800 43200 0 PETT}
    {670341600 39600 0 PETMMTT}
    {670345200 43200 1 PETST}
    {686070000 39600 0 PETT}
    {695746800 43200 0 PETMMTT}
    {701780400 46800 1 PETST}
    {717501600 43200 0 PETT}
    {733240800 46800 1 PETST}
    {748965600 43200 0 PETT}
    {764690400 46800 1 PETST}
    {780415200 43200 0 PETT}
    {796140000 46800 1 PETST}
    {811864800 43200 0 PETT}
    {828194400 46800 1 PETST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622562400 43200 0 PETT}
    {638287200 46800 1 PETST}
    {654616800 43200 0 PETT}
    {670341600 39600 0 PETMMTT}
    {670345200 43200 1 PETST}
    {686070000 39600 0 PETT}
    {695746800 43200 0 PETMMTT}
    {701791200 46800 1 PETST}
    {717516000 43200 0 PETT}
    {733240800 46800 1 PETST}
    {748965600 43200 0 PETT}
    {764690400 46800 1 PETST}
    {780415200 43200 0 PETT}
    {796140000 46800 1 PETST}
    {811864800 43200 0 PETT}
    {828194400 46800 1 PETST}

Changes to library/tzdata/Asia/Khandyga.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701791200 36000 1 YAKST}
    {717512400 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701802000 36000 1 YAKST}
    {717526800 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}

Changes to library/tzdata/Asia/Krasnoyarsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 KRAT}
    {638305200 28800 1 KRAST}
    {654634800 25200 0 KRAT}
    {670359600 21600 0 KRAMMTT}
    {670363200 25200 1 KRAST}
    {686088000 21600 0 KRAT}
    {695764800 25200 0 KRAMMTT}
    {701798400 28800 1 KRAST}
    {717519600 25200 0 KRAT}
    {733258800 28800 1 KRAST}
    {748983600 25200 0 KRAT}
    {764708400 28800 1 KRAST}
    {780433200 25200 0 KRAT}
    {796158000 28800 1 KRAST}
    {811882800 25200 0 KRAT}
    {828212400 28800 1 KRAST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 KRAT}
    {638305200 28800 1 KRAST}
    {654634800 25200 0 KRAT}
    {670359600 21600 0 KRAMMTT}
    {670363200 25200 1 KRAST}
    {686088000 21600 0 KRAT}
    {695764800 25200 0 KRAMMTT}
    {701809200 28800 1 KRAST}
    {717534000 25200 0 KRAT}
    {733258800 28800 1 KRAST}
    {748983600 25200 0 KRAT}
    {764708400 28800 1 KRAST}
    {780433200 25200 0 KRAT}
    {796158000 28800 1 KRAST}
    {811882800 25200 0 KRAT}
    {828212400 28800 1 KRAST}

Changes to library/tzdata/Asia/Magadan.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
64
65
66
67
68
69
70

71
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701784000 43200 1 MAGST}
    {717505200 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}
................................................................................
    {1224946800 39600 0 MAGT}
    {1238252400 43200 1 MAGST}
    {1256396400 39600 0 MAGT}
    {1269702000 43200 1 MAGST}
    {1288450800 39600 0 MAGT}
    {1301151600 43200 0 MAGT}
    {1414245600 36000 0 MAGT}

}






|
|







 







>

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
64
65
66
67
68
69
70
71
72
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701794800 43200 1 MAGST}
    {717519600 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}
................................................................................
    {1224946800 39600 0 MAGT}
    {1238252400 43200 1 MAGST}
    {1256396400 39600 0 MAGT}
    {1269702000 43200 1 MAGST}
    {1288450800 39600 0 MAGT}
    {1301151600 43200 0 MAGT}
    {1414245600 36000 0 MAGT}
    {1461427200 39600 0 MAGT}
}

Changes to library/tzdata/Asia/Novokuznetsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 KRAT}
    {638305200 28800 1 KRAST}
    {654634800 25200 0 KRAT}
    {670359600 21600 0 KRAMMTT}
    {670363200 25200 1 KRAST}
    {686088000 21600 0 KRAT}
    {695764800 25200 0 KRAMMTT}
    {701798400 28800 1 KRAST}
    {717519600 25200 0 KRAT}
    {733258800 28800 1 KRAST}
    {748983600 25200 0 KRAT}
    {764708400 28800 1 KRAST}
    {780433200 25200 0 KRAT}
    {796158000 28800 1 KRAST}
    {811882800 25200 0 KRAT}
    {828212400 28800 1 KRAST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 KRAT}
    {638305200 28800 1 KRAST}
    {654634800 25200 0 KRAT}
    {670359600 21600 0 KRAMMTT}
    {670363200 25200 1 KRAST}
    {686088000 21600 0 KRAT}
    {695764800 25200 0 KRAMMTT}
    {701809200 28800 1 KRAST}
    {717534000 25200 0 KRAT}
    {733258800 28800 1 KRAST}
    {748983600 25200 0 KRAT}
    {764708400 28800 1 KRAST}
    {780433200 25200 0 KRAT}
    {796158000 28800 1 KRAST}
    {811882800 25200 0 KRAT}
    {828212400 28800 1 KRAST}

Changes to library/tzdata/Asia/Novosibirsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 NOVT}
    {638305200 28800 1 NOVST}
    {654634800 25200 0 NOVT}
    {670359600 21600 0 NOVMMTT}
    {670363200 25200 1 NOVST}
    {686088000 21600 0 NOVT}
    {695764800 25200 0 NOVMMTT}
    {701798400 28800 1 NOVST}
    {717519600 25200 0 NOVT}
    {733258800 28800 1 NOVST}
    {738090000 25200 0 NOVST}
    {748987200 21600 0 NOVT}
    {764712000 25200 1 NOVST}
    {780436800 21600 0 NOVT}
    {796161600 25200 1 NOVST}
    {811886400 21600 0 NOVT}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622580400 25200 0 NOVT}
    {638305200 28800 1 NOVST}
    {654634800 25200 0 NOVT}
    {670359600 21600 0 NOVMMTT}
    {670363200 25200 1 NOVST}
    {686088000 21600 0 NOVT}
    {695764800 25200 0 NOVMMTT}
    {701809200 28800 1 NOVST}
    {717534000 25200 0 NOVT}
    {733258800 28800 1 NOVST}
    {738090000 25200 0 NOVST}
    {748987200 21600 0 NOVT}
    {764712000 25200 1 NOVST}
    {780436800 21600 0 NOVT}
    {796161600 25200 1 NOVST}
    {811886400 21600 0 NOVT}

Changes to library/tzdata/Asia/Omsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622584000 21600 0 OMST}
    {638308800 25200 1 OMSST}
    {654638400 21600 0 OMST}
    {670363200 18000 0 OMSMMTT}
    {670366800 21600 1 OMSST}
    {686091600 18000 0 OMST}
    {695768400 21600 0 OMSMMTT}
    {701802000 25200 1 OMSST}
    {717523200 21600 0 OMST}
    {733262400 25200 1 OMSST}
    {748987200 21600 0 OMST}
    {764712000 25200 1 OMSST}
    {780436800 21600 0 OMST}
    {796161600 25200 1 OMSST}
    {811886400 21600 0 OMST}
    {828216000 25200 1 OMSST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622584000 21600 0 OMST}
    {638308800 25200 1 OMSST}
    {654638400 21600 0 OMST}
    {670363200 18000 0 OMSMMTT}
    {670366800 21600 1 OMSST}
    {686091600 18000 0 OMST}
    {695768400 21600 0 OMSMMTT}
    {701812800 25200 1 OMSST}
    {717537600 21600 0 OMST}
    {733262400 25200 1 OMSST}
    {748987200 21600 0 OMST}
    {764712000 25200 1 OMSST}
    {780436800 21600 0 OMST}
    {796161600 25200 1 OMSST}
    {811886400 21600 0 OMST}
    {828216000 25200 1 OMSST}

Changes to library/tzdata/Asia/Oral.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Oral) {
    {-9223372036854775808 12324 0 LMT}
    {-1441164324 14400 0 URAT}
    {-1247544000 18000 0 URAT}
    {354913200 21600 1 URAST}
    {370720800 21600 0 URAT}
    {386445600 18000 0 URAT}
    {386449200 21600 1 URAST}
    {402256800 18000 0 URAT}
    {417985200 21600 1 URAST}
    {433792800 18000 0 URAT}
    {449607600 21600 1 URAST}
    {465339600 18000 0 URAT}
    {481064400 21600 1 URAST}
    {496789200 18000 0 URAT}
    {512514000 21600 1 URAST}
    {528238800 18000 0 URAT}
    {543963600 21600 1 URAST}
    {559688400 18000 0 URAT}
    {575413200 21600 1 URAST}
    {591138000 18000 0 URAT}
    {606862800 14400 0 URAT}
    {606866400 18000 1 URAST}
    {622591200 14400 0 URAT}
    {638316000 18000 1 URAST}
    {654645600 14400 0 URAT}

    {662673600 14400 0 URAT}
    {692827200 14400 0 ORAT}
    {701809200 18000 1 ORAST}
    {717530400 14400 0 ORAT}
    {733269600 18000 1 ORAST}
    {748994400 14400 0 ORAT}
    {764719200 18000 1 ORAST}
    {780444000 14400 0 ORAT}
    {796168800 18000 1 ORAST}
    {811893600 14400 0 ORAT}
    {828223200 18000 1 ORAST}
    {846367200 14400 0 ORAT}
    {859672800 18000 1 ORAST}
    {877816800 14400 0 ORAT}
    {891122400 18000 1 ORAST}
    {909266400 14400 0 ORAT}
    {922572000 18000 1 ORAST}
    {941320800 14400 0 ORAT}
    {954021600 18000 1 ORAST}
    {972770400 14400 0 ORAT}
    {985471200 18000 1 ORAST}
    {1004220000 14400 0 ORAT}
    {1017525600 18000 1 ORAST}
    {1035669600 14400 0 ORAT}
    {1048975200 18000 1 ORAST}
    {1067119200 14400 0 ORAT}
    {1080424800 18000 1 ORAST}
    {1099173600 14400 0 ORAT}
    {1110830400 18000 0 ORAT}
}



|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Oral) {
    {-9223372036854775808 12324 0 LMT}
    {-1441164324 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {591138000 18000 0 +05}
    {606862800 14400 0 +04}
    {606866400 18000 1 +05}
    {622591200 14400 0 +04}
    {638316000 18000 1 +05}
    {654645600 14400 0 +04}
    {670370400 18000 1 +05}
    {686095200 14400 0 +04}
    {701816400 14400 0 +04}
    {701820000 18000 1 +05}
    {717544800 14400 0 +04}
    {733269600 18000 1 +05}
    {748994400 14400 0 +04}
    {764719200 18000 1 +05}
    {780444000 14400 0 +04}
    {796168800 18000 1 +05}
    {811893600 14400 0 +04}
    {828223200 18000 1 +05}
    {846367200 14400 0 +04}
    {859672800 18000 1 +05}
    {877816800 14400 0 +04}
    {891122400 18000 1 +05}
    {909266400 14400 0 +04}
    {922572000 18000 1 +05}
    {941320800 14400 0 +04}
    {954021600 18000 1 +05}
    {972770400 14400 0 +04}
    {985471200 18000 1 +05}
    {1004220000 14400 0 +04}
    {1017525600 18000 1 +05}
    {1035669600 14400 0 +04}
    {1048975200 18000 1 +05}
    {1067119200 14400 0 +04}
    {1080424800 18000 1 +05}
    {1099173600 18000 0 +05}

}

Changes to library/tzdata/Asia/Qyzylorda.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Qyzylorda) {
    {-9223372036854775808 15712 0 LMT}
    {-1441167712 14400 0 KIZT}
    {-1247544000 18000 0 KIZT}
    {354913200 21600 1 KIZST}
    {370720800 21600 0 KIZT}
    {386445600 18000 0 KIZT}
    {386449200 21600 1 KIZST}
    {402256800 18000 0 KIZT}
    {417985200 21600 1 KIZST}
    {433792800 18000 0 KIZT}
    {449607600 21600 1 KIZST}
    {465339600 18000 0 KIZT}
    {481064400 21600 1 KIZST}
    {496789200 18000 0 KIZT}
    {512514000 21600 1 KIZST}
    {528238800 18000 0 KIZT}
    {543963600 21600 1 KIZST}
    {559688400 18000 0 KIZT}
    {575413200 21600 1 KIZST}
    {591138000 18000 0 KIZT}
    {606862800 21600 1 KIZST}
    {622587600 18000 0 KIZT}
    {638312400 21600 1 KIZST}
    {654642000 18000 0 KIZT}
    {662670000 18000 0 KIZT}

    {692823600 18000 0 QYZT}
    {695768400 21600 0 QYZT}
    {701802000 25200 1 QYZST}
    {717523200 21600 0 QYZT}
    {733262400 25200 1 QYZST}
    {748987200 21600 0 QYZT}
    {764712000 25200 1 QYZST}
    {780436800 21600 0 QYZT}
    {796161600 25200 1 QYZST}
    {811886400 21600 0 QYZT}
    {828216000 25200 1 QYZST}
    {846360000 21600 0 QYZT}
    {859665600 25200 1 QYZST}
    {877809600 21600 0 QYZT}
    {891115200 25200 1 QYZST}
    {909259200 21600 0 QYZT}
    {922564800 25200 1 QYZST}
    {941313600 21600 0 QYZT}
    {954014400 25200 1 QYZST}
    {972763200 21600 0 QYZT}
    {985464000 25200 1 QYZST}
    {1004212800 21600 0 QYZT}
    {1017518400 25200 1 QYZST}
    {1035662400 21600 0 QYZT}
    {1048968000 25200 1 QYZST}
    {1067112000 21600 0 QYZT}
    {1080417600 25200 1 QYZST}
    {1099166400 21600 0 QYZT}
    {1110823200 21600 0 QYZT}
}



|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

57
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Qyzylorda) {
    {-9223372036854775808 15712 0 LMT}
    {-1441167712 14400 0 +04}
    {-1247544000 18000 0 +05}
    {354913200 21600 1 +06}
    {370720800 21600 0 +06}
    {386445600 18000 0 +05}
    {386449200 21600 1 +06}
    {402256800 18000 0 +05}
    {417985200 21600 1 +06}
    {433792800 18000 0 +05}
    {449607600 21600 1 +06}
    {465339600 18000 0 +05}
    {481064400 21600 1 +06}
    {496789200 18000 0 +05}
    {512514000 21600 1 +06}
    {528238800 18000 0 +05}
    {543963600 21600 1 +06}
    {559688400 18000 0 +05}
    {575413200 21600 1 +06}
    {591138000 18000 0 +05}
    {606862800 21600 1 +06}
    {622587600 18000 0 +05}
    {638312400 21600 1 +06}
    {654642000 18000 0 +05}
    {670366800 14400 0 +04}
    {670370400 18000 1 +05}
    {701812800 18000 0 +05}
    {701816400 21600 1 +06}

    {717541200 18000 0 +05}
    {733266000 21600 1 +06}
    {748990800 18000 0 +05}
    {764715600 21600 1 +06}
    {780440400 18000 0 +05}
    {796165200 21600 1 +06}
    {811890000 18000 0 +05}
    {828219600 21600 1 +06}
    {846363600 18000 0 +05}
    {859669200 21600 1 +06}
    {877813200 18000 0 +05}
    {891118800 21600 1 +06}
    {909262800 18000 0 +05}
    {922568400 21600 1 +06}
    {941317200 18000 0 +05}
    {954018000 21600 1 +06}
    {972766800 18000 0 +05}
    {985467600 21600 1 +06}
    {1004216400 18000 0 +05}
    {1017522000 21600 1 +06}
    {1035666000 18000 0 +05}
    {1048971600 21600 1 +06}
    {1067115600 18000 0 +05}
    {1080421200 21600 1 +06}
    {1099170000 21600 0 +06}

}

Changes to library/tzdata/Asia/Sakhalin.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
..
66
67
68
69
70
71
72

73
    {622566000 39600 0 SAKT}
    {638290800 43200 1 SAKST}
    {654620400 39600 0 SAKT}
    {670345200 36000 0 SAKMMTT}
    {670348800 39600 1 SAKST}
    {686073600 36000 0 SAKT}
    {695750400 39600 0 SAKMMTT}
    {701784000 43200 1 SAKST}
    {717505200 39600 0 SAKT}
    {733244400 43200 1 SAKST}
    {748969200 39600 0 SAKT}
    {764694000 43200 1 SAKST}
    {780418800 39600 0 SAKT}
    {796143600 43200 1 SAKST}
    {811868400 39600 0 SAKT}
    {828198000 43200 1 SAKST}
................................................................................
    {1224950400 36000 0 SAKT}
    {1238256000 39600 1 SAKST}
    {1256400000 36000 0 SAKT}
    {1269705600 39600 1 SAKST}
    {1288454400 36000 0 SAKT}
    {1301155200 39600 0 SAKT}
    {1414249200 36000 0 SAKT}

}






|
|







 







>

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
..
66
67
68
69
70
71
72
73
74
    {622566000 39600 0 SAKT}
    {638290800 43200 1 SAKST}
    {654620400 39600 0 SAKT}
    {670345200 36000 0 SAKMMTT}
    {670348800 39600 1 SAKST}
    {686073600 36000 0 SAKT}
    {695750400 39600 0 SAKMMTT}
    {701794800 43200 1 SAKST}
    {717519600 39600 0 SAKT}
    {733244400 43200 1 SAKST}
    {748969200 39600 0 SAKT}
    {764694000 43200 1 SAKST}
    {780418800 39600 0 SAKT}
    {796143600 43200 1 SAKST}
    {811868400 39600 0 SAKT}
    {828198000 43200 1 SAKST}
................................................................................
    {1224950400 36000 0 SAKT}
    {1238256000 39600 1 SAKST}
    {1256400000 36000 0 SAKT}
    {1269705600 39600 1 SAKST}
    {1288454400 36000 0 SAKT}
    {1301155200 39600 0 SAKT}
    {1414249200 36000 0 SAKT}
    {1459008000 39600 0 SAKT}
}

Changes to library/tzdata/Asia/Srednekolymsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701784000 43200 1 MAGST}
    {717505200 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701794800 43200 1 MAGST}
    {717519600 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}

Added library/tzdata/Asia/Tomsk.


















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tomsk) {
    {-9223372036854775808 20391 0 LMT}
    {-1578807591 21600 0 +06}
    {-1247551200 25200 0 +08}
    {354906000 28800 1 +08}
    {370713600 25200 0 +07}
    {386442000 28800 1 +08}
    {402249600 25200 0 +07}
    {417978000 28800 1 +08}
    {433785600 25200 0 +07}
    {449600400 28800 1 +08}
    {465332400 25200 0 +07}
    {481057200 28800 1 +08}
    {496782000 25200 0 +07}
    {512506800 28800 1 +08}
    {528231600 25200 0 +07}
    {543956400 28800 1 +08}
    {559681200 25200 0 +07}
    {575406000 28800 1 +08}
    {591130800 25200 0 +07}
    {606855600 28800 1 +08}
    {622580400 25200 0 +07}
    {638305200 28800 1 +08}
    {654634800 25200 0 +07}
    {670359600 21600 0 +07}
    {670363200 25200 1 +07}
    {686088000 21600 0 +06}
    {695764800 25200 0 +08}
    {701809200 28800 1 +08}
    {717534000 25200 0 +07}
    {733258800 28800 1 +08}
    {748983600 25200 0 +07}
    {764708400 28800 1 +08}
    {780433200 25200 0 +07}
    {796158000 28800 1 +08}
    {811882800 25200 0 +07}
    {828212400 28800 1 +08}
    {846356400 25200 0 +07}
    {859662000 28800 1 +08}
    {877806000 25200 0 +07}
    {891111600 28800 1 +08}
    {909255600 25200 0 +07}
    {922561200 28800 1 +08}
    {941310000 25200 0 +07}
    {954010800 28800 1 +08}
    {972759600 25200 0 +07}
    {985460400 28800 1 +08}
    {1004209200 25200 0 +07}
    {1017514800 28800 1 +08}
    {1020196800 25200 0 +07}
    {1035662400 21600 0 +06}
    {1048968000 25200 1 +07}
    {1067112000 21600 0 +06}
    {1080417600 25200 1 +07}
    {1099166400 21600 0 +06}
    {1111867200 25200 1 +07}
    {1130616000 21600 0 +06}
    {1143316800 25200 1 +07}
    {1162065600 21600 0 +06}
    {1174766400 25200 1 +07}
    {1193515200 21600 0 +06}
    {1206820800 25200 1 +07}
    {1224964800 21600 0 +06}
    {1238270400 25200 1 +07}
    {1256414400 21600 0 +06}
    {1269720000 25200 1 +07}
    {1288468800 21600 0 +06}
    {1301169600 25200 0 +07}
    {1414263600 21600 0 +06}
    {1464465600 25200 0 +07}
}

Changes to library/tzdata/Asia/Ust-Nera.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701784000 43200 1 MAGST}
    {717505200 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}






|
|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
    {622566000 39600 0 MAGT}
    {638290800 43200 1 MAGST}
    {654620400 39600 0 MAGT}
    {670345200 36000 0 MAGMMTT}
    {670348800 39600 1 MAGST}
    {686073600 36000 0 MAGT}
    {695750400 39600 0 MAGMMTT}
    {701794800 43200 1 MAGST}
    {717519600 39600 0 MAGT}
    {733244400 43200 1 MAGST}
    {748969200 39600 0 MAGT}
    {764694000 43200 1 MAGST}
    {780418800 39600 0 MAGT}
    {796143600 43200 1 MAGST}
    {811868400 39600 0 MAGT}
    {828198000 43200 1 MAGST}

Changes to library/tzdata/Asia/Vladivostok.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622569600 36000 0 VLAT}
    {638294400 39600 1 VLAST}
    {654624000 36000 0 VLAT}
    {670348800 32400 0 VLAMMTT}
    {670352400 36000 1 VLAST}
    {686077200 32400 0 VLAT}
    {695754000 36000 0 VLAMMTT}
    {701787600 39600 1 VLAST}
    {717508800 36000 0 VLAT}
    {733248000 39600 1 VLAST}
    {748972800 36000 0 VLAT}
    {764697600 39600 1 VLAST}
    {780422400 36000 0 VLAT}
    {796147200 39600 1 VLAST}
    {811872000 36000 0 VLAT}
    {828201600 39600 1 VLAST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622569600 36000 0 VLAT}
    {638294400 39600 1 VLAST}
    {654624000 36000 0 VLAT}
    {670348800 32400 0 VLAMMTT}
    {670352400 36000 1 VLAST}
    {686077200 32400 0 VLAT}
    {695754000 36000 0 VLAMMTT}
    {701798400 39600 1 VLAST}
    {717523200 36000 0 VLAT}
    {733248000 39600 1 VLAST}
    {748972800 36000 0 VLAT}
    {764697600 39600 1 VLAST}
    {780422400 36000 0 VLAT}
    {796147200 39600 1 VLAST}
    {811872000 36000 0 VLAT}
    {828201600 39600 1 VLAST}

Changes to library/tzdata/Asia/Yakutsk.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701791200 36000 1 YAKST}
    {717512400 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}






|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {622573200 32400 0 YAKT}
    {638298000 36000 1 YAKST}
    {654627600 32400 0 YAKT}
    {670352400 28800 0 YAKMMTT}
    {670356000 32400 1 YAKST}
    {686080800 28800 0 YAKT}
    {695757600 32400 0 YAKMMTT}
    {701802000 36000 1 YAKST}
    {717526800 32400 0 YAKT}
    {733251600 36000 1 YAKST}
    {748976400 32400 0 YAKT}
    {764701200 36000 1 YAKST}
    {780426000 32400 0 YAKT}
    {796150800 36000 1 YAKST}
    {811875600 32400 0 YAKT}
    {828205200 36000 1 YAKST}

Changes to library/tzdata/Asia/Yekaterinburg.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622587600 18000 0 SVET}
    {638312400 21600 1 SVEST}
    {654642000 18000 0 SVET}
    {670366800 14400 0 SVEMMTT}
    {670370400 18000 1 SVEST}
    {686095200 14400 0 SVET}
    {695772000 18000 0 YEKMMTT}
    {701805600 21600 1 YEKST}
    {717526800 18000 0 YEKT}
    {733266000 21600 1 YEKST}
    {748990800 18000 0 YEKT}
    {764715600 21600 1 YEKST}
    {780440400 18000 0 YEKT}
    {796165200 21600 1 YEKST}
    {811890000 18000 0 YEKT}
    {828219600 21600 1 YEKST}






|
|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {622587600 18000 0 SVET}
    {638312400 21600 1 SVEST}
    {654642000 18000 0 SVET}
    {670366800 14400 0 SVEMMTT}
    {670370400 18000 1 SVEST}
    {686095200 14400 0 SVET}
    {695772000 18000 0 YEKMMTT}
    {701816400 21600 1 YEKST}
    {717541200 18000 0 YEKT}
    {733266000 21600 1 YEKST}
    {748990800 18000 0 YEKT}
    {764715600 21600 1 YEKST}
    {780440400 18000 0 YEKT}
    {796165200 21600 1 YEKST}
    {811890000 18000 0 YEKT}
    {828219600 21600 1 YEKST}

Changes to library/tzdata/Asia/Yerevan.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
62
63
64
65
66
67
68
69
70
    {606866400 18000 1 YERST}
    {622591200 14400 0 YERT}
    {638316000 18000 1 YERST}
    {654645600 14400 0 YERT}
    {670370400 14400 1 YERST}
    {685569600 14400 0 AMST}
    {686098800 10800 0 AMT}
    {701812800 14400 1 AMST}
    {717534000 10800 0 AMT}
    {733273200 14400 1 AMST}
    {748998000 10800 0 AMT}
    {764722800 14400 1 AMST}
    {780447600 10800 0 AMT}
    {796172400 14400 1 AMST}
    {811897200 14400 0 AMT}
    {852062400 14400 0 AMT}
................................................................................
    {1224972000 14400 0 AMT}
    {1238277600 18000 1 AMST}
    {1256421600 14400 0 AMT}
    {1269727200 18000 1 AMST}
    {1288476000 14400 0 AMT}
    {1301176800 18000 1 AMST}
    {1319925600 14400 0 AMT}
    {1332626400 14400 0 AMT}
}






|
|







 







|

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
62
63
64
65
66
67
68
69
70
    {606866400 18000 1 YERST}
    {622591200 14400 0 YERT}
    {638316000 18000 1 YERST}
    {654645600 14400 0 YERT}
    {670370400 14400 1 YERST}
    {685569600 14400 0 AMST}
    {686098800 10800 0 AMT}
    {701823600 14400 1 AMST}
    {717548400 10800 0 AMT}
    {733273200 14400 1 AMST}
    {748998000 10800 0 AMT}
    {764722800 14400 1 AMST}
    {780447600 10800 0 AMT}
    {796172400 14400 1 AMST}
    {811897200 14400 0 AMT}
    {852062400 14400 0 AMT}
................................................................................
    {1224972000 14400 0 AMT}
    {1238277600 18000 1 AMST}
    {1256421600 14400 0 AMT}
    {1269727200 18000 1 AMST}
    {1288476000 14400 0 AMT}
    {1301176800 18000 1 AMST}
    {1319925600 14400 0 AMT}
    {1328731200 14400 0 AMT}
}

Added library/tzdata/Europe/Astrakhan.














































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Astrakhan) {
    {-9223372036854775808 11532 0 LMT}
    {-1441249932 10800 0 +03}
    {-1247540400 14400 0 +05}
    {354916800 18000 1 +05}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {591141600 14400 0 +04}
    {606866400 10800 0 +04}
    {606870000 14400 1 +04}
    {622594800 10800 0 +03}
    {638319600 14400 1 +04}
    {654649200 10800 0 +03}
    {670374000 14400 0 +04}
    {701820000 10800 0 +04}
    {701823600 14400 1 +04}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {811897200 10800 0 +03}
    {828226800 14400 1 +04}
    {846370800 10800 0 +03}
    {859676400 14400 1 +04}
    {877820400 10800 0 +03}
    {891126000 14400 1 +04}
    {909270000 10800 0 +03}
    {922575600 14400 1 +04}
    {941324400 10800 0 +03}
    {954025200 14400 1 +04}
    {972774000 10800 0 +03}
    {985474800 14400 1 +04}
    {1004223600 10800 0 +03}
    {1017529200 14400 1 +04}
    {1035673200 10800 0 +03}
    {1048978800 14400 1 +04}
    {1067122800 10800 0 +03}
    {1080428400 14400 1 +04}
    {1099177200 10800 0 +03}
    {1111878000 14400 1 +04}
    {1130626800 10800 0 +03}
    {1143327600 14400 1 +04}
    {1162076400 10800 0 +03}
    {1174777200 14400 1 +04}
    {1193526000 10800 0 +03}
    {1206831600 14400 1 +04}
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
    {1459033200 14400 0 +04}
}

Changes to library/tzdata/Europe/Chisinau.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {631141200 10800 0 MSK}
    {641941200 7200 0 EET}
    {662680800 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {694216800 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}






|
|
|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {641948400 10800 0 EEST}
    {654652800 7200 0 EET}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {694216800 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}

Changes to library/tzdata/Europe/Kaliningrad.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {701816400 10800 1 EEST}
    {717537600 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}






|
|
|
|
|


|
|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 7200 0 EEMMTT}
    {606873600 10800 1 EEST}
    {622598400 7200 0 EET}
    {638323200 10800 1 EEST}
    {654652800 7200 0 EET}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}

Added library/tzdata/Europe/Kirov.












































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Kirov) {
    {-9223372036854775808 11928 0 LMT}
    {-1593825528 10800 0 +03}
    {-1247540400 14400 0 +05}
    {354916800 18000 1 +05}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {591141600 14400 0 +04}
    {606866400 10800 0 +04}
    {606870000 14400 1 +04}
    {622594800 10800 0 +03}
    {638319600 14400 1 +04}
    {654649200 10800 0 +03}
    {670374000 14400 0 +04}
    {701820000 10800 0 +04}
    {701823600 14400 1 +04}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {811897200 10800 0 +03}
    {828226800 14400 1 +04}
    {846370800 10800 0 +03}
    {859676400 14400 1 +04}
    {877820400 10800 0 +03}
    {891126000 14400 1 +04}
    {909270000 10800 0 +03}
    {922575600 14400 1 +04}
    {941324400 10800 0 +03}
    {954025200 14400 1 +04}
    {972774000 10800 0 +03}
    {985474800 14400 1 +04}
    {1004223600 10800 0 +03}
    {1017529200 14400 1 +04}
    {1035673200 10800 0 +03}
    {1048978800 14400 1 +04}
    {1067122800 10800 0 +03}
    {1080428400 14400 1 +04}
    {1099177200 10800 0 +03}
    {1111878000 14400 1 +04}
    {1130626800 10800 0 +03}
    {1143327600 14400 1 +04}
    {1162076400 10800 0 +03}
    {1174777200 14400 1 +04}
    {1193526000 10800 0 +03}
    {1206831600 14400 1 +04}
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
}

Changes to library/tzdata/Europe/Minsk.

29
30
31
32
33
34
35

36
37
38
39
40
41
42
43
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {631141200 10800 0 MSK}
    {670374000 10800 1 EEST}
    {686102400 7200 0 EET}
    {701820000 10800 1 EEST}

    {717544800 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}






>
|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {631141200 10800 0 MSK}
    {670374000 10800 1 EEST}
    {686102400 7200 0 EET}
    {701820000 10800 1 EEST}
    {717544800 10800 0 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}

Changes to library/tzdata/Europe/Moscow.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {695779200 10800 0 MSD}
    {701812800 14400 1 MSD}
    {717534000 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}






|
|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {695779200 10800 0 MSD}
    {701823600 14400 1 MSD}
    {717548400 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}

Changes to library/tzdata/Europe/Samara.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    {606866400 10800 0 MSD}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 10800 0 KUYT}
    {687916800 14400 0 SAMT}
    {701809200 18000 1 SAMST}
    {717530400 14400 0 SAMT}
    {733269600 18000 1 SAMST}
    {748994400 14400 0 SAMT}
    {764719200 18000 1 SAMST}
    {780444000 14400 0 SAMT}
    {796168800 18000 1 SAMST}
    {811893600 14400 0 SAMT}
    {828223200 18000 1 SAMST}






|

|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    {606866400 10800 0 MSD}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 7200 0 EEMMTT}
    {670377600 10800 1 EEST}
    {686102400 10800 0 SAMT}
    {687916800 14400 0 SAMT}
    {701820000 18000 1 SAMST}
    {717544800 14400 0 SAMT}
    {733269600 18000 1 SAMST}
    {748994400 14400 0 SAMT}
    {764719200 18000 1 SAMST}
    {780444000 14400 0 SAMT}
    {796168800 18000 1 SAMST}
    {811893600 14400 0 SAMT}
    {828223200 18000 1 SAMST}

Added library/tzdata/Europe/Ulyanovsk.


















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Ulyanovsk) {
    {-9223372036854775808 11616 0 LMT}
    {-1593825216 10800 0 +03}
    {-1247540400 14400 0 +05}
    {354916800 18000 1 +05}
    {370724400 14400 0 +04}
    {386452800 18000 1 +05}
    {402260400 14400 0 +04}
    {417988800 18000 1 +05}
    {433796400 14400 0 +04}
    {449611200 18000 1 +05}
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {591141600 14400 0 +04}
    {606866400 10800 0 +04}
    {606870000 14400 1 +04}
    {622594800 10800 0 +03}
    {638319600 14400 1 +04}
    {654649200 10800 0 +03}
    {670374000 7200 0 +03}
    {670377600 10800 1 +03}
    {686102400 7200 0 +02}
    {695779200 10800 0 +04}
    {701823600 14400 1 +04}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {811897200 10800 0 +03}
    {828226800 14400 1 +04}
    {846370800 10800 0 +03}
    {859676400 14400 1 +04}
    {877820400 10800 0 +03}
    {891126000 14400 1 +04}
    {909270000 10800 0 +03}
    {922575600 14400 1 +04}
    {941324400 10800 0 +03}
    {954025200 14400 1 +04}
    {972774000 10800 0 +03}
    {985474800 14400 1 +04}
    {1004223600 10800 0 +03}
    {1017529200 14400 1 +04}
    {1035673200 10800 0 +03}
    {1048978800 14400 1 +04}
    {1067122800 10800 0 +03}
    {1080428400 14400 1 +04}
    {1099177200 10800 0 +03}
    {1111878000 14400 1 +04}
    {1130626800 10800 0 +03}
    {1143327600 14400 1 +04}
    {1162076400 10800 0 +03}
    {1174777200 14400 1 +04}
    {1193526000 10800 0 +03}
    {1206831600 14400 1 +04}
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
    {1459033200 14400 0 +04}
}

Changes to library/tzdata/Europe/Vilnius.

26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}

    {670374000 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}






|
|
|
|
>
|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 7200 0 EEMMTT}
    {606873600 10800 1 EEST}
    {622598400 7200 0 EET}
    {638323200 10800 1 EEST}
    {654652800 7200 0 EET}
    {670377600 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}

Changes to library/tzdata/Europe/Volgograd.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
    {465343200 14400 0 VOLT}
    {481068000 18000 1 VOLST}
    {496792800 14400 0 VOLT}
    {512517600 18000 1 VOLST}
    {528242400 14400 0 VOLT}
    {543967200 18000 1 VOLST}
    {559692000 14400 0 VOLT}
    {575416800 18000 1 VOLST}
    {591141600 14400 0 VOLT}
    {606866400 10800 0 VOLMMTT}
    {606870000 14400 1 VOLST}
    {622594800 10800 0 VOLT}
    {638319600 14400 1 VOLST}
    {654649200 10800 0 VOLT}
    {670374000 14400 0 VOLT}
    {701820000 14400 0 MSD}

    {717534000 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}






|
|
|





|
>
|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    {465343200 14400 0 VOLT}
    {481068000 18000 1 VOLST}
    {496792800 14400 0 VOLT}
    {512517600 18000 1 VOLST}
    {528242400 14400 0 VOLT}
    {543967200 18000 1 VOLST}
    {559692000 14400 0 VOLT}
    {575416800 10800 0 VOLMMTT}
    {575420400 14400 1 VOLST}
    {591145200 10800 0 VOLT}
    {606870000 14400 1 VOLST}
    {622594800 10800 0 VOLT}
    {638319600 14400 1 VOLST}
    {654649200 10800 0 VOLT}
    {670374000 14400 0 VOLT}
    {701820000 10800 0 MSD}
    {701823600 14400 1 MSD}
    {717548400 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}

Changes to library/tzdata/Pacific/Easter.

93
94
95
96
97
98
99















































100
























































































































101
    {1313899200 -18000 1 EASST}
    {1335668400 -21600 0 EAST}
    {1346558400 -18000 1 EASST}
    {1367118000 -21600 0 EAST}
    {1378612800 -18000 1 EASST}
    {1398567600 -21600 0 EAST}
    {1410062400 -18000 1 EASST}















































    {1430017200 -18000 0 EAST}
























































































































}






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    {1313899200 -18000 1 EASST}
    {1335668400 -21600 0 EAST}
    {1346558400 -18000 1 EASST}
    {1367118000 -21600 0 EAST}
    {1378612800 -18000 1 EASST}
    {1398567600 -21600 0 EAST}
    {1410062400 -18000 1 EASST}
    {1463281200 -21600 0 EAST}
    {1471147200 -18000 1 EASST}
    {1494730800 -21600 0 EAST}
    {1502596800 -18000 1 EASST}
    {1526180400 -21600 0 EAST}
    {1534046400 -18000 1 EASST}
    {1557630000 -21600 0 EAST}
    {1565496000 -18000 1 EASST}
    {1589079600 -21600 0 EAST}
    {1596945600 -18000 1 EASST}
    {1620529200 -21600 0 EAST}
    {1629000000 -18000 1 EASST}
    {1652583600 -21600 0 EAST}
    {1660449600 -18000 1 EASST}
    {1684033200 -21600 0 EAST}
    {1691899200 -18000 1 EASST}
    {1715482800 -21600 0 EAST}
    {1723348800 -18000 1 EASST}
    {1746932400 -21600 0 EAST}
    {1754798400 -18000 1 EASST}
    {1778382000 -21600 0 EAST}
    {1786248000 -18000 1 EASST}
    {1809831600 -21600 0 EAST}
    {1818302400 -18000 1 EASST}
    {1841886000 -21600 0 EAST}
    {1849752000 -18000 1 EASST}
    {1873335600 -21600 0 EAST}
    {1881201600 -18000 1 EASST}
    {1904785200 -21600 0 EAST}
    {1912651200 -18000 1 EASST}
    {1936234800 -21600 0 EAST}
    {1944100800 -18000 1 EASST}
    {1967684400 -21600 0 EAST}
    {1976155200 -18000 1 EASST}
    {1999738800 -21600 0 EAST}
    {2007604800 -18000 1 EASST}
    {2031188400 -21600 0 EAST}
    {2039054400 -18000 1 EASST}
    {2062638000 -21600 0 EAST}
    {2070504000 -18000 1 EASST}
    {2094087600 -21600 0 EAST}
    {2101953600 -18000 1 EASST}
    {2125537200 -21600 0 EAST}
    {2133403200 -18000 1 EASST}
    {2156986800 -21600 0 EAST}
    {2165457600 -18000 1 EASST}
    {2189041200 -21600 0 EAST}
    {2196907200 -18000 1 EASST}
    {2220490800 -21600 0 EAST}
    {2228356800 -18000 1 EASST}
    {2251940400 -21600 0 EAST}
    {2259806400 -18000 1 EASST}
    {2283390000 -21600 0 EAST}
    {2291256000 -18000 1 EASST}
    {2314839600 -21600 0 EAST}
    {2322705600 -18000 1 EASST}
    {2346894000 -21600 0 EAST}
    {2354760000 -18000 1 EASST}
    {2378343600 -21600 0 EAST}
    {2386209600 -18000 1 EASST}
    {2409793200 -21600 0 EAST}
    {2417659200 -18000 1 EASST}
    {2441242800 -21600 0 EAST}
    {2449108800 -18000 1 EASST}
    {2472692400 -21600 0 EAST}
    {2480558400 -18000 1 EASST}
    {2504142000 -21600 0 EAST}
    {2512612800 -18000 1 EASST}
    {2536196400 -21600 0 EAST}
    {2544062400 -18000 1 EASST}
    {2567646000 -21600 0 EAST}
    {2575512000 -18000 1 EASST}
    {2599095600 -21600 0 EAST}
    {2606961600 -18000 1 EASST}
    {2630545200 -21600 0 EAST}
    {2638411200 -18000 1 EASST}
    {2661994800 -21600 0 EAST}
    {2669860800 -18000 1 EASST}
    {2693444400 -21600 0 EAST}
    {2701915200 -18000 1 EASST}
    {2725498800 -21600 0 EAST}
    {2733364800 -18000 1 EASST}
    {2756948400 -21600 0 EAST}
    {2764814400 -18000 1 EASST}
    {2788398000 -21600 0 EAST}
    {2796264000 -18000 1 EASST}
    {2819847600 -21600 0 EAST}
    {2827713600 -18000 1 EASST}
    {2851297200 -21600 0 EAST}
    {2859768000 -18000 1 EASST}
    {2883351600 -21600 0 EAST}
    {2891217600 -18000 1 EASST}
    {2914801200 -21600 0 EAST}
    {2922667200 -18000 1 EASST}
    {2946250800 -21600 0 EAST}
    {2954116800 -18000 1 EASST}
    {2977700400 -21600 0 EAST}
    {2985566400 -18000 1 EASST}
    {3009150000 -21600 0 EAST}
    {3017016000 -18000 1 EASST}
    {3040599600 -21600 0 EAST}
    {3049070400 -18000 1 EASST}
    {3072654000 -21600 0 EAST}
    {3080520000 -18000 1 EASST}
    {3104103600 -21600 0 EAST}
    {3111969600 -18000 1 EASST}
    {3135553200 -21600 0 EAST}
    {3143419200 -18000 1 EASST}
    {3167002800 -21600 0 EAST}
    {3174868800 -18000 1 EASST}
    {3198452400 -21600 0 EAST}
    {3206318400 -18000 1 EASST}
    {3230506800 -21600 0 EAST}
    {3238372800 -18000 1 EASST}
    {3261956400 -21600 0 EAST}
    {3269822400 -18000 1 EASST}
    {3293406000 -21600 0 EAST}
    {3301272000 -18000 1 EASST}
    {3324855600 -21600 0 EAST}
    {3332721600 -18000 1 EASST}
    {3356305200 -21600 0 EAST}
    {3364171200 -18000 1 EASST}
    {3387754800 -21600 0 EAST}
    {3396225600 -18000 1 EASST}
    {3419809200 -21600 0 EAST}
    {3427675200 -18000 1 EASST}
    {3451258800 -21600 0 EAST}
    {3459124800 -18000 1 EASST}
    {3482708400 -21600 0 EAST}
    {3490574400 -18000 1 EASST}
    {3514158000 -21600 0 EAST}
    {3522024000 -18000 1 EASST}
    {3545607600 -21600 0 EAST}
    {3553473600 -18000 1 EASST}
    {3577057200 -21600 0 EAST}
    {3585528000 -18000 1 EASST}
    {3609111600 -21600 0 EAST}
    {3616977600 -18000 1 EASST}
    {3640561200 -21600 0 EAST}
    {3648427200 -18000 1 EASST}
    {3672010800 -21600 0 EAST}
    {3679876800 -18000 1 EASST}
    {3703460400 -21600 0 EAST}
    {3711326400 -18000 1 EASST}
    {3734910000 -21600 0 EAST}
    {3743380800 -18000 1 EASST}
    {3766964400 -21600 0 EAST}
    {3774830400 -18000 1 EASST}
    {3798414000 -21600 0 EAST}
    {3806280000 -18000 1 EASST}
    {3829863600 -21600 0 EAST}
    {3837729600 -18000 1 EASST}
    {3861313200 -21600 0 EAST}
    {3869179200 -18000 1 EASST}
    {3892762800 -21600 0 EAST}
    {3900628800 -18000 1 EASST}
    {3924212400 -21600 0 EAST}
    {3932683200 -18000 1 EASST}
    {3956266800 -21600 0 EAST}
    {3964132800 -18000 1 EASST}
    {3987716400 -21600 0 EAST}
    {3995582400 -18000 1 EASST}
    {4019166000 -21600 0 EAST}
    {4027032000 -18000 1 EASST}
    {4050615600 -21600 0 EAST}
    {4058481600 -18000 1 EASST}
    {4082065200 -21600 0 EAST}
    {4089931200 -18000 1 EASST}
}

Changes to library/word.tcl.

7
8
9
10
11
12
13
14

15
16
17
18

19
20
21
22
23
24
25
26
27
28
29
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The following variables are used to determine which characters are
# interpreted as white space.


if {$::tcl_platform(platform) eq "windows"} {
    # Windows style - any but a unicode space char
    set ::tcl_wordchars {\S}

    set ::tcl_nonwordchars {\s}
} else {
    # Motif style - any unicode word char (number, letter, or underscore)
    set ::tcl_wordchars {\w}
    set ::tcl_nonwordchars {\W}
}

# Arrange for caches of the real matcher REs to be kept, which enables the REs
# themselves to be cached for greater performance (and somewhat greater
# clarity too).







|
>

<
|
|
>
|
<
<
<







7
8
9
10
11
12
13
14
15
16

17
18
19
20



21
22
23
24
25
26
27
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The following variables are used to determine which characters are
# interpreted as word characters. See bug [f1253530cdd8]. Will
# probably be removed in Tcl 9.


if {![info exists ::tcl_wordchars]} {
    set ::tcl_wordchars {\w}
}
if {![info exists ::tcl_nonwordchars]} {



    set ::tcl_nonwordchars {\W}
}

# Arrange for caches of the real matcher REs to be kept, which enables the REs
# themselves to be cached for greater performance (and somewhat greater
# clarity too).

Changes to tests/README.

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Please note that the all.tcl file will source your new test file if
the filename matches the tests/*.test pattern (as it should).  The
names of test files that contain regression (or glass-box) tests
should correspond to the Tcl or C code file that they are testing.
For example, the test file for the C file "tclCmdAH.c" is
"cmdAH.test".  Test files that contain black-box tests may not
correspond to any Tcl or C code file so they should match the pattern
"*_bb.test". 

Be sure your new test file can be run from any working directory.

Be sure no temporary files are left behind by your test file.
Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
properly to be sure of this.

Be sure your tests can run cross-platform in both a build environment
as well as an installation environment.  If your test file contains
tests that should not be run in one or more of those cases, please use
the constraints mechanism to skip those tests.

4. Incompatibilities of package tcltest 2.1 with 
   testing machinery of very old versions of Tcl:
------------------------------------------------

1) Global variables such as VERBOSE, TESTS, and testConfig of the
   old machinery correspond to the [configure -verbose], 
   [configure -match], and [testConstraint] commands of tcltest 2.1,
   respectively.

2) VERBOSE values were longer numeric.  [configure -verbose] values
   are lists of keywords.

3) When you run "make test", the working dir for the test suite is now






|












|




|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Please note that the all.tcl file will source your new test file if
the filename matches the tests/*.test pattern (as it should).  The
names of test files that contain regression (or glass-box) tests
should correspond to the Tcl or C code file that they are testing.
For example, the test file for the C file "tclCmdAH.c" is
"cmdAH.test".  Test files that contain black-box tests may not
correspond to any Tcl or C code file so they should match the pattern
"*_bb.test".

Be sure your new test file can be run from any working directory.

Be sure no temporary files are left behind by your test file.
Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
properly to be sure of this.

Be sure your tests can run cross-platform in both a build environment
as well as an installation environment.  If your test file contains
tests that should not be run in one or more of those cases, please use
the constraints mechanism to skip those tests.

4. Incompatibilities of package tcltest 2.1 with
   testing machinery of very old versions of Tcl:
------------------------------------------------

1) Global variables such as VERBOSE, TESTS, and testConfig of the
   old machinery correspond to the [configure -verbose],
   [configure -match], and [testConstraint] commands of tcltest 2.1,
   respectively.

2) VERBOSE values were longer numeric.  [configure -verbose] values
   are lists of keywords.

3) When you run "make test", the working dir for the test suite is now

Changes to tests/apply.test.

224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
test apply-8.2 {args treatment} {
    apply [list {x args} $applyBody] 1 2
} {{x 1} {args 2}}
test apply-8.3 {args treatment} {
    apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
test apply-8.4 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 
} {{x 1} {y 2}}
test apply-8.5 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3 4
} {{x 3} {y 4}}
test apply-8.6 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3
} {{x 3} {y 2}}






|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
test apply-8.2 {args treatment} {
    apply [list {x args} $applyBody] 1 2
} {{x 1} {args 2}}
test apply-8.3 {args treatment} {
    apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
test apply-8.4 {default values} {
    apply [list {{x 1} {y 2}} $applyBody]
} {{x 1} {y 2}}
test apply-8.5 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3 4
} {{x 3} {y 4}}
test apply-8.6 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3
} {{x 3} {y 2}}

Changes to tests/assemble.test.

297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
...
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
...
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
...
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
....
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
....
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
....
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
....
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
....
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
....
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
....
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
....
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
....
3275
3276
3277
3278
3279
3280
3281






















































































3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
	assemble {add excess}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-7.2 {add} {
    -body { 
	assemble {
	    push 2
	    push 2
	    add
	} 
    }
    -result {4}
}
test assemble-7.3 {appendArrayStk} {
    -body {
	set a(b) {hello, }
	assemble {
................................................................................
	    [assemble {push 0b1100; push 0b1010; bitor}] \
	    [assemble {push 0b1100; push 0b1010; bitxor}]
    }
    -result {8 -13 14 6}
}
test assemble-7.6 {div} {
    -body {
	assemble {push 999999; push 7; div} 
    }
    -result 142857
}
test assemble-7.7 {dup} {
    -body {
	assemble {
	    push 1; dup; dup; add; dup; add; dup; add; add
	}
    }
    -result 9
}	
test assemble-7.8 {eq} {
    -body {
	list \
	    [assemble {push able; push baker; eq}] \
	    [assemble {push able; push able;  eq}]
    }
    -result {0 1}
................................................................................
	x
    }
    -result {{a b} {c d} {e i} {g h}}
}
test assemble-7.25 {lshift} {
    -body {
	assemble {push 16; push 4; lshift}
    } 
    -result 256
}
test assemble-7.26 {mod} {
    -body {
	assemble {push 123456; push 1000; mod}
    }
    -result 456
................................................................................
	assemble {push this; pop; push that}
    }
    -result that
}
test assemble-7.31 {rshift} {
    -body {
	assemble {push 257; push 4; rshift}
    } 
    -result 16
}
test assemble-7.32 {storeArrayStk} {
    -body {
	proc x {} {
	    assemble {
		push able; push baker; push charlie; storeArrayStk
................................................................................
	list [catch {assemble {expr $x}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}

# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
#			    nsupvar, variable, upvar)
		
test assemble-11.1 {exist - wrong # args} {
    -body {
	assemble {exist}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
................................................................................
	x
    }
    -result 123
    -cleanup {namespace delete q; rename x {}}
}

# assemble-12 - ASSEM_LVT1 (incr and incrArray)
		
test assemble-12.1 {incr - wrong # args} {
    -body {
	assemble {incr}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
................................................................................
test assemble-17.9 {jump - resolve a label multiple times} {
    -body {
	proc x {} {
	    set case 0
	    set result {}
	    assemble {
		jump common
		
		label zero
		pop		
		incrImm case 1
		pop
		push a
		append result
		pop
		jump common
		
		label one
		pop
		incrImm case 1
		pop
		push b
		append result
		pop
		jump common
		
		label common
		load case
		dup
		push 0
		eq
		jumpTrue zero
		dup
................................................................................
		push 2
		eq
		jumpTrue two
		dup
		push 3
		eq
		jumpTrue three
		
		label two
		pop
		incrImm case 1
		pop
		push c
		append result
		pop
		jump common
		
		label three
		pop
		incrImm case 1
		pop
		push d
		append result
	    }
................................................................................
		"; push b; concat 2; nop; nop; jump a" \
		[expr {$i+1}] \n
	}
	append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
	append body {label b15; push b; concat 2; nop; nop; jump c} \n
	append body {label d}
	proc x {} [list assemble $body]
    }	
    -body {
	x
    }
    -cleanup {
	catch {unset body}
	catch {rename x {}}
    }
................................................................................
    }
    -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
    -cleanup {rename x {}; unset result}
}
test assemble-20.6 {lsetFlat} {
    -body {
	assemble {push b; push a; lsetFlat 2}
    } 
    -result b
}
test assemble-20.7 {lsetFlat} {
    -body {
	assemble {push 1; push d; push {a b c}; lsetFlat 3}
    }
    -result {a d c}
................................................................................

test assemble-40.1 {unbalanced stack} {
    -body {
	list \
	    [catch {
		assemble {
		    push 3
		    dup 
		    mult 
		    push 4
		    dup 
		    mult 
		    pop 
		    expon
		}
	    } result] $result $::errorInfo
    }
    -result {1 {stack underflow} {stack underflow
    in assembly code between lines 1 and end of assembly code*}}
    -match glob
................................................................................
test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
    -body {
	proc ulam {n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n
	    
		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n
	    
		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n
	    
		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n
	     
		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1
	    
		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n
	    
		pop;		# max
	    }
	}
	set result {}
	for {set i 1} {$i < 30} {incr i} {
	    lappend result [ulam $i]
	}
................................................................................
test assemble-51.3 {memory leak testing} memory {
    leaktest {
	apply {{n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n
	    
		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n
	    
		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n
	    
		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n
	     
		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1
	    
		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n
	    
		pop;		# max
	    }
	}} 1
    }
} 0
test assemble-51.4 {memory leak testing} memory {
    leaktest {
................................................................................
	catch {
	    apply {{} {
		assemble {reverse polish notation}
	    }}
	}
    }
} 0






















































































 
rename fillTables {}
rename assemble {}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:






|




|







 







|










|







 







|







 







|







 







|







 







|







 







|

|






|








|







 







|








|







 







|







 







|







 







|
|

|
|
|







 







|









|





|



|





|





|







 







|









|





|



|





|





|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
...
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
...
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
...
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
....
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
....
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
....
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
....
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
....
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
....
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
....
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
....
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
....
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
	assemble {add excess}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-7.2 {add} {
    -body {
	assemble {
	    push 2
	    push 2
	    add
	}
    }
    -result {4}
}
test assemble-7.3 {appendArrayStk} {
    -body {
	set a(b) {hello, }
	assemble {
................................................................................
	    [assemble {push 0b1100; push 0b1010; bitor}] \
	    [assemble {push 0b1100; push 0b1010; bitxor}]
    }
    -result {8 -13 14 6}
}
test assemble-7.6 {div} {
    -body {
	assemble {push 999999; push 7; div}
    }
    -result 142857
}
test assemble-7.7 {dup} {
    -body {
	assemble {
	    push 1; dup; dup; add; dup; add; dup; add; add
	}
    }
    -result 9
}
test assemble-7.8 {eq} {
    -body {
	list \
	    [assemble {push able; push baker; eq}] \
	    [assemble {push able; push able;  eq}]
    }
    -result {0 1}
................................................................................
	x
    }
    -result {{a b} {c d} {e i} {g h}}
}
test assemble-7.25 {lshift} {
    -body {
	assemble {push 16; push 4; lshift}
    }
    -result 256
}
test assemble-7.26 {mod} {
    -body {
	assemble {push 123456; push 1000; mod}
    }
    -result 456
................................................................................
	assemble {push this; pop; push that}
    }
    -result that
}
test assemble-7.31 {rshift} {
    -body {
	assemble {push 257; push 4; rshift}
    }
    -result 16
}
test assemble-7.32 {storeArrayStk} {
    -body {
	proc x {} {
	    assemble {
		push able; push baker; push charlie; storeArrayStk
................................................................................
	list [catch {assemble {expr $x}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}

# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
#			    nsupvar, variable, upvar)

test assemble-11.1 {exist - wrong # args} {
    -body {
	assemble {exist}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
................................................................................
	x
    }
    -result 123
    -cleanup {namespace delete q; rename x {}}
}

# assemble-12 - ASSEM_LVT1 (incr and incrArray)

test assemble-12.1 {incr - wrong # args} {
    -body {
	assemble {incr}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
................................................................................
test assemble-17.9 {jump - resolve a label multiple times} {
    -body {
	proc x {} {
	    set case 0
	    set result {}
	    assemble {
		jump common

		label zero
		pop
		incrImm case 1
		pop
		push a
		append result
		pop
		jump common

		label one
		pop
		incrImm case 1
		pop
		push b
		append result
		pop
		jump common

		label common
		load case
		dup
		push 0
		eq
		jumpTrue zero
		dup
................................................................................
		push 2
		eq
		jumpTrue two
		dup
		push 3
		eq
		jumpTrue three

		label two
		pop
		incrImm case 1
		pop
		push c
		append result
		pop
		jump common

		label three
		pop
		incrImm case 1
		pop
		push d
		append result
	    }
................................................................................
		"; push b; concat 2; nop; nop; jump a" \
		[expr {$i+1}] \n
	}
	append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
	append body {label b15; push b; concat 2; nop; nop; jump c} \n
	append body {label d}
	proc x {} [list assemble $body]
    }
    -body {
	x
    }
    -cleanup {
	catch {unset body}
	catch {rename x {}}
    }
................................................................................
    }
    -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
    -cleanup {rename x {}; unset result}
}
test assemble-20.6 {lsetFlat} {
    -body {
	assemble {push b; push a; lsetFlat 2}
    }
    -result b
}
test assemble-20.7 {lsetFlat} {
    -body {
	assemble {push 1; push d; push {a b c}; lsetFlat 3}
    }
    -result {a d c}
................................................................................

test assemble-40.1 {unbalanced stack} {
    -body {
	list \
	    [catch {
		assemble {
		    push 3
		    dup
		    mult
		    push 4
		    dup
		    mult
		    pop
		    expon
		}
	    } result] $result $::errorInfo
    }
    -result {1 {stack underflow} {stack underflow
    in assembly code between lines 1 and end of assembly code*}}
    -match glob
................................................................................
test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
    -body {
	proc ulam {n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n

		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n

		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n

		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n

		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1

		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n

		pop;		# max
	    }
	}
	set result {}
	for {set i 1} {$i < 30} {incr i} {
	    lappend result [ulam $i]
	}
................................................................................
test assemble-51.3 {memory leak testing} memory {
    leaktest {
	apply {{n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n

		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n

		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n

		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n

		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1

		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n

		pop;		# max
	    }
	}} 1
    }
} 0
test assemble-51.4 {memory leak testing} memory {
    leaktest {
................................................................................
	catch {
	    apply {{} {
		assemble {reverse polish notation}
	    }}
	}
    }
} 0

test assemble-52.1 {Bug 3154ea2759} {
    apply {{} {
	# Needs six exception ranges to force the range allocations to use the
	# malloced store.
	::tcl::unsupported::assemble {
	    beginCatch @badLabel
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel
	    label @badLabel
	    push 1;		# should be pushReturnCode
	    label @okLabel
	    endCatch
	    pop

	    beginCatch @badLabel2
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel2
	    label @badLabel2
	    push 1;		# should be pushReturnCode
	    label @okLabel2
	    endCatch
	    pop

	    beginCatch @badLabel3
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel3
	    label @badLabel3
	    push 1;		# should be pushReturnCode
	    label @okLabel3
	    endCatch
	    pop

	    beginCatch @badLabel4
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel4
	    label @badLabel4
	    push 1;		# should be pushReturnCode
	    label @okLabel4
	    endCatch
	    pop

	    beginCatch @badLabel5
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel5
	    label @badLabel5
	    push 1;		# should be pushReturnCode
	    label @okLabel5
	    endCatch
	    pop

	    beginCatch @badLabel6
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel6
	    label @badLabel6
	    push 1;		# should be pushReturnCode
	    label @okLabel6
	    endCatch
	    pop
	}
    }}
} {};				# must not crash
 
rename fillTables {}
rename assemble {}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/assemble1.bench.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0

proc ulam2 {n} {
    tcl::unsupported::assemble {
	load n;		# max
	dup;		# max n
	jump start;     # max n
	
	label loop;	# max n
	over 1;         # max n max
	over 1;		# max in max n
	ge;             # man n max>=n
	jumpTrue skip;  # max n

	reverse 2;      # n max
	pop;            # n
	dup;            # n n
	
	label skip;	# max n
	dup;            # max n n
	push 2;         # max n n 2
	mod;            # max n n%2
	jumpTrue odd;   # max n
	
	push 2;         # max n 2
	div;            # max n/2 -> max n
	jump start;     # max n
	
	label odd;	# max n
	push 3;         # max n 3
	mult;           # max 3*n
	push 1;         # max 3*n 1
	add;            # max 3*n+1
	
	label start;	# max n
	dup;		# max n n
	push 1;		# max n n 1
	neq;		# max n n>1
	jumpTrue loop;	# max n
	
	pop;		# max
    }
}
set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0

proc test1 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam1 $i  
    }
}
proc test2 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam2 $i  
    }
}

for {set j 0} {$j < 10} {incr j} {
    test1 1
    set before [clock microseconds]
    test1 30000
    set after [clock microseconds]
    puts "compiled: [expr {1e-6 * ($after - $before)}]"
    
    test2 1
    set before [clock microseconds]
    test2 30000
    set after [clock microseconds]
    puts "assembled: [expr {1e-6 * ($after - $before)}]"
}
    






|









|





|



|





|





|







|




|









|






<
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0

proc ulam2 {n} {
    tcl::unsupported::assemble {
	load n;		# max
	dup;		# max n
	jump start;     # max n

	label loop;	# max n
	over 1;         # max n max
	over 1;		# max in max n
	ge;             # man n max>=n
	jumpTrue skip;  # max n

	reverse 2;      # n max
	pop;            # n
	dup;            # n n

	label skip;	# max n
	dup;            # max n n
	push 2;         # max n n 2
	mod;            # max n n%2
	jumpTrue odd;   # max n

	push 2;         # max n 2
	div;            # max n/2 -> max n
	jump start;     # max n

	label odd;	# max n
	push 3;         # max n 3
	mult;           # max 3*n
	push 1;         # max 3*n 1
	add;            # max 3*n+1

	label start;	# max n
	dup;		# max n n
	push 1;		# max n n 1
	neq;		# max n n>1
	jumpTrue loop;	# max n

	pop;		# max
    }
}
set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0

proc test1 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam1 $i
    }
}
proc test2 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam2 $i
    }
}

for {set j 0} {$j < 10} {incr j} {
    test1 1
    set before [clock microseconds]
    test1 30000
    set after [clock microseconds]
    puts "compiled: [expr {1e-6 * ($after - $before)}]"

    test2 1
    set before [clock microseconds]
    test2 30000
    set after [clock microseconds]
    puts "assembled: [expr {1e-6 * ($after - $before)}]"
}

Changes to tests/autoMkindex.test.

176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
    }
    auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
    auto_mkindex . autoMkindex.tcl
    file exists tclIndex
} -cleanup {
    # Reset initCommands to avoid trashing other tests
    AutoMkindexTestReset
} -result 1 
# The auto_mkindex_parser::command is used to register commands that create
# new commands.
test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
    file delete tclIndex
} -body {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index






|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
    }
    auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
    auto_mkindex . autoMkindex.tcl
    file exists tclIndex
} -cleanup {
    # Reset initCommands to avoid trashing other tests
    AutoMkindexTestReset
} -result 1
# The auto_mkindex_parser::command is used to register commands that create
# new commands.
test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
    file delete tclIndex
} -body {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index

Changes to tests/basic.test.

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
...
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    namespace eval test_ns_basic {
        proc p {} {
            return "p in [namespace current]"
        }
    }
    list [test_ns_basic::p] \
         [rename test_ns_basic::p test_ns_basic::q] \
         [test_ns_basic::q] 
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
................................................................................

test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command returns an error
    # As the error code in Tcl_EvalObjv accesses the list elements, this will
    # cause a segfault if [Bug 1119369] has not been fixed. 
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command 
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	error "BAD CALL"
    }
    catch {eval $SRC}
} -result 1 -cleanup {
................................................................................
}

test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command accesses its command line
    # This will cause a segfault if [Bug 1119369] has not been fixed. 
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command 
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	info level 0
    }
    catch {eval $SRC}
} -result 0 -cleanup {
................................................................................
    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {hello
invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 3)}    

test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	interp alias {} patch {} info patchlevel
	patch
	break
    } BREAKtest]
................................................................................
} -body {
    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 4)}    

test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	foo [set a 1] [break]
    } BREAKtest]
} -constraints {
    exec
................................................................................

test basic-48.1.$noComp {expansion: parsing} $constraints {
	run { # A comment

		# Another comment
		list 1  2\
			3   {*}$::l1
            
		# Comment again
	}
} {1 2 3 a {b b} c d}

test basic-48.2.$noComp {no expansion} $constraints {
        run {list $::l1 $::l2 [l3]}
} {{a {b b} c d} {e f {g g} h} {i j k {l l}}}
................................................................................
test basic-48.13.$noComp {expansion: odd usage} $constraints {
	run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}

test basic-48.14.$noComp {expansion: hash command} -setup {
        catch {rename \# ""}
        set cmd "#"
    } -constraints $constraints -body { 
           run { {*}$cmd apa bepa }
    } -cleanup {
	unset cmd
} -returnCodes 1 -result {invalid command name "#"}

test basic-48.15.$noComp {expansion: complex words} -setup {
            set a(x) [list a {b c} d e]
................................................................................
        }
    } -constraints [linsert $constraints 0 memory] -body {
        set end [getbytes]
        for {set i 0} {$i < 5} {incr i} {
            stress
            set tmp $end
            set end [getbytes]
        }    
        set leak [expr {$end - $tmp}]
    } -cleanup {
	unset end i tmp
	rename getbytes {}
	rename stress {}
} -result 0

test basic-48.17.$noComp {expansion: object safety} -setup {
        set old_precision $::tcl_precision
        set ::tcl_precision 4
    } -constraints $constraints -body { 
            set third [expr {1.0/3.0}]
            set l [list $third $third]
            set x [run {list $third {*}$l $third}]
	    set res [list]
            foreach t $x {
                lappend res [expr {$t * 3.0}]
            }






|







 







|



|







 







|



|







 







|







 







|







 







|







 







|







 







|










|







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
...
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    namespace eval test_ns_basic {
        proc p {} {
            return "p in [namespace current]"
        }
    }
    list [test_ns_basic::p] \
         [rename test_ns_basic::p test_ns_basic::q] \
         [test_ns_basic::q]
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
................................................................................

test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command returns an error
    # As the error code in Tcl_EvalObjv accesses the list elements, this will
    # cause a segfault if [Bug 1119369] has not been fixed.
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	error "BAD CALL"
    }
    catch {eval $SRC}
} -result 1 -cleanup {
................................................................................
}

test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command accesses its command line
    # This will cause a segfault if [Bug 1119369] has not been fixed.
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	info level 0
    }
    catch {eval $SRC}
} -result 0 -cleanup {
................................................................................
    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {hello
invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 3)}

test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	interp alias {} patch {} info patchlevel
	patch
	break
    } BREAKtest]
................................................................................
} -body {
    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 4)}

test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	foo [set a 1] [break]
    } BREAKtest]
} -constraints {
    exec
................................................................................

test basic-48.1.$noComp {expansion: parsing} $constraints {
	run { # A comment

		# Another comment
		list 1  2\
			3   {*}$::l1

		# Comment again
	}
} {1 2 3 a {b b} c d}

test basic-48.2.$noComp {no expansion} $constraints {
        run {list $::l1 $::l2 [l3]}
} {{a {b b} c d} {e f {g g} h} {i j k {l l}}}
................................................................................
test basic-48.13.$noComp {expansion: odd usage} $constraints {
	run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}

test basic-48.14.$noComp {expansion: hash command} -setup {
        catch {rename \# ""}
        set cmd "#"
    } -constraints $constraints -body {
           run { {*}$cmd apa bepa }
    } -cleanup {
	unset cmd
} -returnCodes 1 -result {invalid command name "#"}

test basic-48.15.$noComp {expansion: complex words} -setup {
            set a(x) [list a {b c} d e]
................................................................................
        }
    } -constraints [linsert $constraints 0 memory] -body {
        set end [getbytes]
        for {set i 0} {$i < 5} {incr i} {
            stress
            set tmp $end
            set end [getbytes]
        }
        set leak [expr {$end - $tmp}]
    } -cleanup {
	unset end i tmp
	rename getbytes {}
	rename stress {}
} -result 0

test basic-48.17.$noComp {expansion: object safety} -setup {
        set old_precision $::tcl_precision
        set ::tcl_precision 4
    } -constraints $constraints -body {
            set third [expr {1.0/3.0}]
            set l [list $third $third]
            set x [run {list $third {*}$l $third}]
	    set res [list]
            foreach t $x {
                lappend res [expr {$t * 3.0}]
            }

Changes to tests/chan.test.

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
test chan-16.3 {chan command: pending subcommand} -body {
    chan pending stdin stdout stderr
} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
test chan-16.4 {chan command: pending subcommand} -body {
    chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": must be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
    chan pending input stdout 
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
    chan pending input stdin
} -result 0
test chan-16.7 {chan command: pending input subcommand} -body {
    chan pending input FOOBAR
} -returnCodes error -result "can not find channel named \"FOOBAR\""
................................................................................
    }

    set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
    set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
    set ::chan-16.9-data [list]
    set ::chan-16.9-done 0
} -body {
    after idle chan-16.9-client 
    vwait ::chan-16.9-done
    set ::chan-16.9-data
} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
    catch {chan close $client}
    catch {chan close $server}
    rename chan-16.9-accept {}
    rename chan-16.9-readable {}






|







 







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
test chan-16.3 {chan command: pending subcommand} -body {
    chan pending stdin stdout stderr
} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
test chan-16.4 {chan command: pending subcommand} -body {
    chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": must be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
    chan pending input stdout
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
    chan pending input stdin
} -result 0
test chan-16.7 {chan command: pending input subcommand} -body {
    chan pending input FOOBAR
} -returnCodes error -result "can not find channel named \"FOOBAR\""
................................................................................
    }

    set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
    set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
    set ::chan-16.9-data [list]
    set ::chan-16.9-done 0
} -body {
    after idle chan-16.9-client
    vwait ::chan-16.9-done
    set ::chan-16.9-data
} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
    catch {chan close $client}
    catch {chan close $server}
    rename chan-16.9-accept {}
    rename chan-16.9-readable {}

Changes to tests/chanio.test.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
...
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
...
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
....
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
....
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
....
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
....
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
....
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
....
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
....
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
    variable n
    variable v
    variable msg
    variable expected

    ::tcltest::loadTestedCommands
    catch [list package require -exact Tcltest [info patchlevel]]
    
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint exec             [llength [info commands exec]]
    testConstraint openpipe         1
    testConstraint fileevent        [llength [info commands fileevent]]
    testConstraint fcopy            [llength [info commands fcopy]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
set path(test2) [makeFile {} test2]
test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
    # This test written for SF bug #506297.
    #
    # Executing this test without the fix for the referenced bug applied to
    # tcl will cause tcl, more specifically WriteChars, to go into an infinite
    # loop.
    set f [open $path(test2) w] 
    chan configure      $f -encoding iso2022-jp 
    chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] 
    chan close           $f 
    contents $path(test2)
} "    \x1b\$B\$O\x1b(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
    # When closing a channel with an encoding that appends escape bytes, check
    # for the case where the escape bytes overflow the current IO buffer. The
    # bytes should be moved into a new buffer.
    set data "1234567890 [format %c 12399]"
................................................................................
    contents $path(test1)
} -cleanup {
    chan close $f
} -result "\r\n12"
test chan-io-3.4 {WriteChars: loop over stage buffer} {
    # stage buffer maps to more than can be queued at once.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 16 
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.5 {WriteChars: saved != 0} {
    # Bytes produced by UtfToExternal from end of last channel buffer had to
    # be moved to beginning of next channel buffer to preserve requested
    # buffersize.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17 
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
    # One incomplete UTF-8 character at end of staging buffer. Backup in src
................................................................................
test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
    # When translating UTF-8 to external, the produced bytes went past end of
    # the channel buffer. This is done on purpose - we then truncate the bytes
    # at the end of the partial character to preserve the requested blocksize
    # on flush. The truncated bytes are moved to the beginning of the next
    # channel buffer.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17 
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
    set f [open $path(test1) w]
................................................................................
    chan puts -nonewline $f "12345678901\n456789012345678901234"
    chan close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test chan-io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]
    chan configure $f 
    chan puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test chan-io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]
................................................................................
} -cleanup {
    chan close $f
} -result [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
    # if (dst >= dstEnd) 
    set f [open $path(test1) w]
    chan puts $f $a
    chan puts $f hi
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f line] $line
} -cleanup {
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan eof $f]
} -cleanup {
    chan close $f
} -result [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
    # not (*eol == '\n') 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan tell $f]
................................................................................
    # if (chanPtr->flags & INPUT_SAW_CR)
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f] 
    chan configure $f -blocking 1
    chan puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
    set x ""
} -constraints {stdio testchannel openpipe fileevent} -body {
    # not (*eol == '\n') 
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f] 
    chan configure $f -blocking 1
    chan puts -nonewline $f "abcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
................................................................................
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
    chan close $f
} -result {123456 0 8 78901}
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
    # not (*eol == '\n') 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\r78901"
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
................................................................................
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
    chan close $f
} -result {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) 
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto binary} -buffersize 16
    chan puts -nonewline $f "abcdefghijklmno\r"
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
    # (src >= srcMax) 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
    # (src >= srcMax) 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\rfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
    # (src >= srcMax) 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\nfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
    # not (*src == '\r') 
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\ndef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
................................................................................
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf 
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
................................................................................
} -cleanup {
    chan close $f
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding {} 
    chan puts -nonewline $f \xe7\x89\xa6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
} -cleanup {
    chan close $f
................................................................................
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
} -result {{{}} auto}
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
        writable so we can't change -eofchar or -translation} -setup {
    set l [list]
} -body { 
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    chan configure $sock -eofchar D -translation lf
    lappend l [chan configure $sock -eofchar] \
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
} -result {{{}} auto}
................................................................................
    set f [open $path(test3) WRONLY]
    chan configure $f -eofchar {}
    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [list [catch {chan gets $f} msg] $msg]
    chan close $f
    lappend x [viewFile test3]
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy} 
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
    file delete $path(test3)
    open $path(test3) RDWR
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.15 {POSIX open access modes: RDWR} {
    makeFile xyzzy test3
    set f [open $path(test3) RDWR]






|







 







|
|
|
|







 







|










|







 







|







 







|







 







|







 







|







 







|










|






|







 







|







 







|







 







|











|











|







 







|







 







|







 







|







 







|







 







|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
...
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
...
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
....
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
....
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
....
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
....
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
....
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
....
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
....
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
    variable n
    variable v
    variable msg
    variable expected

    ::tcltest::loadTestedCommands
    catch [list package require -exact Tcltest [info patchlevel]]

    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint exec             [llength [info commands exec]]
    testConstraint openpipe         1
    testConstraint fileevent        [llength [info commands fileevent]]
    testConstraint fcopy            [llength [info commands fcopy]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
set path(test2) [makeFile {} test2]
test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
    # This test written for SF bug #506297.
    #
    # Executing this test without the fix for the referenced bug applied to
    # tcl will cause tcl, more specifically WriteChars, to go into an infinite
    # loop.
    set f [open $path(test2) w]
    chan configure      $f -encoding iso2022-jp
    chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
    chan close           $f
    contents $path(test2)
} "    \x1b\$B\$O\x1b(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
    # When closing a channel with an encoding that appends escape bytes, check
    # for the case where the escape bytes overflow the current IO buffer. The
    # bytes should be moved into a new buffer.
    set data "1234567890 [format %c 12399]"
................................................................................
    contents $path(test1)
} -cleanup {
    chan close $f
} -result "\r\n12"
test chan-io-3.4 {WriteChars: loop over stage buffer} {
    # stage buffer maps to more than can be queued at once.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 16
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.5 {WriteChars: saved != 0} {
    # Bytes produced by UtfToExternal from end of last channel buffer had to
    # be moved to beginning of next channel buffer to preserve requested
    # buffersize.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
    # One incomplete UTF-8 character at end of staging buffer. Backup in src
................................................................................
test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
    # When translating UTF-8 to external, the produced bytes went past end of
    # the channel buffer. This is done on purpose - we then truncate the bytes
    # at the end of the partial character to preserve the requested blocksize
    # on flush. The truncated bytes are moved to the beginning of the next
    # channel buffer.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
    set f [open $path(test1) w]
................................................................................
    chan puts -nonewline $f "12345678901\n456789012345678901234"
    chan close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test chan-io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]
    chan configure $f
    chan puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test chan-io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]
................................................................................
} -cleanup {
    chan close $f
} -result [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
    # if (dst >= dstEnd)
    set f [open $path(test1) w]
    chan puts $f $a
    chan puts $f hi
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f line] $line
} -cleanup {
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan eof $f]
} -cleanup {
    chan close $f
} -result [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
    # not (*eol == '\n')
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan tell $f]
................................................................................
    # if (chanPtr->flags & INPUT_SAW_CR)
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan configure $f -blocking 1
    chan puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
    set x ""
} -constraints {stdio testchannel openpipe fileevent} -body {
    # not (*eol == '\n')
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan configure $f -blocking 1
    chan puts -nonewline $f "abcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
................................................................................
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
    chan close $f
} -result {123456 0 8 78901}
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
    # not (*eol == '\n')
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\r78901"
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
................................................................................
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
    chan close $f
} -result {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto binary} -buffersize 16
    chan puts -nonewline $f "abcdefghijklmno\r"
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
    # (src >= srcMax)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
    # (src >= srcMax)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\rfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
    # (src >= srcMax)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\nfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
................................................................................
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
} -cleanup {
    chan close $f
} -result "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
    # not (*src == '\r')
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\ndef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
................................................................................
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
................................................................................
} -cleanup {
    chan close $f
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding {}
    chan puts -nonewline $f \xe7\x89\xa6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
} -cleanup {
    chan close $f
................................................................................
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
} -result {{{}} auto}
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
        writable so we can't change -eofchar or -translation} -setup {
    set l [list]
} -body {
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    chan configure $sock -eofchar D -translation lf
    lappend l [chan configure $sock -eofchar] \
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
} -result {{{}} auto}
................................................................................
    set f [open $path(test3) WRONLY]
    chan configure $f -eofchar {}
    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [list [catch {chan gets $f} msg] $msg]
    chan close $f
    lappend x [viewFile test3]
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
    file delete $path(test3)
    open $path(test3) RDWR
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.15 {POSIX open access modes: RDWR} {
    makeFile xyzzy test3
    set f [open $path(test3) RDWR]

Changes to tests/clock.test.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
.....
34988
34989
34990
34991
34992
34993
34994




34995
34996
34997
34998
34999
35000
35001
.....
35214
35215
35216
35217
35218
35219
35220






































35221













35222
35223
35224
35225
35226
35227
35228
35229
35230
35231
.....
35240
35241
35242
35243
35244
35245
35246
35247
35248
35249
35250
35251
35252
35253
35254
.....
35263
35264
35265
35266
35267
35268
35269
35270
35271
35272
35273
35274
35275
35276
35277
.....
35286
35287
35288
35289
35290
35291
35292
35293
35294
35295
35296
35297
35298
35299
35300
.....
35323
35324
35325
35326
35327
35328
35329
35330
35331
35332
35333
35334
35335
35336
35337
.....
35360
35361
35362
35363
35364
35365
35366
35367
35368
35369
35370
35371
35372
35373
35374
.....
35430
35431
35432
35433
35434
35435
35436
35437
35438
35439
35440
35441
35442
35443
35444
.....
35464
35465
35466
35467
35468
35469
35470
35471
35472
35473
35474
35475
35476
35477
35478
35479
35480
35481
35482
35483
35484
35485
35486
35487
35488
35489
35490
.....
35800
35801
35802
35803
35804
35805
35806
35807
35808
35809
35810
35811
35812
35813
35814
35815
35816
35817
35818
35819
35820
35821
35822
35823
35824
35825
35826
35827
35828
35829
35830
35831
35832
35833
35834
35835
35836
35837
35838
.....
35920
35921
35922
35923
35924
35925
35926
35927
35928
35929
35930
35931
35932
35933
35934
.....
35992
35993
35994
35995
35996
35997
35998
35999
36000
36001
36002
36003
36004
36005
36006
.....
36037
36038
36039
36040
36041
36042
36043
36044
36045
36046
36047
36048
36049
36050
36051
.....
36276
36277
36278
36279
36280
36281
36282
36283
36284
36285
36286
36287
36288
36289
36290
.....
36326
36327
36328
36329
36330
36331
36332
36333
36334
36335
36336
36337
36338
36339
36340
.....
36536
36537
36538
36539
36540
36541
36542
36543
36544
36545
36546
36547
36548
36549
36550
.....
36688
36689
36690
36691
36692
36693
36694
36695
36696
36697
36698
36699
36700
36701
36702
36703
36704
36705
36706
36707
36708
36709
36710
36711
36712
36713
.....
36805
36806
36807
36808
36809
36810
36811
36812
36813
36814
36815
36816
36817
36818
36819
36820
36821
36822
36823
36824
36825
36826
36827
36828
36829
36830
36831
36832
36833
36834
36835
36836
36837
36838
36839
36840
36841
36842
36843
36844
36845
36846
36847
36848
36849
36850
36851
36852
36853
36854
36855
36856
36857
36858
36859
36860
36861
36862
36863
36864
    [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
    [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]

# TEST PLAN

# clock-1:
#	[clock format] - tests of bad and empty arguments 
#
# clock-2 
#	formatting of year, month and day of month
#
# clock-3
#	formatting of fiscal year, fiscal week and day of week.
#
# clock-4
#	formatting of time of day.
................................................................................
	    x xi xii xiii xiv xv xvi xvii xviii xix
	    xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix
	    xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix
	    xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix
	    l li lii liii liv lv lvi lvii lviii lix
	    lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
	    lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
	    lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii 
	    lxxxix
	    xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
	    c
	}
	DATE_FORMAT {%m/%d/%Y}
	TIME_FORMAT {%H:%M:%S}
	DATE_TIME_FORMAT {%x %X}
................................................................................
test clock-1.3 "clock format - empty val" {
    clock format 0 -gmt 1 -format ""
} {}

test clock-1.4 "clock format - bad flag" {*}{
    -body {
    list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
    } 
    -match glob
    -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
}

test clock-1.5 "clock format - bad timezone" {
    list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}
................................................................................
test clock-29.1800 {time parsing} {
    clock scan {2440588 xi:lix:lix pm} \
        -gmt true -locale en_US_roman \
        -format {%J %Ol:%OM:%OS %P}
} 86399
# END testcases29





test clock-30.1 {clock add years} {
    set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC]
    set f [clock add $t 1 year -timezone :UTC]
    clock format $f -format %Y-%m-%d -timezone :UTC
} {2001-01-01}
test clock-30.2 {clock add years - leap day} {
    set t [clock scan 2000-02-29 -format %Y-%m-%d -timezone :UTC]
................................................................................
    set t [clock scan {2004-10-31 01:00:00 -0400} \
	       -format {%Y-%m-%d %H:%M:%S %z} \
	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}




















































test clock-31.1 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%d-%b-%Y}]

test clock-31.2 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {the %d' day of %B %Y}]

test clock-31.3 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%l:%M:%S %p}]

test clock-31.4 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]

test clock-31.5 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {the %d' day of %B %Y}]

test clock-31.6 {system locale} \
    -constraints win \
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	if { $t ne $v } {
	    append problems "scanning $u: $t should be $v\n"
	}
	incr t 86400
    }
    set problems
} {}
			 
# Legacy tests

# clock clicks
test clock-33.1 {clock clicks tests} {
    expr [clock clicks]+1
    concat {}
} {}
................................................................................
    # the test takes >60 ms to run.
    set start [clock clicks -milli]
    after 10
    set end [clock clicks -milli]
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" : 
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.5a {clock tests, millisecond timing test} {
    # This test can fail on a system that is so heavily loaded that
    # the test takes >60 ms to run.
    set start [clock milliseconds]
    after 10
    set end [clock milliseconds]
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" : 
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks ? } msg] $msg
} {1 {bad option "?": must be -milliseconds or -microseconds}}
test clock-33.7 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks - } msg] $msg
................................................................................
test clock-34.47 {ago with multiple relative units} {
    set base [clock scan "12/31/1999 00:00:00"]
    set res [clock scan "2 days 2 hours ago" -base $base]
    expr {$base - $res}
} 180000

test clock-34.48 {more than one ToD} {*}{
    -body {clock scan {10:00 11:00}} 
    -returnCodes error
    -result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
}

test clock-34.49 {more than one date} {*}{
    -body {clock scan {1/1/2001 2/2/2002}} 
    -returnCodes error
    -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
}

test clock-34.50 {more than one time zone} {*}{
    -body {clock scan {10:00 EST CST}} 
    -returnCodes error
    -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
}

test clock-34.51 {more than one weekday} {*}{
    -body {clock scan {Monday Tuesday}} 
    -returnCodes error
    -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
}

test clock-34.52 {more than one ordinal month} {*}{
    -body {clock scan {next January next March}} 
    -returnCodes error
    -result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}



# clock seconds
................................................................................
        }
        if { [info exists oldTclTZ] } {
            set env(TCL_TZ) $oldTclTZ
            unset oldTclTZ
        }
    } \
    -result 1
        

test clock-39.1 {regression - synonym timezones} {
    clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
} {19:00:00}

test clock-40.1 {regression - bad month with -timezone :localtime} \
    -setup {
................................................................................
	    set env(TZ) $oldTZ
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result {12:34:56-0500}
    
test clock-45.1 {regression test - time zone containing only two digits} \
    -body {
	clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
    } \
    -result 482134530

test clock-46.1 {regression test - month zero} \
................................................................................
    }
} -cleanup {
    interp delete child
} -result {0 12345}

test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \
    -body {
	list [catch { 
	    clock format -86400 -timezone :localtime -format %Y
	} result] $result
    } \
    -match regexp \
    -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}

test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
................................................................................
    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixOne \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}
	    
test clock-56.2 {use of zoneinfo, version 2} {*}{
    -setup {
	clock format [clock seconds]
	set tzdir [makeDirectory zoneinfo]
	set tzdir2 [makeDirectory Test $tzdir]
	set tzfile [makeFile {} PhoenixTwo $tzdir2]
	set f [open $tzfile wb]
................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile PhoenixTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    } 
    -body {
	clock format 1072940400 -timezone :Test/PhoenixTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}

................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile TijuanaTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    } 
    -body {
	clock format 2224738800 -timezone :Test/TijuanaTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2040-07-01 00:00:00 PDT}
}

................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile Windhoek $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    } 
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {
	    
	    set retval {}
	    foreach char [split $string {}] {
		scan $char %c ccode
		if { $ccode >= 0x0020 && $ccode < 0x007f
		     && $char ne "\{" && $char ne "\}" && $char ne "\["
		     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
		    append retval $char
................................................................................
    join $trouble \n
} {}

# case-insensitive matching of weekday and month names [Bug 1781282]

test clock-60.1 {case insensitive weekday names} {
    clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.2 {case insensitive weekday names} {
    clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.3 {case insensitive weekday names} {
    clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.4 {case insensitive weekday names} {
    clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.5 {case insensitive weekday names} {
    clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.6 {case insensitive weekday names} {
    clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.7 {case insensitive month names} {
    clock scan "1 january 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.8 {case insensitive month names} {
    clock scan "1 January 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.9 {case insensitive month names} {
    clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.10 {case insensitive month names} {
    clock scan "1 december 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.11 {case insensitive month names} {
    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
	clock format 0x8000000000000000 -format %s -gmt true
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
	clock format -0x8000000000000001 -format %s -gmt true
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.3 {near-miss overflow of a wide integer on output} {
    clock format 0x7fffffffffffffff -format %s -gmt true
} [expr 0x7fffffffffffffff]
test clock-61.4 {near-miss overflow of a wide integer on output} {






|

|







 







|







 







|







 







>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>


|







 







|







 







|







 







|







 







|







 







|







 







|







 







|











|







 







|





|





|





|





|







 







|







 







|







 







|







 







|







 







|







 







|







 







|










|







 







|


|


|


|


|


|


|


|


|


|


|


|




|






|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
.....
34988
34989
34990
34991
34992
34993
34994
34995
34996
34997
34998
34999
35000
35001
35002
35003
35004
35005
.....
35218
35219
35220
35221
35222
35223
35224
35225
35226
35227
35228
35229
35230
35231
35232
35233
35234
35235
35236
35237
35238
35239
35240
35241
35242
35243
35244
35245
35246
35247
35248
35249
35250
35251
35252
35253
35254
35255
35256
35257
35258
35259
35260
35261
35262
35263
35264
35265
35266
35267
35268
35269
35270
35271
35272
35273
35274
35275
35276
35277
35278
35279
35280
35281
35282
35283
35284
35285
35286
.....
35295
35296
35297
35298
35299
35300
35301
35302
35303
35304
35305
35306
35307
35308
35309
.....
35318
35319
35320
35321
35322
35323
35324
35325
35326
35327
35328
35329
35330
35331
35332
.....
35341
35342
35343
35344
35345
35346
35347
35348
35349
35350
35351
35352
35353
35354
35355
.....
35378
35379
35380
35381
35382
35383
35384
35385
35386
35387
35388
35389
35390
35391
35392
.....
35415
35416
35417
35418
35419
35420
35421
35422
35423
35424
35425
35426
35427
35428
35429
.....
35485
35486
35487
35488
35489
35490
35491
35492
35493
35494
35495
35496
35497
35498
35499
.....
35519
35520
35521
35522
35523
35524
35525
35526
35527
35528
35529
35530
35531
35532
35533
35534
35535
35536
35537
35538
35539
35540
35541
35542
35543
35544
35545
.....
35855
35856
35857
35858
35859
35860
35861
35862
35863
35864
35865
35866
35867
35868
35869
35870
35871
35872
35873
35874
35875
35876
35877
35878
35879
35880
35881
35882
35883
35884
35885
35886
35887
35888
35889
35890
35891
35892
35893
.....
35975
35976
35977
35978
35979
35980
35981
35982
35983
35984
35985
35986
35987
35988
35989
.....
36047
36048
36049
36050
36051
36052
36053
36054
36055
36056
36057
36058
36059
36060
36061
.....
36092
36093
36094
36095
36096
36097
36098
36099
36100
36101
36102
36103
36104
36105
36106
.....
36331
36332
36333
36334
36335
36336
36337
36338
36339
36340
36341
36342
36343
36344
36345
.....
36381
36382
36383
36384
36385
36386
36387
36388
36389
36390
36391
36392
36393
36394
36395
.....
36591
36592
36593
36594
36595
36596
36597
36598
36599
36600
36601
36602
36603
36604
36605
.....
36743
36744
36745
36746
36747
36748
36749
36750
36751
36752
36753
36754
36755
36756
36757
36758
36759
36760
36761
36762
36763
36764
36765
36766
36767
36768
.....
36860
36861
36862
36863
36864
36865
36866
36867
36868
36869
36870
36871
36872
36873
36874
36875
36876
36877
36878
36879
36880
36881
36882
36883
36884
36885
36886
36887
36888
36889
36890
36891
36892
36893
36894
36895
36896
36897
36898
36899
36900
36901
36902
36903
36904
36905
36906
36907
36908
36909
36910
36911
36912
36913
36914
36915
36916
36917
36918
36919
    [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
    [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]

# TEST PLAN

# clock-1:
#	[clock format] - tests of bad and empty arguments
#
# clock-2
#	formatting of year, month and day of month
#
# clock-3
#	formatting of fiscal year, fiscal week and day of week.
#
# clock-4
#	formatting of time of day.
................................................................................
	    x xi xii xiii xiv xv xvi xvii xviii xix
	    xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix
	    xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix
	    xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix
	    l li lii liii liv lv lvi lvii lviii lix
	    lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
	    lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
	    lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
	    lxxxix
	    xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
	    c
	}
	DATE_FORMAT {%m/%d/%Y}
	TIME_FORMAT {%H:%M:%S}
	DATE_TIME_FORMAT {%x %X}
................................................................................
test clock-1.3 "clock format - empty val" {
    clock format 0 -gmt 1 -format ""
} {}

test clock-1.4 "clock format - bad flag" {*}{
    -body {
    list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
    }
    -match glob
    -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
}

test clock-1.5 "clock format - bad timezone" {
    list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}
................................................................................
test clock-29.1800 {time parsing} {
    clock scan {2440588 xi:lix:lix pm} \
        -gmt true -locale en_US_roman \
        -format {%J %Ol:%OM:%OS %P}
} 86399
# END testcases29


# BEGIN testcases30

# Test [clock add]
test clock-30.1 {clock add years} {
    set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC]
    set f [clock add $t 1 year -timezone :UTC]
    clock format $f -format %Y-%m-%d -timezone :UTC
} {2001-01-01}
test clock-30.2 {clock add years - leap day} {
    set t [clock scan 2000-02-29 -format %Y-%m-%d -timezone :UTC]
................................................................................
    set t [clock scan {2004-10-31 01:00:00 -0400} \
	       -format {%Y-%m-%d %H:%M:%S %z} \
	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
test clock-30.26 {clock add weekdays} {
    set t [clock scan {2013-11-20}] ;# Wednesday
    set f1 [clock add $t 3 weekdays]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.27 {clock add weekdays starting on Saturday} {
    set t [clock scan {2013-11-23}] ;# Saturday
    set f1 [clock add $t 1 weekday]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.28 {clock add weekdays starting on Sunday} {
    set t [clock scan {2013-11-24}] ;# Sunday
    set f1 [clock add $t 1 weekday]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2013-11-25}
test clock-30.29 {clock add 0 weekdays starting on a weekend} {
    set t [clock scan {2016-02-27}] ;# Saturday
    set f1 [clock add $t 0 weekdays]
    set x1 [clock format $f1 -format {%Y-%m-%d}]
} {2016-02-27}
test clock-30.30 {clock add weekdays and back} -body {
    set n [clock seconds]
    # we start on each day of the week
    for {set i 0} {$i < 7} {incr i} {
        set start  [clock add $n $i days]
        set startu [clock format $start -format %u]
        # add 0 - 100 weekdays
        for {set j 0} {$j < 100} {incr j} {
            set forth [clock add $start $j weekdays]
            set back  [clock add $forth -$j weekdays]
            # If $s was a weekday or $j was 0, $b must be the same day.
            # Otherwise, $b must be the immediately preceeding Friday
            set fail 0
            if {$j == 0 || $startu < 6} {
                if {$start != $back} { set fail 1}
            } else {
                set friday [clock add $start -[expr {$startu % 5}] days]
                if {$friday != $back} { set fail 1 }
            }
            if {$fail} {
                set sdate [clock format $start -format {%Y-%m-%d}]
                set bdate [clock format $back  -format {%Y-%m-%d}]
                return "$sdate + $j - $j := $bdate"
            }
        }
    }
    return "OK"
} -result {OK}

# END testcases30


test clock-31.1 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%d-%b-%Y}]

test clock-31.2 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {the %d' day of %B %Y}]

test clock-31.3 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%l:%M:%S %p}]

test clock-31.4 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]

test clock-31.5 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {the %d' day of %B %Y}]

test clock-31.6 {system locale} \
    -constraints win \
    -setup {
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
................................................................................
	if { $t ne $v } {
	    append problems "scanning $u: $t should be $v\n"
	}
	incr t 86400
    }
    set problems
} {}

# Legacy tests

# clock clicks
test clock-33.1 {clock clicks tests} {
    expr [clock clicks]+1
    concat {}
} {}
................................................................................
    # the test takes >60 ms to run.
    set start [clock clicks -milli]
    after 10
    set end [clock clicks -milli]
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" :
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.5a {clock tests, millisecond timing test} {
    # This test can fail on a system that is so heavily loaded that
    # the test takes >60 ms to run.
    set start [clock milliseconds]
    after 10
    set end [clock milliseconds]
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" :
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks ? } msg] $msg
} {1 {bad option "?": must be -milliseconds or -microseconds}}
test clock-33.7 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks - } msg] $msg
................................................................................
test clock-34.47 {ago with multiple relative units} {
    set base [clock scan "12/31/1999 00:00:00"]
    set res [clock scan "2 days 2 hours ago" -base $base]
    expr {$base - $res}
} 180000

test clock-34.48 {more than one ToD} {*}{
    -body {clock scan {10:00 11:00}}
    -returnCodes error
    -result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
}

test clock-34.49 {more than one date} {*}{
    -body {clock scan {1/1/2001 2/2/2002}}
    -returnCodes error
    -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
}

test clock-34.50 {more than one time zone} {*}{
    -body {clock scan {10:00 EST CST}}
    -returnCodes error
    -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
}

test clock-34.51 {more than one weekday} {*}{
    -body {clock scan {Monday Tuesday}}
    -returnCodes error
    -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
}

test clock-34.52 {more than one ordinal month} {*}{
    -body {clock scan {next January next March}}
    -returnCodes error
    -result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}



# clock seconds
................................................................................
        }
        if { [info exists oldTclTZ] } {
            set env(TCL_TZ) $oldTclTZ
            unset oldTclTZ
        }
    } \
    -result 1


test clock-39.1 {regression - synonym timezones} {
    clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
} {19:00:00}

test clock-40.1 {regression - bad month with -timezone :localtime} \
    -setup {
................................................................................
	    set env(TZ) $oldTZ
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result {12:34:56-0500}

test clock-45.1 {regression test - time zone containing only two digits} \
    -body {
	clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
    } \
    -result 482134530

test clock-46.1 {regression test - month zero} \
................................................................................
    }
} -cleanup {
    interp delete child
} -result {0 12345}

test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \
    -body {
	list [catch {
	    clock format -86400 -timezone :localtime -format %Y
	} result] $result
    } \
    -match regexp \
    -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}

test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
................................................................................
    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixOne \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}

test clock-56.2 {use of zoneinfo, version 2} {*}{
    -setup {
	clock format [clock seconds]
	set tzdir [makeDirectory zoneinfo]
	set tzdir2 [makeDirectory Test $tzdir]
	set tzfile [makeFile {} PhoenixTwo $tzdir2]
	set f [open $tzfile wb]
................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile PhoenixTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}

................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile TijuanaTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -body {
	clock format 2224738800 -timezone :Test/TijuanaTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2040-07-01 00:00:00 PDT}
}

................................................................................
    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile Windhoek $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {

	    set retval {}
	    foreach char [split $string {}] {
		scan $char %c ccode
		if { $ccode >= 0x0020 && $ccode < 0x007f
		     && $char ne "\{" && $char ne "\}" && $char ne "\["
		     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
		    append retval $char
................................................................................
    join $trouble \n
} {}

# case-insensitive matching of weekday and month names [Bug 1781282]

test clock-60.1 {case insensitive weekday names} {
    clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.2 {case insensitive weekday names} {
    clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.3 {case insensitive weekday names} {
    clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.4 {case insensitive weekday names} {
    clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.5 {case insensitive weekday names} {
    clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.6 {case insensitive weekday names} {
    clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.7 {case insensitive month names} {
    clock scan "1 january 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.8 {case insensitive month names} {
    clock scan "1 January 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.9 {case insensitive month names} {
    clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.10 {case insensitive month names} {
    clock scan "1 december 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-60.11 {case insensitive month names} {
    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
	clock format 0x8000000000000000 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
	clock format -0x8000000000000001 -format %s -gmt true
    }
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.3 {near-miss overflow of a wide integer on output} {
    clock format 0x7fffffffffffffff -format %s -gmt true
} [expr 0x7fffffffffffffff]
test clock-61.4 {near-miss overflow of a wide integer on output} {

Changes to tests/compile.test.

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
...
220
221
222
223
224
225
226











227
228
229
230
231
232
233
...
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
...
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
    catch {catch-test error} ::foo
    return $::foo
} {GOOD}
test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
    proc foo {} {
	set fail [catch {
	    return 1
	}] ; # {}	
	return 2
    }
    foo
} {2}
test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
    proc foo {} {
	catch {
	    if {[a]} {
		if b {}
	    }   
	}   
    }
    list [catch foo msg] $msg
} {0 1}
test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}{
     -setup {
	 namespace eval catchtest {
	     variable result1 {}
................................................................................
    set ::foo 1
    proc foreach-test {} {
	foreach ::foo {1 2 3} {}
    }
    foreach-test
    set ::foo
} 3












test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup {
    catch {unset x}
    catch {unset y}
} -body {
    set x 123
    proc p {} {
................................................................................
    apply {{} { set r [list foobar] ; expr {!a} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg
} -returnCodes error -result {unmatched open brace in list}

# 
# Special section for tests of tclLiteral.c
# The following tests check for incorrect memory handling in
# TclReleaseLiteral. They are only effective when tcl is compiled with
# TCL_MEM_DEBUG
#
# Special test for leak on interp delete [Bug 467523]. 
test compile-12.1 {testing literal leak on interp delete} -setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	interp create foo 
	foo eval { 
	    namespace eval bar {}
	} 
	interp delete foo
	set tmp $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    rename getbytes {}
................................................................................
    set sourceFile [makeFile {
	for {set i 0} {$i < 5} {incr i} {
	    namespace eval bar {}
	    namespace delete bar
	}
	puts 0
    } source.file]
    exec [interpreter] $sourceFile 
} -cleanup {
    catch {removeFile $sourceFile}
} -result 0
# Test to catch buffer overrun in TclCompileTokens from buf 530320
test compile-12.3 {check for a buffer overrun} -body {
    proc crash {} {
	puts $array([expr {a+2}])
................................................................................
     catch {set bubba([join $abba $jubba]) $vol} msg2
     list $msg1 $msg2
} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}

test compile-14.2 {testing element name "$"} -body {
    unset -nocomplain a
    set a() 1
    set a(1) 2 
    set a($) 3
    list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
} -cleanup {unset a} -result [list 1 2 3 {$}]


# Tests compile-15.* cover Tcl Bug 633204
test compile-15.1 {proper TCL_RETURN code from [return]} {






|









|
|







 







>
>
>
>
>
>
>
>
>
>
>







 







|





|








|
|

|







 







|







 







|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
...
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
...
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
    catch {catch-test error} ::foo
    return $::foo
} {GOOD}
test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
    proc foo {} {
	set fail [catch {
	    return 1
	}] ; # {}
	return 2
    }
    foo
} {2}
test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
    proc foo {} {
	catch {
	    if {[a]} {
		if b {}
	    }
	}
    }
    list [catch foo msg] $msg
} {0 1}
test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}{
     -setup {
	 namespace eval catchtest {
	     variable result1 {}
................................................................................
    set ::foo 1
    proc foreach-test {} {
	foreach ::foo {1 2 3} {}
    }
    foreach-test
    set ::foo
} 3
test compile-5.3 {TclCompileForeachCmd: [Bug b9b2079e6d]} -setup {
    proc demo {} {
	foreach x y {
	    if 1 break else
	}
    }
} -body {
    demo
} -cleanup {
    rename demo {}
} -returnCodes error -result {wrong # args: no script following "else" argument}

test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup {
    catch {unset x}
    catch {unset y}
} -body {
    set x 123
    proc p {} {
................................................................................
    apply {{} { set r [list foobar] ; expr {!a} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg
} -returnCodes error -result {unmatched open brace in list}

#
# Special section for tests of tclLiteral.c
# The following tests check for incorrect memory handling in
# TclReleaseLiteral. They are only effective when tcl is compiled with
# TCL_MEM_DEBUG
#
# Special test for leak on interp delete [Bug 467523].
test compile-12.1 {testing literal leak on interp delete} -setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	interp create foo
	foo eval {
	    namespace eval bar {}
	}
	interp delete foo
	set tmp $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    rename getbytes {}
................................................................................
    set sourceFile [makeFile {
	for {set i 0} {$i < 5} {incr i} {
	    namespace eval bar {}
	    namespace delete bar
	}
	puts 0
    } source.file]
    exec [interpreter] $sourceFile
} -cleanup {
    catch {removeFile $sourceFile}
} -result 0
# Test to catch buffer overrun in TclCompileTokens from buf 530320
test compile-12.3 {check for a buffer overrun} -body {
    proc crash {} {
	puts $array([expr {a+2}])
................................................................................
     catch {set bubba([join $abba $jubba]) $vol} msg2
     list $msg1 $msg2
} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}

test compile-14.2 {testing element name "$"} -body {
    unset -nocomplain a
    set a() 1
    set a(1) 2
    set a($) 3
    list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
} -cleanup {unset a} -result [list 1 2 3 {$}]


# Tests compile-15.* cover Tcl Bug 633204
test compile-15.1 {proper TCL_RETURN code from [return]} {

Changes to tests/coroutine.test.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
...
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
...
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
	set imax $stop
	yield
	while {$i < $imax} {
	    set stop [yield [expr {$i*$stop}]]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 2} {stop 10}} $body] 
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo $k]
    }
    set res
} -cleanup {
................................................................................
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call	
	expr {[getNumLevel] - $base - 1}
    }
    proc foo {} {
	while 1 {
	    nestedYield
	}
    }
................................................................................
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call	
	expr {[getNumLevel] - $base - 1}
    }
    proc foo base {
	while 1 {
	    set base [nestedYield [relativeLevel $base]]
	}
    }
................................................................................
	    set a [yieldto return -level 0 $a]
	    lappend a [llength $a]
	}
    }
    coroutine a corobody
    coroutine b corobody
    list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
	[b ok] [rename b {}] 
} -cleanup {
    rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
test coroutine-7.3 {yielding between coroutines} -body {
    proc juggler {target {value ""}} {
	if {$value eq ""} {
	    set value [yield [info coroutine]]






|







 







|







 







|







 







|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
...
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
...
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
	set imax $stop
	yield
	while {$i < $imax} {
	    set stop [yield [expr {$i*$stop}]]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 2} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo $k]
    }
    set res
} -cleanup {
................................................................................
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call
	expr {[getNumLevel] - $base - 1}
    }
    proc foo {} {
	while 1 {
	    nestedYield
	}
    }
................................................................................
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call
	expr {[getNumLevel] - $base - 1}
    }
    proc foo base {
	while 1 {
	    set base [nestedYield [relativeLevel $base]]
	}
    }
................................................................................
	    set a [yieldto return -level 0 $a]
	    lappend a [llength $a]
	}
    }
    coroutine a corobody
    coroutine b corobody
    list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
	[b ok] [rename b {}]
} -cleanup {
    rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
test coroutine-7.3 {yielding between coroutines} -body {
    proc juggler {target {value ""}} {
	if {$value eq ""} {
	    set value [yield [info coroutine]]

Changes to tests/encoding.test.

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
    set system [encoding system]
    set path [encoding dirs]
} -constraints {testencoding} -body {
    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found   
    encoding system identity
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system identity
    encoding dirs $path
    encoding system $system
................................................................................

test encoding-8.1 {Tcl_ExternalToUtf} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding iso8859-1
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis    
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
................................................................................
    encoding system identity
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary 
    puts $f "abcdefghijklmnop"
    close $f
    encoding convertto splat \u4e4e
} -returnCodes error -cleanup {
    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
................................................................................

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u120]
    append x [encoding convertto iso8859-3 \ud5]
    append x [encoding convertfrom iso8859-3 \xd5]
} "\xd5?\u120"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 ab\u0120g] 
    append x [encoding convertfrom iso8859-3 ab\xd5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab\u4e4eg] 
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 \u4e4e\u3b1]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {






|







 







|







 







|







 







|



|







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
    set system [encoding system]
    set path [encoding dirs]
} -constraints {testencoding} -body {
    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found
    encoding system identity
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system identity
    encoding dirs $path
    encoding system $system
................................................................................

test encoding-8.1 {Tcl_ExternalToUtf} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding iso8859-1
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
................................................................................
    encoding system identity
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary
    puts $f "abcdefghijklmnop"
    close $f
    encoding convertto splat \u4e4e
} -returnCodes error -cleanup {
    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
................................................................................

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u120]
    append x [encoding convertto iso8859-3 \ud5]
    append x [encoding convertfrom iso8859-3 \xd5]
} "\xd5?\u120"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 ab\u0120g]
    append x [encoding convertfrom iso8859-3 ab\xd5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab\u4e4eg]
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 \u4e4e\u3b1]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {

Changes to tests/execute.test.

694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
....
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
} -body {
    set e { [llength {}]+1 }
    set result {}
    interp alias {} e slave expr
    lappend result [e $e]
    interp delete slave
    interp create slave
    interp alias {} e slave expr 
    lappend result [e $e]
} -cleanup {
    interp delete slave
} -result {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
    set e { [llength {}]+1 }
    set result {}
................................................................................
} -returnCodes error -match glob -result *
test execute-10.3 {Bug 3072640} -setup {
    proc generate {n} {
	for {set i 0} {$i < $n} {incr i} {
	    yield $i
	}
    }
    proc t {args} { 
	incr ::foo 
    }
    trace add execution ::generate enterstep ::t
} -body {
    coroutine coro generate 5
    trace remove execution ::generate enterstep ::t
    set ::foo
} -cleanup {






|







 







|
|







694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
....
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
} -body {
    set e { [llength {}]+1 }
    set result {}
    interp alias {} e slave expr
    lappend result [e $e]
    interp delete slave
    interp create slave
    interp alias {} e slave expr
    lappend result [e $e]
} -cleanup {
    interp delete slave
} -result {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
    set e { [llength {}]+1 }
    set result {}
................................................................................
} -returnCodes error -match glob -result *
test execute-10.3 {Bug 3072640} -setup {
    proc generate {n} {
	for {set i 0} {$i < $n} {incr i} {
	    yield $i
	}
    }
    proc t {args} {
	incr ::foo
    }
    trace add execution ::generate enterstep ::t
} -body {
    coroutine coro generate 5
    trace remove execution ::generate enterstep ::t
    set ::foo
} -cleanup {

Changes to tests/expr-old.test.

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
....
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36
test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1
test expr-old-21.3 {parenthesization} {expr +(3-4)} -1

# Embedded commands and variable names.

set a 16 
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32 
test expr-old-22.2 {embedded variables} {
    set x -5
    set y 10
    expr {$x + $y}
} {5} 
test expr-old-22.3 {embedded variables} {
    set x "  -5"
    set y "  +10"
    expr {$x + $y}
} {5}
test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
test expr-old-22.5 {embedded commands and variables} {
................................................................................
    ieeeFloatingPoint&&testexprdouble {
	testexprdouble 17976931348623165[string repeat 0 292]
    } {This is a result: Inf}
test expr-old-37.25 {Tcl_ExprDouble and NaN} \
    {ieeeFloatingPoint testexprdouble} {
	list [catch {testexprdouble 0.0/0.0} result] $result
    } {1 {domain error: argument not in valid range}}
    
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
	    [catch {testexprstring "1+"} msg] $msg
} -match glob -result {5 10.2 1 *}
test expr-old-38.2 {Tcl_ExprString} testexprstring {
    # This one is "magical"
    testexprstring {}






|
|




|







 







|







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
....
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36
test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1
test expr-old-21.3 {parenthesization} {expr +(3-4)} -1

# Embedded commands and variable names.

set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
test expr-old-22.2 {embedded variables} {
    set x -5
    set y 10
    expr {$x + $y}
} {5}
test expr-old-22.3 {embedded variables} {
    set x "  -5"
    set y "  +10"
    expr {$x + $y}
} {5}
test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
test expr-old-22.5 {embedded commands and variables} {
................................................................................
    ieeeFloatingPoint&&testexprdouble {
	testexprdouble 17976931348623165[string repeat 0 292]
    } {This is a result: Inf}
test expr-old-37.25 {Tcl_ExprDouble and NaN} \
    {ieeeFloatingPoint testexprdouble} {
	list [catch {testexprdouble 0.0/0.0} result] $result
    } {1 {domain error: argument not in valid range}}

test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
	    [catch {testexprstring "1+"} msg] $msg
} -match glob -result {5 10.2 1 *}
test expr-old-38.2 {Tcl_ExprString} testexprstring {
    # This one is "magical"
    testexprstring {}

Changes to tests/expr.test.

1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
....
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
....
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
test expr-23.74.2 {INST_EXPON: Bug 2798543} -body {
    expr {14**17 == 14**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.74.3 {INST_EXPON: Bug 2798543} {
    expr {(-14)**17 == (-14)**65553}
} 0

	
# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
................................................................................
    0 1 1 1 1 \
    0 -1 -2 -3 -4 \
    0 0 2 2 2 \
    0 0 -1 -2 -3 \
    0 1 0 3 3 \
    0 -1 0 -1 -2 \
    ]
        
test expr-32.2 {expr div basics} {
    set mod_nums [list \
        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \
        {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \
        {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \
................................................................................
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
    
test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
    testexprdoubleobj 4.+1.
} {This is a result: 5.0}
#Check for [Bug 1109484]
test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
    -constraints {testexprdoubleobj} \
    -match glob \






|







 







|







 







|







1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
....
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
....
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
test expr-23.74.2 {INST_EXPON: Bug 2798543} -body {
    expr {14**17 == 14**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.74.3 {INST_EXPON: Bug 2798543} {
    expr {(-14)**17 == (-14)**65553}
} 0


# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
................................................................................
    0 1 1 1 1 \
    0 -1 -2 -3 -4 \
    0 0 2 2 2 \
    0 0 -1 -2 -3 \
    0 1 0 3 3 \
    0 -1 0 -1 -2 \
    ]

test expr-32.2 {expr div basics} {
    set mod_nums [list \
        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \
        {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \
        {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \
................................................................................
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}

test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
    testexprdoubleobj 4.+1.
} {This is a result: 5.0}
#Check for [Bug 1109484]
test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
    -constraints {testexprdoubleobj} \
    -match glob \

Changes to tests/fileSystem.test.

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
...
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
    unix hasLinks
} -body {
    file link dir2.link dir.link
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.link inside.file foo]]
} -cleanup {
    file delete dir2.link
} -result ok 
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link dir2.link dir.link
    file link [file join dir2.file dir2.link] [file join .. dir2.link]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.file dir2.link inside.file foo]]
} ok
................................................................................
    close [open dgp/test w]
    foreach relative [glob -nocomplain [file join * test]] {
	set absolute [file join [pwd] $relative]
	set res [list [file tail $absolute] "test"]
    }
    return $res
} -cleanup {
    file delete -force dgp 
    cd $origdir
} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
    set res {}
    set p "C:\\toto"
    lappend res [file join $p toto]
    file isdirectory $p






|







 







|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
...
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
    unix hasLinks
} -body {
    file link dir2.link dir.link
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.link inside.file foo]]
} -cleanup {
    file delete dir2.link
} -result ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link dir2.link dir.link
    file link [file join dir2.file dir2.link] [file join .. dir2.link]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.file dir2.link inside.file foo]]
} ok
................................................................................
    close [open dgp/test w]
    foreach relative [glob -nocomplain [file join * test]] {
	set absolute [file join [pwd] $relative]
	set res [list [file tail $absolute] "test"]
    }
    return $res
} -cleanup {
    file delete -force dgp
    cd $origdir
} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
    set res {}
    set p "C:\\toto"
    lappend res [file join $p toto]
    file isdirectory $p

Changes to tests/for.test.

299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
        13 {From: George <[email protected]>} \
        14 {The Tcl 7.6 and Tk 4.2 releases} \
        15 {} \
        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
        19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
        20 {} \
        21 {} \
        22 {What's new } \
        23 {} \
        24 {The most important changes in the releases are summarized below. See the README} \
        25 {and changes files in the distributions for more complete information on what has} \
        26 {changed, including both feature changes and bug fixes. } \
        27 {} \
        28 {     There are new options to the file command for copying files (file copy),} \
        29 {     deleting files and directories (file delete), creating directories (file} \
        30 {     mkdir), and renaming files (file rename). } \
        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
        32 {     Windows NT. } \
        33 {     There is a new memory allocator for the Macintosh version, which should be} \
        34 {     more efficient than the old one. } \
        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
        36 {     algorithm produces much better layouts than before, especially where rows or} \
        37 {     columns were stretchable. } \
        38 {     There are new commands for creating common dialog boxes:} \
        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
        40 {     tk_messageBox. These use native dialog boxes if they are available. } \
        41 {     There is a new virtual event mechanism for handling events in a more portable} \
        42 {     way. See the new command event. It also allows events (both physical and} \
        43 {     virtual) to be generated dynamically. } \
        44 {} \
        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
        47 {should work on these new releases as well. } \
        48 {} \
        49 {Obtaining The Releases} \
        50 {} \
        51 {Binary Releases} \
        52 {} \
        53 {Pre-compiled releases are available for the following platforms: } \
        54 {} \
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
        58 {     tclsh programs, and documentation. } \
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
        63 {     folder containing all that you need to run Tcl and Tk. } \
        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
................................................................................
it. The first beta versions of these
releases were released on August 30, 1996. These releas
es contain only minor changes,
so we hope to have only a single beta release and to 
go final in early October, 1996.


What's new 

The most important changes in the releases are summariz
ed below. See the README
and changes files in the distributions for more complet
e information on what has
changed, including both feature changes and bug fixes. 

     There are new options to the file command for 
copying files (file copy),
     deleting files and directories (file delete), 
creating directories (file
     mkdir), and renaming files (file rename). 
     The implementation of exec has been improved great
ly for Windows 95 and
     Windows NT. 
     There is a new memory allocator for the Macintosh 
version, which should be
     more efficient than the old one. 
     Tk's grid geometry manager has been completely 
rewritten. The layout
     algorithm produces much better layouts than before
, especially where rows or
     columns were stretchable. 
     There are new commands for creating common dialog 
boxes:
     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
     tk_messageBox. These use native dialog boxes if 
they are available.
     There is a new virtual event mechanism for handlin
g events in a more portable
     way. See the new command event. It also allows 
events (both physical and
     virtual) to be generated dynamically. 

Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 
7.5 and Tk 4.1 except for
changes in the C APIs for custom channel drivers. Scrip
ts written for earlier releases
should work on these new releases as well. 

Obtaining The Releases

Binary Releases

Pre-compiled releases are available for the following 
platforms:

     Windows 3.1, Windows 95, and Windows NT: Fetch
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 
execute it. The file is a
     self-extracting executable. It will install the 
Tcl and Tk libraries, the wish and
     tclsh programs, and documentation. 
     Macintosh (both 68K and PowerPC): Fetch
     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 
The file is in binhex format,
     which is understood by Fetch, StuffIt, and many 
other Mac utilities. The
     unpacked file is a self-installing executable: 
double-click on it and it will create a






|


|



|



|

|

|


|


|


|



|










|







 







|





|





|


|


|




|









|





|













|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
        13 {From: George <[email protected]>} \
        14 {The Tcl 7.6 and Tk 4.2 releases} \
        15 {} \
        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
        19 {so we hope to have only a single beta release and to go final in early October, 1996.} \
        20 {} \
        21 {} \
        22 {What's new} \
        23 {} \
        24 {The most important changes in the releases are summarized below. See the README} \
        25 {and changes files in the distributions for more complete information on what has} \
        26 {changed, including both feature changes and bug fixes.} \
        27 {} \
        28 {     There are new options to the file command for copying files (file copy),} \
        29 {     deleting files and directories (file delete), creating directories (file} \
        30 {     mkdir), and renaming files (file rename).} \
        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
        32 {     Windows NT.} \
        33 {     There is a new memory allocator for the Macintosh version, which should be} \
        34 {     more efficient than the old one.} \
        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
        36 {     algorithm produces much better layouts than before, especially where rows or} \
        37 {     columns were stretchable.} \
        38 {     There are new commands for creating common dialog boxes:} \
        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
        40 {     tk_messageBox. These use native dialog boxes if they are available.} \
        41 {     There is a new virtual event mechanism for handling events in a more portable} \
        42 {     way. See the new command event. It also allows events (both physical and} \
        43 {     virtual) to be generated dynamically.} \
        44 {} \
        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
        47 {should work on these new releases as well.} \
        48 {} \
        49 {Obtaining The Releases} \
        50 {} \
        51 {Binary Releases} \
        52 {} \
        53 {Pre-compiled releases are available for the following platforms: } \
        54 {} \
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
        58 {     tclsh programs, and documentation.} \
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
        63 {     folder containing all that you need to run Tcl and Tk. } \
        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
................................................................................
it. The first beta versions of these
releases were released on August 30, 1996. These releas
es contain only minor changes,
so we hope to have only a single beta release and to 
go final in early October, 1996.


What's new

The most important changes in the releases are summariz
ed below. See the README
and changes files in the distributions for more complet
e information on what has
changed, including both feature changes and bug fixes.

     There are new options to the file command for 
copying files (file copy),
     deleting files and directories (file delete), 
creating directories (file
     mkdir), and renaming files (file rename).
     The implementation of exec has been improved great
ly for Windows 95 and
     Windows NT.
     There is a new memory allocator for the Macintosh 
version, which should be
     more efficient than the old one.
     Tk's grid geometry manager has been completely 
rewritten. The layout
     algorithm produces much better layouts than before
, especially where rows or
     columns were stretchable.
     There are new commands for creating common dialog 
boxes:
     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
     tk_messageBox. These use native dialog boxes if 
they are available.
     There is a new virtual event mechanism for handlin
g events in a more portable
     way. See the new command event. It also allows 
events (both physical and
     virtual) to be generated dynamically.

Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 
7.5 and Tk 4.1 except for
changes in the C APIs for custom channel drivers. Scrip
ts written for earlier releases
should work on these new releases as well.

Obtaining The Releases

Binary Releases

Pre-compiled releases are available for the following 
platforms:

     Windows 3.1, Windows 95, and Windows NT: Fetch
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 
execute it. The file is a
     self-extracting executable. It will install the 
Tcl and Tk libraries, the wish and
     tclsh programs, and documentation.
     Macintosh (both 68K and PowerPC): Fetch
     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 
The file is in binhex format,
     which is understood by Fetch, StuffIt, and many 
other Mac utilities. The
     unpacked file is a self-installing executable: 
double-click on it and it will create a

Changes to tests/history.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
  
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# The history command might be autoloaded...
if {[catch {history}]} {






|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# The history command might be autoloaded...
if {[catch {history}]} {

Changes to tests/httpd.

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
		append html </dl>\n
	    }
	    append html </body></html>
	}
    }

    # Catch errors from premature client closes
    
    catch {
	if {$data(proto) == "HEAD"} {
	    puts $sock "HTTP/1.0 200 OK"
	} else {
            # Split the response to test for [Bug 26245326]
	    puts -nonewline $sock "HT"
            flush $sock






|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
		append html </dl>\n
	    }
	    append html </body></html>
	}
    }

    # Catch errors from premature client closes

    catch {
	if {$data(proto) == "HEAD"} {
	    puts $sock "HTTP/1.0 200 OK"
	} else {
            # Split the response to test for [Bug 26245326]
	    puts -nonewline $sock "HT"
            flush $sock

Changes to tests/httpold.test.

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
	return
    }
}

set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}

## 
## The httpd script implement a stub http server
##
source [file join [file dirname [info script]] httpd]

set port 8010
if [catch {httpd_init $port} listen] {
    puts "Cannot start http server, http test skipped"






|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
	return
    }
}

set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}

##
## The httpd script implement a stub http server
##
source [file join [file dirname [info script]] httpd]

set port 8010
if [catch {httpd_init $port} listen] {
    puts "Cannot start http server, http test skipped"

Changes to tests/info.test.

2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
....
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
....
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x y
	{set res [info frame 0]}
    } 
    return $res
}
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
................................................................................

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if {*}{
	{[return [info frame 0]]}
	{}
    } 
}
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if 0 {*}{
	{} else
	{return [info frame 0]}
    } 
}
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}

................................................................................
} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } 
    return $res
}
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}






|







 







|













|







 







|







2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
....
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
....
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x y
	{set res [info frame 0]}
    }
    return $res
}
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
................................................................................

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if {*}{
	{[return [info frame 0]]}
	{}
    }
}
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if 0 {*}{
	{} else
	{return [info frame 0]}
    }
}
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}

................................................................................
} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}

Changes to tests/init.test.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    auto_qualify ::foo::bar ::blue
} ::foo::bar
test init-1.2 {auto_qualify - absolute cmd - global} {
    auto_qualify ::global ::sub
} global
test init-1.3 {auto_qualify - no colons cmd - global} {
    auto_qualify nocolons ::
} nocolons 
test init-1.4 {auto_qualify - no colons cmd - namespace} {
    auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}
test init-1.5 {auto_qualify - colons in cmd - global} {
    auto_qualify foo::bar ::
} ::foo::bar
test init-1.6 {auto_qualify - colons in cmd - namespace} {
................................................................................
test init-2.5 {load safe:::setLogCmd - stage 2} {
    safe:::setLogCmd  ;# intentionally 3 :
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
auto_reset
catch {rename ::safe::setLogCmd {}}
test init-2.6 {load setLogCmd from safe:: - stage 1} {
    namespace eval safe setLogCmd 
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
test init-2.7 {oad setLogCmd from safe::  - stage 2} {
    namespace eval safe setLogCmd 
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
test init-2.8 {load tcl::HistAdd} -setup {
    auto_reset
    catch {rename ::tcl::HistAdd {}}
} -body {
    # 3 ':' on purpose
................................................................................
                which spans
                multiple lines}
    {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
    {argument which spans multiple lines
                and is long enough to be truncated and
"               <- includes a false lead in the prune point search
                and must be longer still to force truncation}
                {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar foo
"}
    {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar
"}
    {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
	}] {    ;# emacs needs -> "







|







 







|



|







 







|




|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    auto_qualify ::foo::bar ::blue
} ::foo::bar
test init-1.2 {auto_qualify - absolute cmd - global} {
    auto_qualify ::global ::sub
} global
test init-1.3 {auto_qualify - no colons cmd - global} {
    auto_qualify nocolons ::
} nocolons
test init-1.4 {auto_qualify - no colons cmd - namespace} {
    auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}
test init-1.5 {auto_qualify - colons in cmd - global} {
    auto_qualify foo::bar ::
} ::foo::bar
test init-1.6 {auto_qualify - colons in cmd - namespace} {
................................................................................
test init-2.5 {load safe:::setLogCmd - stage 2} {
    safe:::setLogCmd  ;# intentionally 3 :
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
auto_reset
catch {rename ::safe::setLogCmd {}}
test init-2.6 {load setLogCmd from safe:: - stage 1} {
    namespace eval safe setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
test init-2.7 {oad setLogCmd from safe::  - stage 2} {
    namespace eval safe setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
} {}
test init-2.8 {load tcl::HistAdd} -setup {
    auto_reset
    catch {rename ::tcl::HistAdd {}}
} -body {
    # 3 ':' on purpose
................................................................................
                which spans
                multiple lines}
    {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
    {argument which spans multiple lines
                and is long enough to be truncated and
"               <- includes a false lead in the prune point search
                and must be longer still to force truncation}
                {contrived example: rare circumstance
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar foo
"}
    {contrived example: rare circumstance
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar
"}
    {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
	}] {    ;# emacs needs -> "

Changes to tests/interp.test.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
..
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
...
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
...
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
....
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
....
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
....
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
....
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
....
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
....
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
....
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
    interp hello
} -result {bad option "hello": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
    interp -froboz
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
    interp -froboz -safe
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} 
test interp-1.10 {options for interp command} -returnCodes error -body {
    interp target
} -result {wrong # args: should be "interp target path alias"}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a
} a
test interp-2.2 {basic interpreter creation} {
    catch {interp create}
} 0
test interp-2.3 {basic interpreter creation} {
    catch {interp create -safe}
} 0 
test interp-2.4 {basic interpreter creation} {
    list [catch {interp create a} msg] $msg
} {1 {interpreter named "a" already exists, cannot create}}
test interp-2.5 {basic interpreter creation} {
    interp create b -safe
} b
test interp-2.6 {basic interpreter creation} {
................................................................................
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum > $thenum
} 1    
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy anothernum
................................................................................
    proc dela {} {interp delete a}
    list [catch {a eval foo} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.9 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}     
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}     

# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
................................................................................
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr 34 * 34}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156    

test interp-20.1 {interp hide, interp expose and interp invokehidden} {
    set a [interp create]
    $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
    $a eval {proc foo {} {}}
    $a hide foo
    catch {$a eval foo something} msg
................................................................................
    interp delete a
    set l
} {{[list x y z] f g h} z}
test interp-20.21 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]    
    lappend l $msg
    interp delete a
    set l
} {0 {}}
test interp-20.22 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]    
    lappend l $msg
    interp delete a
    set l
} {0 {}}
test interp-20.23 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a eval {interp hide {} list}} msg]    
    lappend l $msg
    interp delete a
    set l
} {1 {permission denied: safe interpreter cannot hide commands}}
test interp-20.24 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {a eval {interp hide b list}} msg]    
    lappend l $msg
    interp delete a
    set l
} {1 {permission denied: safe interpreter cannot hide commands}}
test interp-20.25 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
................................................................................
    interp delete a
    set l
} {0 {}}
test interp-20.26 {interp expoose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]    
    lappend l $msg
    lappend l [catch {a expose list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.27 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]    
    lappend l $msg
    lappend l [catch {interp expose a list} msg]    
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.28 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]    
    lappend l $msg
    lappend l [catch {a eval {interp expose {} list}} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.29 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]    
    lappend l $msg
    lappend l [catch {a eval {interp expose {} list}} msg]    
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.30 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {interp hide {a b} list} msg]    
    lappend l $msg
    lappend l [catch {a eval {interp expose b list}} msg]    
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.31 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {interp hide {a b} list} msg]    
    lappend l $msg
    lappend l [catch {interp expose {a b} list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.32 {interp invokehidden vs safety} {
................................................................................
test interp-21.5 {interp hidden} -setup {
    catch {interp delete a}
} -body {
    interp create -safe a
    lsort [interp hidden a]
} -cleanup {
    interp delete a
} -result $hidden_cmds 
test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
    catch {interp delete a}
    set l ""
} -body {
    interp create a
    lappend l [interp hidden a]
    interp hide a pwd
................................................................................
"test"}

# Interps & Namespaces
test interp-27.1 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} { 
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    $i alias foo::bar tstAlias foo::bar
    $i eval foo::bar test
    return $aliasTrace
} -cleanup {
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.2 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} { 
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    $i alias foo::bar tstAlias foo::bar
    $i eval namespace eval foo {bar test}
    return $aliasTrace
} -cleanup {
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.3 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} { 
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
    interp alias $i foo::bar {} tstAlias foo::bar
    interp eval $i {namespace eval foo {bar test}}
    return $aliasTrace
................................................................................
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.4 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    namespace eval foo2 {
	variable aliasTrace {}
	proc bar {args} { 
	    variable aliasTrace
	    lappend aliasTrace [list [namespace current] $args]
	}
    }
    $i alias foo::bar foo2::bar foo::bar
    $i eval namespace eval foo {bar test}
    return $foo2::aliasTrace
................................................................................
    set t0 [clock seconds]
    interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1
    set code [catch {
	$i eval {after 10000}
    } msg]
    set t1 [clock seconds]
    interp delete $i
    list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}] 
} {1 {time limit exceeded} OK}
test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
    set i [interp create]
    # Assume someone hasn't set the clock to early 1970!
    $i limit time -seconds 1 -granularity 4
    interp alias $i log {} lappend result
    set result {}
................................................................................
test interp-35.24 {interp time limits can't touch current interp} -body {
    interp limit {} time -seconds 2
} -returnCodes error -result {limits on current interpreter inaccessible}

test interp-36.1 {interp bgerror syntax} -body {
    interp bgerror
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.2 {interp bgerror syntax} -body { 
    interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
    interp create slave
} -body {
    slave bgerror x y
} -cleanup {






|













|







 







|







 







|




|







 







|







 







|








|








|









|







 







|










|

|








|










|

|









|

|









|







 







|







 







|













|













|







 







|







 







|







 







|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
..
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
...
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
...
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
....
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
....
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
....
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
....
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
....
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
....
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
....
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
    interp hello
} -result {bad option "hello": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
    interp -froboz
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
    interp -froboz -safe
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
    interp target
} -result {wrong # args: should be "interp target path alias"}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a
} a
test interp-2.2 {basic interpreter creation} {
    catch {interp create}
} 0
test interp-2.3 {basic interpreter creation} {
    catch {interp create -safe}
} 0
test interp-2.4 {basic interpreter creation} {
    list [catch {interp create a} msg] $msg
} {1 {interpreter named "a" already exists, cannot create}}
test interp-2.5 {basic interpreter creation} {
    interp create b -safe
} b
test interp-2.6 {basic interpreter creation} {
................................................................................
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum > $thenum
} 1
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy anothernum
................................................................................
    proc dela {} {interp delete a}
    list [catch {a eval foo} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.9 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}

# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
................................................................................
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr 34 * 34}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156

test interp-20.1 {interp hide, interp expose and interp invokehidden} {
    set a [interp create]
    $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
    $a eval {proc foo {} {}}
    $a hide foo
    catch {$a eval foo something} msg
................................................................................
    interp delete a
    set l
} {{[list x y z] f g h} z}
test interp-20.21 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {}}
test interp-20.22 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {}}
test interp-20.23 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a eval {interp hide {} list}} msg]
    lappend l $msg
    interp delete a
    set l
} {1 {permission denied: safe interpreter cannot hide commands}}
test interp-20.24 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {a eval {interp hide b list}} msg]
    lappend l $msg
    interp delete a
    set l
} {1 {permission denied: safe interpreter cannot hide commands}}
test interp-20.25 {interp hide vs safety} {
    catch {interp delete a}
    interp create a -safe
................................................................................
    interp delete a
    set l
} {0 {}}
test interp-20.26 {interp expoose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]
    lappend l $msg
    lappend l [catch {a expose list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.27 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]
    lappend l $msg
    lappend l [catch {interp expose a list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.28 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {a hide list} msg]
    lappend l $msg
    lappend l [catch {a eval {interp expose {} list}} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.29 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [catch {interp hide a list} msg]
    lappend l $msg
    lappend l [catch {a eval {interp expose {} list}} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.30 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {interp hide {a b} list} msg]
    lappend l $msg
    lappend l [catch {a eval {interp expose b list}} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 1 {permission denied: safe interpreter cannot expose commands}}
test interp-20.31 {interp expose vs safety} {
    catch {interp delete a}
    interp create a -safe
    interp create {a b}
    set l ""
    lappend l [catch {interp hide {a b} list} msg]
    lappend l $msg
    lappend l [catch {interp expose {a b} list} msg]
    lappend l $msg
    interp delete a
    set l
} {0 {} 0 {}}
test interp-20.32 {interp invokehidden vs safety} {
................................................................................
test interp-21.5 {interp hidden} -setup {
    catch {interp delete a}
} -body {
    interp create -safe a
    lsort [interp hidden a]
} -cleanup {
    interp delete a
} -result $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
    catch {interp delete a}
    set l ""
} -body {
    interp create a
    lappend l [interp hidden a]
    interp hide a pwd
................................................................................
"test"}

# Interps & Namespaces
test interp-27.1 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    $i alias foo::bar tstAlias foo::bar
    $i eval foo::bar test
    return $aliasTrace
} -cleanup {
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.2 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    $i alias foo::bar tstAlias foo::bar
    $i eval namespace eval foo {bar test}
    return $aliasTrace
} -cleanup {
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.3 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    set aliasTrace {}
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
    }
    interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
    interp alias $i foo::bar {} tstAlias foo::bar
    interp eval $i {namespace eval foo {bar test}}
    return $aliasTrace
................................................................................
    interp delete $i
} -result {{:: {foo::bar test}}}
test interp-27.4 {interp aliases & namespaces} -setup {
    set i [interp create]
} -body {
    namespace eval foo2 {
	variable aliasTrace {}
	proc bar {args} {
	    variable aliasTrace
	    lappend aliasTrace [list [namespace current] $args]
	}
    }
    $i alias foo::bar foo2::bar foo::bar
    $i eval namespace eval foo {bar test}
    return $foo2::aliasTrace
................................................................................
    set t0 [clock seconds]
    interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1
    set code [catch {
	$i eval {after 10000}
    } msg]
    set t1 [clock seconds]
    interp delete $i
    list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
} {1 {time limit exceeded} OK}
test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
    set i [interp create]
    # Assume someone hasn't set the clock to early 1970!
    $i limit time -seconds 1 -granularity 4
    interp alias $i log {} lappend result
    set result {}
................................................................................
test interp-35.24 {interp time limits can't touch current interp} -body {
    interp limit {} time -seconds 2
} -returnCodes error -result {limits on current interpreter inaccessible}

test interp-36.1 {interp bgerror syntax} -body {
    interp bgerror
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.2 {interp bgerror syntax} -body {
    interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
    interp create slave
} -body {
    slave bgerror x y
} -cleanup {

Changes to tests/io.test.

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
...
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
...
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
...
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
...
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
...
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
....
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
....
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
....
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
....
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
....
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
....
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
....
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
....
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
test io-1.8 {Tcl_WriteChars: WriteChars} {
    # This test written for SF bug #506297.
    #
    # Executing this test without the fix for the referenced bug
    # applied to tcl will cause tcl, more specifically WriteChars, to
    # go into an infinite loop.

    set f [open $path(test2) w] 
    fconfigure      $f -encoding iso2022-jp 
    puts -nonewline $f [format %s%c [string repeat " " 4] 12399] 
    close           $f 
    contents $path(test2)
} "    \x1b\$B\$O\x1b(B"

test io-1.9 {Tcl_WriteChars: WriteChars} {
    # When closing a channel with an encoding that appends
    # escape bytes, check for the case where the escape
    # bytes overflow the current IO buffer. The bytes
................................................................................
    lappend sizes [file size $path(test2)]

    set sizes
} {19 19 19 19 19}

test io-2.1 {WriteBytes} {
    # loop until all bytes are written
    
    set f [open $path(test1) w]
    fconfigure $f  -encoding binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
................................................................................
    close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.
    
    set f [open $path(test1) w]
    fconfigure $f -encoding binary -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents $path(test1)]
    close $f
    set x
} "\r\n12"
................................................................................
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

test io-3.1 {WriteChars: compatibility with WriteBytes} {
    # loop until all bytes are written
    
    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
................................................................................
    close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.
    
    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents $path(test1)]
    close $f
    set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} {
    # stage buffer maps to more than can be queued at once.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 16 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} {
    # Bytes produced by UtfToExternal from end of last channel buffer
    # had to be moved to beginning of next channel buffer to preserve
    # requested buffersize.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
    # One incomplete UTF-8 character at end of staging buffer.  Backup
................................................................................
    # When translating UTF-8 to external, the produced bytes went past end
    # of the channel buffer.  This is done purpose -- we then truncate the
    # bytes at the end of the partial character to preserve the requested
    # blocksize on flush.  The truncated bytes are moved to the beginning
    # of the next channel buffer.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17 
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.8 {WriteChars: reset sawLF after each buffer} {
    set f [open $path(test1) w]
................................................................................
    puts -nonewline $f "12345678901\n456789012345678901234"
    close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]
    fconfigure $f 
    puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]
................................................................................
    close $f
    set x
} [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
    # if (dst >= dstEnd) 

    set f [open $path(test1) w]
    puts $f $a
    puts $f hi
    close $f
    set f [open $path(test1)]
    set x [list [gets $f line] $line]
................................................................................
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
    # eol still equals dstEnd
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
    # not (*eol == '\n') 
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\rabcd\r\nefg"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f]]
................................................................................

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
    # not (*eol == '\n') 

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
................................................................................
    puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list "123456789012345" 15]    
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
    # PeekAhead() did not get any, so (eol >= dstEnd)
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel queuedcr $f]]
    close $f
    set x
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
    # if (*eol == '\n') {skip++}
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r\n78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
    # not (*eol == '\n') 
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
    # else if (*eol == '\n') {goto gotoeol;}
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\n78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [tell $f] [gets $f]]
    close $f
................................................................................
    fconfigure $f -encoding shiftjis -buffersize 16
    set x [gets $f]
    close $f
    set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
    # (bufPtr->nextAdded < bufPtr->bufLength)
    
    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line [eof $f]]
................................................................................

    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
    # is 30).  To check if "\n" follows, calls PeekAhead and determines
    # that cached data is available in buffer w/o having to call driver.

    set x [gets $f]
    close $f
    set x    
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
    # (bufPtr->nextAdded < bufPtr->length)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary}
................................................................................
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) 

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary} -buffersize 16
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
................................................................................
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
    # (src >= srcMax) 

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
    # (src >= srcMax) 

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\rfgh"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
    # (src >= srcMax) 

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\nfgh"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
................................................................................
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [read $f]
    close $f
    set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
    # not (*src == '\r') 

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\ndef"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
................................................................................
    encoding system ascii
    set f [open $path(test1) w]
    set x [fconfigure $f -encoding]
    close $f
    encoding system $old
	close $a
    set x
} {ascii}    
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
    set f [open $path(test1) w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
................................................................................
test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list [interpreter] << exit]"]
    expr [pid $f]
    close $f
} {}    

# Test flushing. The functions tested here are FlushChannel.

test io-27.1 {FlushChannel, no output buffered} {
    file delete $path(test1)
    set f [open $path(test1) w]
    flush $f
................................................................................
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x 
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
................................................................................
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf 
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]
................................................................................
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -encoding {} 
    puts -nonewline $f \xe7\x89\xa6
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x






|
|
|
|







 







|







 







|







 







|







 







|











|











|







 







|







 







|







 







|







 







|











|
|







 







|








|







|







 







|


|












|










|
|











|







 







|







 







|







 







|







 







|












|












|







 







|







 







|







 







|







 







|







 







|







 







|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
...
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
...
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
...
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
...
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
...
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
....
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
....
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
....
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
....
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
....
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
....
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
....
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
....
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
test io-1.8 {Tcl_WriteChars: WriteChars} {
    # This test written for SF bug #506297.
    #
    # Executing this test without the fix for the referenced bug
    # applied to tcl will cause tcl, more specifically WriteChars, to
    # go into an infinite loop.

    set f [open $path(test2) w]
    fconfigure      $f -encoding iso2022-jp
    puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
    close           $f
    contents $path(test2)
} "    \x1b\$B\$O\x1b(B"

test io-1.9 {Tcl_WriteChars: WriteChars} {
    # When closing a channel with an encoding that appends
    # escape bytes, check for the case where the escape
    # bytes overflow the current IO buffer. The bytes
................................................................................
    lappend sizes [file size $path(test2)]

    set sizes
} {19 19 19 19 19}

test io-2.1 {WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f  -encoding binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
................................................................................
    close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.

    set f [open $path(test1) w]
    fconfigure $f -encoding binary -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents $path(test1)]
    close $f
    set x
} "\r\n12"
................................................................................
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

test io-3.1 {WriteChars: compatibility with WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
    close $f
    contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
................................................................................
    close $f
    lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
    # Tcl "line" buffering has weird behavior: if current buffer contains
    # a \n, entire buffer gets flushed.  Logical behavior would be to flush
    # only up to the \n.

    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffering line -translation crlf
    puts -nonewline $f "\n12"
    set x [contents $path(test1)]
    close $f
    set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} {
    # stage buffer maps to more than can be queued at once.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 16
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} {
    # Bytes produced by UtfToExternal from end of last channel buffer
    # had to be moved to beginning of next channel buffer to preserve
    # requested buffersize.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
    # One incomplete UTF-8 character at end of staging buffer.  Backup
................................................................................
    # When translating UTF-8 to external, the produced bytes went past end
    # of the channel buffer.  This is done purpose -- we then truncate the
    # bytes at the end of the partial character to preserve the requested
    # blocksize on flush.  The truncated bytes are moved to the beginning
    # of the next channel buffer.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.8 {WriteChars: reset sawLF after each buffer} {
    set f [open $path(test1) w]
................................................................................
    puts -nonewline $f "12345678901\n456789012345678901234"
    close $f
    set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"

test io-5.1 {CheckFlush: not full} {
    set f [open $path(test1) w]
    fconfigure $f
    puts -nonewline $f "12345678901234567890"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
    set f [open $path(test1) w]
................................................................................
    close $f
    set x
} [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
    # if (dst >= dstEnd)

    set f [open $path(test1) w]
    puts $f $a
    puts $f hi
    close $f
    set f [open $path(test1)]
    set x [list [gets $f line] $line]
................................................................................
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
    # eol still equals dstEnd

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
    # not (*eol == '\n')

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\rabcd\r\nefg"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f]]
................................................................................

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
    # not (*eol == '\n')

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
................................................................................
    puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list "123456789012345" 15]
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
    # PeekAhead() did not get any, so (eol >= dstEnd)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto -buffersize 16
    set x [list [gets $f] [testchannel queuedcr $f]]
    close $f
    set x
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
    # if (*eol == '\n') {skip++}

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r\n78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
    # not (*eol == '\n')

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\r78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
    # else if (*eol == '\n') {goto gotoeol;}

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\n78901"
    close $f
    set f [open $path(test1)]
    set x [list [gets $f] [tell $f] [gets $f]]
    close $f
................................................................................
    fconfigure $f -encoding shiftjis -buffersize 16
    set x [gets $f]
    close $f
    set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
    # (bufPtr->nextAdded < bufPtr->bufLength)

    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line [eof $f]]
................................................................................

    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
    # is 30).  To check if "\n" follows, calls PeekAhead and determines
    # that cached data is available in buffer w/o having to call driver.

    set x [gets $f]
    close $f
    set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
    # (bufPtr->nextAdded < bufPtr->length)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary}
................................................................................
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary} -buffersize 16
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
................................................................................
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\rfgh"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r\ndef\nfgh"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
................................................................................
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [read $f]
    close $f
    set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
    # not (*src == '\r')

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\ndef"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
................................................................................
    encoding system ascii
    set f [open $path(test1) w]
    set x [fconfigure $f -encoding]
    close $f
    encoding system $old
	close $a
    set x
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
    set f [open $path(test1) w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
................................................................................
test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list [interpreter] << exit]"]
    expr [pid $f]
    close $f
} {}

# Test flushing. The functions tested here are FlushChannel.

test io-27.1 {FlushChannel, no output buffered} {
    file delete $path(test1)
    set f [open $path(test1) w]
    flush $f
................................................................................
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
................................................................................
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]
................................................................................
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -encoding {}
    puts -nonewline $f \xe7\x89\xa6
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x

Changes to tests/ioTrans.test.

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
    thread::send $tid [list testchannel splice $chan]

    # Run test script, also run local event loop!  The local event loop waits
    # for the result to come back.  It is also necessary for the execution of
    # forwarded channel operations.

    set ::tres ""
    thread::send -async $tid {	
	after 50
	catch {s} res;	# This runs the script, 's' was defined at (*)
	thread::send -async $mid [list set ::tres $res]
    }
    vwait ::tres
    # Remove test thread, and return the captured result.







|







1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
    thread::send $tid [list testchannel splice $chan]

    # Run test script, also run local event loop!  The local event loop waits
    # for the result to come back.  It is also necessary for the execution of
    # forwarded channel operations.

    set ::tres ""
    thread::send -async $tid {
	after 50
	catch {s} res;	# This runs the script, 's' was defined at (*)
	thread::send -async $mid [list set ::tres $res]
    }
    vwait ::tres
    # Remove test thread, and return the captured result.

Changes to tests/iogt.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# -*- tcl -*-
# Commands covered:  transform, and stacking in general
#
# This file contains a collection of tests for Giot
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.

if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
    return






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# -*- tcl -*-
# Commands covered:  transform, and stacking in general
#
# This file contains a collection of tests for Giot
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.

if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
    return

Changes to tests/lindex.test.

428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
    } result
    set result
} {}

test lindex-17.0 {Bug 1718580} {*}{
    -body {
        lindex {} end foo
    } 
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
}

test lindex-17.1 {Bug 1718580} {*}{
    -body {
        lindex a end foo
    } 
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
}

catch { unset minus }







|








|







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
    } result
    set result
} {}

test lindex-17.0 {Bug 1718580} {*}{
    -body {
        lindex {} end foo
    }
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
}

test lindex-17.1 {Bug 1718580} {*}{
    -body {
        lindex a end foo
    }
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
}

catch { unset minus }

Changes to tests/lmap.test.

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    apply {{} { lmap {{a}{b}} {1 2 3} {} }}
} -result {list element in braces followed by "{b}" instead of space}
test lmap-4.14 {lmap errors} -returnCodes error -body {
    apply {{} { lmap a {{1 2}3} {} }}
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
    apply {{} { 
	set a(0) 44
	list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo 
    }} 
} {1 {can't set "a": variable is array} {can't set "a": variable is array
    while executing
"lmap a {1 2 3} {}"}}
test lmap-4.16 {lmap errors} -returnCodes error -body {
    apply {{} {
	lmap {} {} {}
    }}






|

|
|







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    apply {{} { lmap {{a}{b}} {1 2 3} {} }}
} -result {list element in braces followed by "{b}" instead of space}
test lmap-4.14 {lmap errors} -returnCodes error -body {
    apply {{} { lmap a {{1 2}3} {} }}
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
    apply {{} {
	set a(0) 44
	list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
    }}
} {1 {can't set "a": variable is array} {can't set "a": variable is array
    while executing
"lmap a {1 2 3} {}"}}
test lmap-4.16 {lmap errors} -returnCodes error -body {
    apply {{} {
	lmap {} {} {}
    }}

Changes to tests/lrange.test.

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
    lrange "a b c d" end 2
} {}
test lrange-1.15 {range of list elements} {
    concat \"[lrange {a b \{\   	} 0 2]"
} {"a b \{\ "}
# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
    lrange {[append a .b]} 0 end    
} {{[append} a .b\]}

test lrange-2.1 {error conditions} {
    list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
    list [catch {lrange a b 6 7} msg] $msg






|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
    lrange "a b c d" end 2
} {}
test lrange-1.15 {range of list elements} {
    concat \"[lrange {a b \{\   	} 0 2]"
} {"a b \{\ "}
# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
    lrange {[append a .b]} 0 end
} {{[append} a .b\]}

test lrange-2.1 {error conditions} {
    list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
    list [catch {lrange a b 6 7} msg] $msg

Changes to tests/lrepeat.test.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
    -result {expected integer but got "a"}
}
test lrepeat-1.4 {error cases} {
    -body {
	lrepeat -3 1
    }
    -returnCodes 1
    -result {bad count "-3": must be integer >= 0} 
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0
    }
    -result {}
}
test lrepeat-1.6 {error cases} {
    -body {
	lrepeat 3.5 1
    }
    -returnCodes 1
    -result {expected integer but got "3.5"} 
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0 a b c
    }
    -result {}
}






|












|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
    -result {expected integer but got "a"}
}
test lrepeat-1.4 {error cases} {
    -body {
	lrepeat -3 1
    }
    -returnCodes 1
    -result {bad count "-3": must be integer >= 0}
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0
    }
    -result {}
}
test lrepeat-1.6 {error cases} {
    -body {
	lrepeat 3.5 1
    }
    -returnCodes 1
    -result {expected integer but got "3.5"}
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0 a b c
    }
    -result {}
}

Changes to tests/lreplace.test.

94
95
96
97
98
99
100
101






102
103
104
105
106
107
108
...
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
...
177
178
179
180
181
182
183











































184
185
186
187
188
189
190
191
192
test lreplace-1.26 {lreplace command} {
    catch {unset foo}
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}








test lreplace-2.1 {lreplace errors} {
    list [catch lreplace msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} {
    list [catch {lreplace a b} msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
................................................................................
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 1 1} msg] $msg
} {1 {list doesn't contain element 1}}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p
................................................................................
} {0 1 a b c 3 4}
test lreplace-4.11 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 1 a b c
} {0 1 a b c 2 3 4}
test lreplace-4.12 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 2 a b c
} {0 1 a b c 3 4}











































 
# cleanup
catch {unset foo}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:






<
>
>
>
>
>
>







 







|
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109
110
111
112
113
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
test lreplace-1.26 {lreplace command} {
    catch {unset foo}
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}

test lreplace-1.27 {lreplace command} {
    lreplace x 1 1
} x
test lreplace-1.28 {lreplace command} {
    lreplace x 1 1 y
} {x y}

test lreplace-2.1 {lreplace errors} {
    list [catch lreplace msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} {
    list [catch {lreplace a b} msg] $msg
} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
................................................................................
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 2 2} msg] $msg
} {1 {list doesn't contain element 2}}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p
................................................................................
} {0 1 a b c 3 4}
test lreplace-4.11 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 1 a b c
} {0 1 a b c 2 3 4}
test lreplace-4.12 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 2 a b c
} {0 1 a b c 3 4}
test lreplace-4.13 {lreplace empty list} {
    lreplace {} 1 1 1
} 1
test lreplace-4.14 {lreplace empty list} {
    lreplace {} 2 2 2
} 2

test lreplace-5.1 {compiled lreplace: Bug 47ac84309b} {
    apply {x {
	lreplace $x end 0
    }} {a b c}
} {a b c}
test lreplace-5.2 {compiled lreplace: Bug 47ac84309b} {
    apply {x {
	lreplace $x end 0 A
    }} {a b c}
} {a b A c}

# Testing for compiled behaviour. Far too many variations to check with
# spelt-out tests. Note that this *just* checks whether the compiled version
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set ins     {{} A {A B}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lreplace lreplace

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
		foreach i $ins {
		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
		    set tester [list lreplace $ls $a $b {*}$i]
		    set script [list catch $tester m]
		    set script "list \[$script\] \$m"
		    test lreplace-6.[incr n] {lreplace battery} \
			[list apply [list {} $script]] $expected
		}
	    }
	}
    }
}}
 
# cleanup
catch {unset foo}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lsearch.test.

400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
test lsearch-17.1 {lsearch -index option, basic functionality} {
    lsearch -index 1 {{a c} {a b} {a a}} a
} 2
test lsearch-17.2 {lsearch -index option, basic functionality} {
    lsearch -index 1 -exact {{a c} {a b} {a a}} a
} 2
test lsearch-17.3 {lsearch -index option, basic functionality} {
    lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* 
} 1
test lsearch-17.4 {lsearch -index option, basic functionality} {
    lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} 0 
test lsearch-17.5 {lsearch -index option, basic functionality} {
    lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
} {0 1}
test lsearch-17.6 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* 
} {1 2}
test lsearch-17.7 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}

test lsearch-18.1 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 1
test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
    lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 0
test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
} 0
test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} 0 
test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
    lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {0 1}

test lsearch-19.1 {lsearch -sunindices option} {
    lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {1 0 0}
test lsearch-19.2 {lsearch -sunindices option} {
    lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {0 2 0}
test lsearch-19.3 {lsearch -sunindices option} {
    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
} {0 1 1}
test lsearch-19.4 {lsearch -sunindices option} {
    lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {0 0 1} 
test lsearch-19.5 {lsearch -sunindices option} {
    lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}






|



|




|












|



|











|



|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
test lsearch-17.1 {lsearch -index option, basic functionality} {
    lsearch -index 1 {{a c} {a b} {a a}} a
} 2
test lsearch-17.2 {lsearch -index option, basic functionality} {
    lsearch -index 1 -exact {{a c} {a b} {a a}} a
} 2
test lsearch-17.3 {lsearch -index option, basic functionality} {
    lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b*
} 1
test lsearch-17.4 {lsearch -index option, basic functionality} {
    lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} 0
test lsearch-17.5 {lsearch -index option, basic functionality} {
    lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
} {0 1}
test lsearch-17.6 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
} {1 2}
test lsearch-17.7 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}

test lsearch-18.1 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 1
test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
    lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 0
test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} 0
test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} 0
test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
    lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {0 1}

test lsearch-19.1 {lsearch -sunindices option} {
    lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {1 0 0}
test lsearch-19.2 {lsearch -sunindices option} {
    lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {0 2 0}
test lsearch-19.3 {lsearch -sunindices option} {
    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} {0 1 1}
test lsearch-19.4 {lsearch -sunindices option} {
    lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {0 0 1}
test lsearch-19.5 {lsearch -sunindices option} {
    lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}

Changes to tests/lsetComp.test.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc 
    } result]
    rename testProc {}
    return [list $status $result]
}

# Tests for the bytecode compilation of the 'lset' command

................................................................................
	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.5 {lset, compiled, list of args, array on stack} {
................................................................................
	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.8 {lset, compiled, list of args, error } {
................................................................................
	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.5 {lset, compiled, flat args, array on stack} {
................................................................................
	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.8 {lset, compiled, flat args, error } {






|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc
    } result]
    rename testProc {}
    return [list $status $result]
}

# Tests for the bytecode compilation of the 'lset' command

................................................................................
	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.5 {lset, compiled, list of args, array on stack} {
................................................................................
	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.8 {lset, compiled, list of args, error } {
................................................................................
	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.5 {lset, compiled, flat args, array on stack} {
................................................................................
	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.8 {lset, compiled, flat args, error } {

Changes to tests/main.test.

715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-5.9 {
	Tcl_Main: interactive mode: delete interp 
		-> main loop & exit handlers, but no [exit]
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {






|







715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-5.9 {
	Tcl_Main: interactive mode: delete interp
		-> main loop & exit handlers, but no [exit]
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {

Changes to tests/misc.test.

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
	global a
    
	set tst $a([winfo name $zz])
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
................................................................................
    }
    set msg {}
    list [catch tstProc msg] $msg
} {1 {can't read "zz": no such variable}}
test misc-1.2 {error in variable ref. in command in array reference} {
    proc tstProc {} "
	global a
    
	set tst \$a(\[winfo name \$\{zz)
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment






|







 







|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
..
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
	global a

	set tst $a([winfo name $zz])
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
................................................................................
    }
    set msg {}
    list [catch tstProc msg] $msg
} {1 {can't read "zz": no such variable}}
test misc-1.2 {error in variable ref. in command in array reference} {
    proc tstProc {} "
	global a

	set tst \$a(\[winfo name \$\{zz)
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment

Changes to tests/msgcat.test.

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
...
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
...
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
...
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
...
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
    }

    variable envVars {LC_ALL LC_MESSAGES LANG}
    variable count 0
    variable body
    variable result
    variable setVars
    foreach setVars [PowerSet $envVars] { 
	set result [string tolower [lindex $setVars 0]]
	if {[string length $result] == 0} {
	    if {[info exists ::tcl::mac::locale]} {
		set result [string tolower \
			[msgcat::ConvertLocale $::tcl::mac::locale]]
	    } else {
		if {([info sharedlibextension] eq ".dll")
................................................................................
		unset -nocomplain ::env($var)
		catch {set ::env($var) [set [namespace current]::$var]}
	    }
	} -body {i eval msgcat::mclocale} -result $result
	incr count
    }
    unset -nocomplain result
    
    # Could add tests of initialization from Windows registry here.
    # Use a fake registry package.

    # Tests msgcat-1.*: [mclocale], [mcpreferences]

    test msgcat-1.3 {mclocale set, single element} -setup {
	variable locale [mclocale]
................................................................................
    #     ov1 should be resolved in foo
    #     ov1 should resolve to foo in foo_BAR, foo_BAR_baz
    #     ov4 should be resolved in none, and call mcunknown
    #
    variable count 2
    variable result
    array set result {
	foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo 
        foo,ov3 ov3_foo foo,ov4 ov4
	foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR 
        foo_BAR,ov3 ov3_foo_BAR	foo_BAR,ov4 ov4 
        foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo 
        foo_BAR_baz,ov2 ov2_foo_BAR
	foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4
    }
    variable loc
    variable string
    foreach loc {foo foo_BAR foo_BAR_baz} {
	foreach string {ov0 ov1 ov2 ov3 ov4} {
................................................................................
    }
    variable count 1
    foreach loc {foo foo_BAR foo_BAR_baz} {
	test msgcat-5.$count {mcload} -setup {
	    variable locale [mclocale]
	    ::msgcat::mclocale ""
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	    mclocale $loc
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result [expr { $count+1 }]
	incr count
    }

    # Even though foo_BAR_notexist does not exist,
................................................................................
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
................................................................................
	    variable locale [mclocale]
	    mclocale ""
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder 
	} -body {
	    mclocale foo
	    mcpackageconfig set mcfolder $msgdir
	} -result 2

    foreach loc $locales {
	if { $loc eq {} } {
................................................................................
	removeFile $msg.msg $msgdir
    }
    removeDirectory msgdir

    # Tests msgcat-6.*: [mcset], [mc] namespace inheritance
#
# Test mcset and mc, ensuring that resolution for messages
# proceeds from the current ns to its parent and so on to the 
# global ns.
#
# Do this for the 12 permutations of
#     locales: foo
#     namespaces: foo foo::bar foo::bar::baz
#     strings: {ov1 ov2 ov3 ov4}
#     namespace ::foo            defines ov1, ov2, ov3
................................................................................
		    namespace eval bar {
			::msgcat::mcset foo ov2 ov2_foo_bar
			::msgcat::mcset foo ov3 ov3_foo_bar
			namespace eval baz {
			    ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
			}
		    }
		    
		}
		variable locale [mclocale]
		mclocale foo
	    } -cleanup {
		mclocale $locale
		namespace delete foo
	    } -body {
................................................................................

    # Tests msgcat-9.*: [mcexists]

	test msgcat-9.1 {mcexists no parameter} -body {
	    mcexists
	} -returnCodes 1\
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}
    
	test msgcat-9.2 {mcexists unknown option} -body {
	    mcexists -unknown src 
	} -returnCodes 1\
	-result {unknown option "-unknown"}
    
	test msgcat-9.3 {mcexists} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
................................................................................
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists -exactlocale k1]
	} -result {1 0}
    
	test msgcat-9.5 {mcexists parent namespace} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    namespace eval ::msgcat::test::sub {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -exactnamespace k1]
	    }
	} -result {1 0}
    
    # Tests msgcat-10.*: [mcloadedlocales]

	test msgcat-10.1 {mcloadedlocales no arg} -body {
	    mcloadedlocales
	} -returnCodes 1\
	-result {wrong # args: should be "mcloadedlocales subcommand"}
    
	test msgcat-10.2 {mcloadedlocales wrong subcommand} -body {
	    mcloadedlocales junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, or loaded}
    
	test msgcat-10.3 {mcloadedlocales loaded} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo_bar
	    # The result is position independent so sort
	    set resultlist [lsort [mcloadedlocales loaded]]
	} -result {{} foo foo_bar}
    
	test msgcat-10.4 {mcloadedlocales clear} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
................................................................................
	    lappend res [mcpackageconfig set loadcmd ""]
	    lappend res [mcpackageconfig isset loadcmd]
	    mcpackageconfig unset loadcmd
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {0 0 1 0}

    # option mcfolder is already tested with 5.11
    
    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd
    
    # This routine is used as bgerror and by direct callback invocation
    proc callbackproc args {
	variable resultvariable
	set resultvariable $args
    }
    proc callbackfailproc args {
	return -code error fail
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]
    
	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {






|







 







|







 







|

|
|
|







 







|




|







 







|










|







 







|







 







|







 







|







 







|

|


|







 







|













|






|




|












|







 







|

|










|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
...
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
...
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
...
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
...
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
    }

    variable envVars {LC_ALL LC_MESSAGES LANG}
    variable count 0
    variable body
    variable result
    variable setVars
    foreach setVars [PowerSet $envVars] {
	set result [string tolower [lindex $setVars 0]]
	if {[string length $result] == 0} {
	    if {[info exists ::tcl::mac::locale]} {
		set result [string tolower \
			[msgcat::ConvertLocale $::tcl::mac::locale]]
	    } else {
		if {([info sharedlibextension] eq ".dll")
................................................................................
		unset -nocomplain ::env($var)
		catch {set ::env($var) [set [namespace current]::$var]}
	    }
	} -body {i eval msgcat::mclocale} -result $result
	incr count
    }
    unset -nocomplain result

    # Could add tests of initialization from Windows registry here.
    # Use a fake registry package.

    # Tests msgcat-1.*: [mclocale], [mcpreferences]

    test msgcat-1.3 {mclocale set, single element} -setup {
	variable locale [mclocale]
................................................................................
    #     ov1 should be resolved in foo
    #     ov1 should resolve to foo in foo_BAR, foo_BAR_baz
    #     ov4 should be resolved in none, and call mcunknown
    #
    variable count 2
    variable result
    array set result {
	foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo
        foo,ov3 ov3_foo foo,ov4 ov4
	foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR
        foo_BAR,ov3 ov3_foo_BAR	foo_BAR,ov4 ov4
        foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo
        foo_BAR_baz,ov2 ov2_foo_BAR
	foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4
    }
    variable loc
    variable string
    foreach loc {foo foo_BAR foo_BAR_baz} {
	foreach string {ov0 ov1 ov2 ov3 ov4} {
................................................................................
    }
    variable count 1
    foreach loc {foo foo_BAR foo_BAR_baz} {
	test msgcat-5.$count {mcload} -setup {
	    variable locale [mclocale]
	    ::msgcat::mclocale ""
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder
	    mclocale $loc
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result [expr { $count+1 }]
	incr count
    }

    # Even though foo_BAR_notexist does not exist,
................................................................................
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
................................................................................
	    variable locale [mclocale]
	    mclocale ""
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mclocale foo
	    mcpackageconfig set mcfolder $msgdir
	} -result 2

    foreach loc $locales {
	if { $loc eq {} } {
................................................................................
	removeFile $msg.msg $msgdir
    }
    removeDirectory msgdir

    # Tests msgcat-6.*: [mcset], [mc] namespace inheritance
#
# Test mcset and mc, ensuring that resolution for messages
# proceeds from the current ns to its parent and so on to the
# global ns.
#
# Do this for the 12 permutations of
#     locales: foo
#     namespaces: foo foo::bar foo::bar::baz
#     strings: {ov1 ov2 ov3 ov4}
#     namespace ::foo            defines ov1, ov2, ov3
................................................................................
		    namespace eval bar {
			::msgcat::mcset foo ov2 ov2_foo_bar
			::msgcat::mcset foo ov3 ov3_foo_bar
			namespace eval baz {
			    ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
			}
		    }

		}
		variable locale [mclocale]
		mclocale foo
	    } -cleanup {
		mclocale $locale
		namespace delete foo
	    } -body {
................................................................................

    # Tests msgcat-9.*: [mcexists]

	test msgcat-9.1 {mcexists no parameter} -body {
	    mcexists
	} -returnCodes 1\
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}

	test msgcat-9.2 {mcexists unknown option} -body {
	    mcexists -unknown src
	} -returnCodes 1\
	-result {unknown option "-unknown"}

	test msgcat-9.3 {mcexists} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
................................................................................
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists -exactlocale k1]
	} -result {1 0}

	test msgcat-9.5 {mcexists parent namespace} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    namespace eval ::msgcat::test::sub {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -exactnamespace k1]
	    }
	} -result {1 0}

    # Tests msgcat-10.*: [mcloadedlocales]

	test msgcat-10.1 {mcloadedlocales no arg} -body {
	    mcloadedlocales
	} -returnCodes 1\
	-result {wrong # args: should be "mcloadedlocales subcommand"}

	test msgcat-10.2 {mcloadedlocales wrong subcommand} -body {
	    mcloadedlocales junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, or loaded}

	test msgcat-10.3 {mcloadedlocales loaded} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo_bar
	    # The result is position independent so sort
	    set resultlist [lsort [mcloadedlocales loaded]]
	} -result {{} foo foo_bar}

	test msgcat-10.4 {mcloadedlocales clear} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
................................................................................
	    lappend res [mcpackageconfig set loadcmd ""]
	    lappend res [mcpackageconfig isset loadcmd]
	    mcpackageconfig unset loadcmd
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {0 0 1 0}

    # option mcfolder is already tested with 5.11

    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd

    # This routine is used as bgerror and by direct callback invocation
    proc callbackproc args {
	variable resultvariable
	set resultvariable $args
    }
    proc callbackfailproc args {
	return -code error fail
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]

	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {

Changes to tests/namespace.test.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
....
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
....
2949
2950
2951
2952
2953
2954
2955







































2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
        }
    }
    lappend l [namespace current]
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
    # namespace children uses Tcl_GetGlobalNamespace 
    namespace eval test_ns_1 {namespace children foo b*}
} {::test_ns_1::foo::bar}

test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
    namespace eval test_ns_1 {
        variable v 123
        proc p {} {
................................................................................
        [lsort [namespace children :: test_ns_*]]
} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
    list [namespace eval :::test_ns_1::::foo {namespace current}] \
         [namespace eval test_ns_2:::::foo {namespace current}]
} {::test_ns_1::foo ::test_ns_2::foo}
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1:: {
        namespace eval test_ns_2:: {}
        namespace eval test_ns_3:: {}
    }
................................................................................
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"slave eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
    interp create slave 
    slave eval {trace add variable errorCode write {namespace delete :: ;#}}
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"slave eval error foo bar baz"}
................................................................................
    namespace code unknown
} {::namespace inscope :: unknown}
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
        namespace code cmd
    }
} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 
    namespace eval test_ns_1 { 
	variable v 42 
    } 
    namespace eval test_ns_2 { 
	proc namespace args {} 
    } 
    namespace eval test_ns_2 [namespace eval test_ns_1 { 
	namespace code {set v} 
    }] 
} {42} 
test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
    namespace eval demo {
	proc namespace args {puts $args}
	::namespace code {namespace inscope foo}
    }
} [list ::namespace inscope [fq demo] {namespace inscope foo}]

................................................................................
test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
    rename unknown _unknown
} -body {
    proc unknown args {return global}
    namespace eval ns {proc unknown args {return local}}
    list [namespace eval ns aaa bbb] [namespace eval ns aaa]
} -cleanup {
    rename unknown {}   
    rename _unknown unknown
    namespace delete ns
} -result {global global}

test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {
	set res {}
	proc test {} {
	    set ::g 0
	}  
	lappend ::res [test]
	proc set {a b} {
	    ::set a [incr b]
	}
	lappend ::res [test]
    }
    namespace delete ns
................................................................................
    rename getbytes {}
    unset i ns start end
} -result 0

test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
    info class [format %s constructor] oo::object
} ""







































 
# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:






|







 







|







 







|







 







|
|
|
|
|
|
|
|
|
|
|







 







|










|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
....
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
....
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
        }
    }
    lappend l [namespace current]
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
    # namespace children uses Tcl_GetGlobalNamespace
    namespace eval test_ns_1 {namespace children foo b*}
} {::test_ns_1::foo::bar}

test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
    namespace eval test_ns_1 {
        variable v 123
        proc p {} {
................................................................................
        [lsort [namespace children :: test_ns_*]]
} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
    list [namespace eval :::test_ns_1::::foo {namespace current}] \
         [namespace eval test_ns_2:::::foo {namespace current}]
} {::test_ns_1::foo ::test_ns_2::foo}
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1:: {
        namespace eval test_ns_2:: {}
        namespace eval test_ns_3:: {}
    }
................................................................................
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"slave eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
    interp create slave
    slave eval {trace add variable errorCode write {namespace delete :: ;#}}
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"slave eval error foo bar baz"}
................................................................................
    namespace code unknown
} {::namespace inscope :: unknown}
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
        namespace code cmd
    }
} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
	variable v 42
    }
    namespace eval test_ns_2 {
	proc namespace args {}
    }
    namespace eval test_ns_2 [namespace eval test_ns_1 {
	namespace code {set v}
    }]
} {42}
test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
    namespace eval demo {
	proc namespace args {puts $args}
	::namespace code {namespace inscope foo}
    }
} [list ::namespace inscope [fq demo] {namespace inscope foo}]

................................................................................
test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
    rename unknown _unknown
} -body {
    proc unknown args {return global}
    namespace eval ns {proc unknown args {return local}}
    list [namespace eval ns aaa bbb] [namespace eval ns aaa]
} -cleanup {
    rename unknown {}
    rename _unknown unknown
    namespace delete ns
} -result {global global}

test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {
	set res {}
	proc test {} {
	    set ::g 0
	}
	lappend ::res [test]
	proc set {a b} {
	    ::set a [incr b]
	}
	lappend ::res [test]
    }
    namespace delete ns
................................................................................
    rename getbytes {}
    unset i ns start end
} -result 0

test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
    info class [format %s constructor] oo::object
} ""

test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	proc abc {} {}
	proc def {} {}
	trace add command abc delete "rename ::testing::def {}; #"
	trace add command def delete "rename ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	namespace eval abc {proc xyz {} {}}
	namespace eval def {proc xyz {} {}}
	trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
	trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	variable gone {}
	oo::class create CB {
	    variable cmd
	    constructor other {set cmd $other}
	    destructor {rename $cmd {}; lappend ::testing::gone $cmd}
	}
	namespace eval abc {
	    ::testing::CB create def ::testing::abc::ghi
	    ::testing::CB create ghi ::testing::abc::def
	}
	namespace delete abc
	try {
	    return [lsort $gone]
	} finally {
	    namespace delete ::testing
	}
    }
} {::testing::abc::def ::testing::abc::ghi}
 
# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/nre.test.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
...
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	namespace path ::tcl::mathop
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth 
	#
	variable last [testnrelevels] 
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
................................................................................
	list {*}$long
    }
    proc outer {} inner
    lrange [outer] 0 2
} -cleanup {
    rename inner {}
    rename outer {}
} -result {1 1 1} 
test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
    # force an expansion that grows the evaluation stack, check that nre
    # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
    # done properly.
    proc nop {} {}
    proc crash {} {
	foreach val [list {*}[lrepeat 100000 x]] {






|

|







 







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
...
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	namespace path ::tcl::mathop
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth
	#
	variable last [testnrelevels]
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
................................................................................
	list {*}$long
    }
    proc outer {} inner
    lrange [outer] 0 2
} -cleanup {
    rename inner {}
    rename outer {}
} -result {1 1 1}
test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
    # force an expansion that grows the evaluation stack, check that nre
    # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
    # done properly.
    proc nop {} {}
    proc crash {} {
	foreach val [list {*}[lrepeat 100000 x]] {

Changes to tests/obj.test.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	{array search} 
	bytearray
	bytecode
	cmdName
	dict
	end-offset
	regexp
	string
................................................................................
    lappend result $msg
} {12345 {} 1 {variable 1 is unset (NULL)}}

test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 47]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 47 47 47 2 3}
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}

# We assume that testobj is an indicator for test*obj as well







|







 







|








|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	{array search}
	bytearray
	bytecode
	cmdName
	dict
	end-offset
	regexp
	string
................................................................................
    lappend result $msg
} {12345 {} 1 {variable 1 is unset (NULL)}}

test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 47]
    lappend result [testobj duplicate 1 2]
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 47 47 47 2 3}
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj duplicate 1 2]
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}

# We assume that testobj is an indicator for test*obj as well

Changes to tests/oo.test.

276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
....
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
....
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
....
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
} -body {
    slave eval {
	oo::define [oo::class create foo] superclass oo::class
	oo::class destroy
    }
} -cleanup {
    interp delete slave
} 
test oo-1.19 {basic test of OO functionality: teardown order} -body {
    oo::object create o
    namespace delete [info object namespace o]
    o destroy
    # Crashes on error
} -returnCodes error -result {invalid command name "o"}
test oo-1.20 {basic test of OO functionality: my teardown post rename} -body {
................................................................................
} -result {wrong # args: should be "::bar <cloned> a b"}
test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
    oo::class create FooClass
    set result {}
} -body {
    set obj1 [FooClass new]
    oo::objdefine $obj1 {
	variable var 
	method m {} {
	    set var foo
	}
	method get {} {
	    return $var
	}
	export eval
................................................................................
    list [set [obj a]] [namespace tail [obj a]]
} -cleanup {
    obj destroy
} -result {::obj b}
test oo-20.11 {OO: variable mustn't crash when recursing} -body {
    oo::class create A {
	constructor {name} {
	    my variable np_name 
	    set np_name $name
	}
	method copy {nm} {
	    set cpy [[info object class [self]] new $nm]
	    foreach var [info object vars [self]] {
		my variable $var
		set val [set $var]
................................................................................
		if {[string match o_* $var]} {
		    set objs {}
		    foreach ref $val {
			# call to "copy" crashes
			lappend objs [$ref copy {}]
		    }
		    $cpy prop $var $objs
		} else { 
		    $cpy prop $var $val
		}
	    }
	    return $cpy
	}
	method prop {name val} {
	    my variable $name






|







 







|







 







|







 







|







276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
....
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
....
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
....
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
} -body {
    slave eval {
	oo::define [oo::class create foo] superclass oo::class
	oo::class destroy
    }
} -cleanup {
    interp delete slave
}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
    oo::object create o
    namespace delete [info object namespace o]
    o destroy
    # Crashes on error
} -returnCodes error -result {invalid command name "o"}
test oo-1.20 {basic test of OO functionality: my teardown post rename} -body {
................................................................................
} -result {wrong # args: should be "::bar <cloned> a b"}
test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
    oo::class create FooClass
    set result {}
} -body {
    set obj1 [FooClass new]
    oo::objdefine $obj1 {
	variable var
	method m {} {
	    set var foo
	}
	method get {} {
	    return $var
	}
	export eval
................................................................................
    list [set [obj a]] [namespace tail [obj a]]
} -cleanup {
    obj destroy
} -result {::obj b}
test oo-20.11 {OO: variable mustn't crash when recursing} -body {
    oo::class create A {
	constructor {name} {
	    my variable np_name
	    set np_name $name
	}
	method copy {nm} {
	    set cpy [[info object class [self]] new $nm]
	    foreach var [info object vars [self]] {
		my variable $var
		set val [set $var]
................................................................................
		if {[string match o_* $var]} {
		    set objs {}
		    foreach ref $val {
			# call to "copy" crashes
			lappend objs [$ref copy {}]
		    }
		    $cpy prop $var $objs
		} else {
		    $cpy prop $var $val
		}
	    }
	    return $cpy
	}
	method prop {name val} {
	    my variable $name

Changes to tests/package.test.

13
14
15
16
17
18
19





20
21
22
23
24
25
26
...
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
....
1229
1230
1231
1232
1233
1234
1235
1236


1237
1238

1239
1240
1241
1242
1243
1244
1245
....
1246
1247
1248
1249
1250
1251
1252
1253


1254


1255


1256


1257
1258
1259


1260
1261
1262
1263
1264
1265
1266
1267
1268
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.3.3
    namespace import -force ::tcltest::*
}






# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
................................................................................
test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {

    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
................................................................................
	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} {


    prefer
} stable

test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

................................................................................
test package-14.0 {wrong\#args} -returnCodes error -body {
    package prefer foo bar
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} {package prefer stable} stable


test package-15.1 {set stable, keep} {prefer stable} {stable stable}


test package-15.2 {set latest, change} {prefer latest} {stable latest}


test package-15.3 {set latest, keep} {


    prefer latest latest
} {stable latest latest}
test package-15.4 {set stable, rejected} {


    prefer latest stable
} {stable latest latest}

rename prefer {}
 
set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests






>
>
>
>
>







 







|
>







 







|
>
>

<
>







 







|
>
>
|
>
>
|
>
>
|
>
>

|
|
>
>

|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
....
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253
....
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.3.3
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpreferstable [llength [info commands testpreferstable]]

# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
................................................................................
test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    testpreferstable
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
................................................................................
	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer

} -result stable
test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

................................................................................
test package-14.0 {wrong\#args} -returnCodes error -body {
    package prefer foo bar
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer stable} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer stable} -result {stable stable}
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer latest} -result {stable latest}
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest latest
} -result {stable latest latest}
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest stable
} -result {stable latest latest}

rename prefer {}
 
set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests

Changes to tests/parse.test.

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
} -result {16 23}
test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
    testevalobjv testasync
} -setup {
    variable ::aresult
    variable ::acode
    proc async1 {result code} {
	variable ::aresult 
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set aresult xxx






|







365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
} -result {16 23}
test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
    testevalobjv testasync
} -setup {
    variable ::aresult
    variable ::acode
    proc async1 {result code} {
	variable ::aresult
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set aresult xxx

Changes to tests/parseExpr.test.

764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
test parseExpr-21.7 {error messages} -body {
    expr {0o8}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.8 {error messages} -body {
    expr {0o8x}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
    expr {"} 
} -returnCodes error -result {missing "
in expression """}
test parseExpr-21.10 {error messages} -body {
    expr \{ 
} -returnCodes error -result "missing close-brace
in expression \"\{\""
test parseExpr-21.11 {error messages} -body {
    expr $
} -returnCodes error -result {invalid character "$"
in expression "$"}
test parseExpr-21.12 {error messages} -body {






|



|







764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
test parseExpr-21.7 {error messages} -body {
    expr {0o8}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.8 {error messages} -body {
    expr {0o8x}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
    expr {"}
} -returnCodes error -result {missing "
in expression """}
test parseExpr-21.10 {error messages} -body {
    expr \{
} -returnCodes error -result "missing close-brace
in expression \"\{\""
test parseExpr-21.11 {error messages} -body {
    expr $
} -returnCodes error -result {invalid character "$"
in expression "$"}
test parseExpr-21.12 {error messages} -body {

Changes to tests/pkgMkIndex.test.

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
	set dirPath [lindex $parsed 1]
	set idxFile [file join $dirPath pkgIndex.tcl]

	if {[catch {
	    set result [list 0 [makePkgList [parseIndex $idxFile]]]
	} err]} {
	    set result [list 1 $err]
	} 
	file delete $idxFile
    } else {
	set result $rv
    }

    return $result
}






|







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
	set dirPath [lindex $parsed 1]
	set idxFile [file join $dirPath pkgIndex.tcl]

	if {[catch {
	    set result [list 0 [makePkgList [parseIndex $idxFile]]]
	} err]} {
	    set result [list 1 $err]
	}
	file delete $idxFile
    } else {
	set result $rv
    }

    return $result
}

Changes to tests/platform.test.

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {		
	set cpudata [testcpuid 0]
	binary format iii \
	    [lindex $cpudata 1] \
	    [lindex $cpudata 3] \
	    [lindex $cpudata 2] 
    } \
    -match regexp \
    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}

# The platform package makes very few promises, but does promise that the
# format of string it produces consists of two non-empty words separated by a
# hyphen.






|




|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {
	set cpudata [testcpuid 0]
	binary format iii \
	    [lindex $cpudata 1] \
	    [lindex $cpudata 3] \
	    [lindex $cpudata 2]
    } \
    -match regexp \
    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}

# The platform package makes very few promises, but does promise that the
# format of string it produces consists of two non-empty words separated by a
# hyphen.

Changes to tests/proc.test.

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
         [lsort [info commands test_ns_1::*]] \
         [namespace eval test_ns_1 {namespace which q:}] \
         [namespace eval test_ns_1 {namespace which value:at:}]
} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    proc p {a(1) a(2)} { 
	set z [expr $a(1)+$a(2)]
	puts "$z=z, $a(1)=$a(1)"
    }
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} { 
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}

test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
................................................................................
	p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
	set res
    }
    t
} -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {aba}    

test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
    proc a {} {return -code -5}
    proc b {} a
    catch b
} -cleanup {
    rename a {}






|







|







 







|







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
         [lsort [info commands test_ns_1::*]] \
         [namespace eval test_ns_1 {namespace which q:}] \
         [namespace eval test_ns_1 {namespace which value:at:}]
} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    proc p {a(1) a(2)} {
	set z [expr $a(1)+$a(2)]
	puts "$z=z, $a(1)=$a(1)"
    }
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}

test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
................................................................................
	p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
	set res
    }
    t
} -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {aba}

test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
    proc a {} {return -code -5}
    proc b {} a
    catch b
} -cleanup {
    rename a {}

Changes to tests/reg.test.

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
# expectNomatch, these arguments are optional, and if present are
# ignored except that they indicate how many subexpressions should be
# present in the RE.)  It is an error for the number of subexpression
# arguments to be wrong.  Cases involving nonparticipating
# subexpressions, checking where empty substrings are located,
# etc. should be done using expectIndices and expectPartial.

# The flag characters are complex and a bit eclectic.  Generally speaking, 
# lowercase letters are compile options, uppercase are expected re_info
# bits, and nonalphabetics are match options, controls for how the test is 
# run, or testing options.  The one small surprise is that AREs are the
# default, and you must explicitly request lesser flavors of RE.  The flags
# are as follows.  It is admitted that some are not very mnemonic.
# There are some others which are purely debugging tools and are not
# useful in this file.
#
#	-	no-op (placeholder)
................................................................................
    proc expectMatch {args} {
	MatchExpected {} {*}$args
    }

    # match expected (full fanciness)
    # expectIndices testno flags re target mat submat ...
    proc expectIndices {args} {
	MatchExpected -indices {*}$args 
    }

    # partial match expected
    # expectPartial testno flags re target mat "" ...
    # Quirk:  number of ""s must be one more than number of subREs.
    proc expectPartial {args} {
	lset args 1 ![lindex $args 1]	;# add ! flag






|

|







 







|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
# expectNomatch, these arguments are optional, and if present are
# ignored except that they indicate how many subexpressions should be
# present in the RE.)  It is an error for the number of subexpression
# arguments to be wrong.  Cases involving nonparticipating
# subexpressions, checking where empty substrings are located,
# etc. should be done using expectIndices and expectPartial.

# The flag characters are complex and a bit eclectic.  Generally speaking,
# lowercase letters are compile options, uppercase are expected re_info
# bits, and nonalphabetics are match options, controls for how the test is
# run, or testing options.  The one small surprise is that AREs are the
# default, and you must explicitly request lesser flavors of RE.  The flags
# are as follows.  It is admitted that some are not very mnemonic.
# There are some others which are purely debugging tools and are not
# useful in this file.
#
#	-	no-op (placeholder)
................................................................................
    proc expectMatch {args} {
	MatchExpected {} {*}$args
    }

    # match expected (full fanciness)
    # expectIndices testno flags re target mat submat ...
    proc expectIndices {args} {
	MatchExpected -indices {*}$args
    }

    # partial match expected
    # expectPartial testno flags re target mat "" ...
    # Quirk:  number of ""s must be one more than number of subREs.
    proc expectPartial {args} {
	lset args 1 ![lindex $args 1]	;# add ! flag

Changes to tests/regexp.test.

476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
    regsub b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,eabcfde}
test regexp-11.12 {regsub without final variable name returns value} {
    regsub -all b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,ea,bcfd,cf,e}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want... 
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}

test regexp-13.1 {regsub of a very large string} {
................................................................................
    regsub -all {@} {@[email protected]@} "\0a\0" result
    set expected "\0a\0hel\0a\0lo\0a\0"
    string equal $result $expected
} 1

test regexp-20.1 {regsub shared object shimmering} {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz 
    set b $a 
    set c abcdefghijklmnopqurstuvwxyz0123456789 
    regsub $a $c $b d 
    list $d [string length $d] [string bytelength $d]
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} {
    eval regexp -about abc
} {0 {}}

test regexp-21.1 {regsub works with empty string} {






|







 







|
|
|
|







476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
    regsub b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,eabcfde}
test regexp-11.12 {regsub without final variable name returns value} {
    regsub -all b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,ea,bcfd,cf,e}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}

test regexp-13.1 {regsub of a very large string} {
................................................................................
    regsub -all {@} {@[email protected]@} "\0a\0" result
    set expected "\0a\0hel\0a\0lo\0a\0"
    string equal $result $expected
} 1

test regexp-20.1 {regsub shared object shimmering} {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz
    set b $a
    set c abcdefghijklmnopqurstuvwxyz0123456789
    regsub $a $c $b d
    list $d [string length $d] [string bytelength $d]
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} {
    eval regexp -about abc
} {0 {}}

test regexp-21.1 {regsub works with empty string} {

Changes to tests/regexpComp.test.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc 
    } result]
    rename testProc {}
    return $result
    #return [list $status $result]
}

unset -nocomplain foo
................................................................................
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want... 
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    evalInProc {
	list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
    }
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
................................................................................
	list $result [string length $result]
    }
} "\0a\0hel\0a\0lo\0a\0 14"

test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz 
	set b $a 
	set c abcdefghijklmnopqurstuvwxyz0123456789 
	regsub $a $c $b d 
	list $d [string length $d] [string bytelength $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }






|







 







|







 







|
|
|
|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc
    } result]
    rename testProc {}
    return $result
    #return [list $status $result]
}

unset -nocomplain foo
................................................................................
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    evalInProc {
	list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
    }
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
................................................................................
	list $result [string length $result]
    }
} "\0a\0hel\0a\0lo\0a\0 14"

test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz
	set b $a
	set c abcdefghijklmnopqurstuvwxyz0123456789
	regsub $a $c $b d
	list $d [string length $d] [string bytelength $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }

Changes to tests/registry.test.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.1]
	}]} {
	testConstraint reg 1
    }
}

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]
 
test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.1}
test registry-1.1 {argument parsing for registry command} {win reg} {
    list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1a {argument parsing for registry command} {win reg} {
    list [catch {registry -32bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1b {argument parsing for registry command} {win reg} {






|













|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.2]
	}]} {
	testConstraint reg 1
    }
}

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]
 
test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.2}
test registry-1.1 {argument parsing for registry command} {win reg} {
    list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1a {argument parsing for registry command} {win reg} {
    list [catch {registry -32bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1b {argument parsing for registry command} {win reg} {

Changes to tests/set-old.test.

927
928
929
930
931
932
933
934
935
936
937
938
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}
catch {rename foo {}}

# cleanup
::tcltest::cleanupTests
return 

# Local Variables:
# mode: tcl
# End:






|




927
928
929
930
931
932
933
934
935
936
937
938
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}
catch {rename foo {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/set.test.

532
533
534
535
536
537
538
539
# cleanup
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return 






|
532
533
534
535
536
537
538
539
# cleanup
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return

Changes to tests/split.test.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
} {{} {} {} {}}
test split-1.8 {basic split commands} {
    proc foo {} {
        set x {}
        foreach f [split {]\n} {}] {
            append x $f
        }
        return $x	
    }
    foo
} {]\n}
test split-1.9 {basic split commands} {
    proc foo {} {
        set x ab\000c
        set y [split $x {}]






|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
} {{} {} {} {}}
test split-1.8 {basic split commands} {
    proc foo {} {
        set x {}
        foreach f [split {]\n} {}] {
            append x $f
        }
        return $x
    }
    foo
} {]\n}
test split-1.9 {basic split commands} {
    proc foo {} {
        set x ab\000c
        set y [split $x {}]

Changes to tests/stack.test.

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp alias {} unknown {} notaknownproc
	catch { unknown } msg
	puts $msg
    }
} -result {too many nested evaluations (infinite loop?)}
    
# Make sure that there is enough stack to run regexp even if we're
# close to the recursion limit. [Bug 947070] [Patch 746378]
test stack-3.1 {enough room for regexp near recursion limit} -body {
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp recursionlimit {} 10000
	set depth 0






|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp alias {} unknown {} notaknownproc
	catch { unknown } msg
	puts $msg
    }
} -result {too many nested evaluations (infinite loop?)}

# Make sure that there is enough stack to run regexp even if we're
# close to the recursion limit. [Bug 947070] [Patch 746378]
test stack-3.1 {enough room for regexp near recursion limit} -body {
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp recursionlimit {} 10000
	set depth 0

Changes to tests/string.test.

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
....
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
    string first \u7266 abc\u7266x end-2
} 3
test string-4.14 {string first, negative start index} {
    string first b abc -1
} 1
test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first] 
    # which pointed past the end of the string.
    set uchar \u057e    ;# character with two-byte encoding in utf-8
    string first % %#$uchar$uchar#$uchar$uchar#% 3
} 8

test string-5.1 {string index} {
    list [catch {string index} msg] $msg
................................................................................
    # Since bignums arrived in Tcl 8.5, the sense of this test changed.
    # Now integer values that exceed native limits become bignums, and
    # bignums can convert to doubles without error.
    list [string is double -fail var [largest_int]0] $var
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
test string-6.39 {string is double, false} {
    # This test is non-portable because IRIX thinks 
    # that .e1 is a valid double - this is really a bug
    # on IRIX as .e1 should NOT be a valid double
    #
    # Portable now. Tcl 8.5 does its own double parsing.

    list [string is double -fail var .e1] $var
} {0 0}
................................................................................

# Helper for memory stress tests
# Repeat each body in a local space checking that memory does not increase
proc MemStress {args} {
    set res {}
    foreach body $args {
        set end 0
        for {set i 0} {$i < 5} {incr i} { 
            proc MemStress_Body {} $body
            uplevel 1 MemStress_Body
            rename MemStress_Body {}
            set tmp $end
            set end [lindex [lindex [split [memory info] "\n"] 3] 3]
        }
        lappend res [expr {$end - $tmp}]






|







 







|







 







|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
....
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
    string first \u7266 abc\u7266x end-2
} 3
test string-4.14 {string first, negative start index} {
    string first b abc -1
} 1
test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first]
    # which pointed past the end of the string.
    set uchar \u057e    ;# character with two-byte encoding in utf-8
    string first % %#$uchar$uchar#$uchar$uchar#% 3
} 8

test string-5.1 {string index} {
    list [catch {string index} msg] $msg
................................................................................
    # Since bignums arrived in Tcl 8.5, the sense of this test changed.
    # Now integer values that exceed native limits become bignums, and
    # bignums can convert to doubles without error.
    list [string is double -fail var [largest_int]0] $var
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
test string-6.39 {string is double, false} {
    # This test is non-portable because IRIX thinks
    # that .e1 is a valid double - this is really a bug
    # on IRIX as .e1 should NOT be a valid double
    #
    # Portable now. Tcl 8.5 does its own double parsing.

    list [string is double -fail var .e1] $var
} {0 0}
................................................................................

# Helper for memory stress tests
# Repeat each body in a local space checking that memory does not increase
proc MemStress {args} {
    set res {}
    foreach body $args {
        set end 0
        for {set i 0} {$i < 5} {incr i} {
            proc MemStress_Body {} $body
            uplevel 1 MemStress_Body
            rename MemStress_Body {}
            set tmp $end
            set end [lindex [lindex [split [memory info] "\n"] 3] 3]
        }
        lappend res [expr {$end - $tmp}]

Changes to tests/stringComp.test.

724
725
726
727
728
729
730










731
732
733
734
735
736
737
    apply {arg {
	set argCopy $arg
	set arg [string replace $arg 1 2 aa]
	# Crashes in comparison before fix
	expr {$arg ne $argCopy}
    }} abcde
} 1











## string tolower
## not yet bc

## string toupper
## not yet bc







>
>
>
>
>
>
>
>
>
>







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
    apply {arg {
	set argCopy $arg
	set arg [string replace $arg 1 2 aa]
	# Crashes in comparison before fix
	expr {$arg ne $argCopy}
    }} abcde
} 1
test stringComp-14.4 {Bug 1af8de570511} {
    apply {{x y} {
	# Generate an unshared string value
	set val ""
	for { set i 0 } { $i < $x } { incr i } {
	    set val [format "0%s" $val]
	}
	string replace $val[unset val] 1 1 $y
    }} 4 x
} 0x00

## string tolower
## not yet bc

## string toupper
## not yet bc

Changes to tests/stringObj.test.

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    string length "a"
} 1
test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
    set a "abcdef"
    list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
    string length "\u00ae" 
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
    # string length "○○" 
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
} 6
test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
    # set a "ïa¿b®cï¿d®"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise






|


|







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    string length "a"
} 1
test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
    set a "abcdef"
    list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
    string length "\u00ae"
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
    # string length "○○"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
} 6
test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
    # set a "ïa¿b®cï¿d®"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise

Changes to tests/subst.test.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    subst {x.[concat foo].y.[concat bar].z}
} {x.foo.y.bar.z}
test subst-5.4 {command substitutions} {
    list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
} {1 {invalid command name "bogus_command"}}
test subst-5.5 {command substitutions} {
    set a 0
    list [catch {subst {[set a 1}} msg] $a $msg 
} {1 0 {missing close-bracket}}
test subst-5.6 {command substitutions} {
    set a 0
    list [catch {subst {0[set a 1}} msg] $a $msg 
} {1 0 {missing close-bracket}}
test subst-5.7 {command substitutions} {
    set a 0
    list [catch {subst {0[set a 1; set a 2}} msg] $a $msg 
} {1 1 {missing close-bracket}}

# repeat the tests above simulating cmd line input
test subst-5.8 {command substitutions} {
    set script {[subst {[set a 1}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg 
} {1 {missing close-bracket}}
test subst-5.9 {command substitutions} {
    set script {[subst {0[set a 1}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg 
} {1 {missing close-bracket}}
test subst-5.10 {command substitutions} {
    set script {[subst {0[set a 1; set a 2}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg 
} {1 {missing close-bracket}}

test subst-6.1 {clear the result after command substitution} -body {
    catch {unset a}
    subst {[concat foo] $a}
} -returnCodes error -result {can't read "a": no such variable}

................................................................................
test subst-8.5 {return in a subst} {
    subst {foo [return {]}; bogus code] bar}
} {foo ] bar}
test subst-8.6 {return in a subst} -returnCodes error -body {
    subst "foo \[return {x}; bogus code bar"
} -result {missing close-bracket}
test subst-8.7 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set a {}"" ; stuff] bar} 
} -returnCodes error -result {extra characters after close-brace}
test subst-8.8 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.9 {return in a variable subst} {
    subst {foo $var([return {x}]) bar}
} {foo x bar}






|



|



|





|



|



|







 







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    subst {x.[concat foo].y.[concat bar].z}
} {x.foo.y.bar.z}
test subst-5.4 {command substitutions} {
    list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
} {1 {invalid command name "bogus_command"}}
test subst-5.5 {command substitutions} {
    set a 0
    list [catch {subst {[set a 1}} msg] $a $msg
} {1 0 {missing close-bracket}}
test subst-5.6 {command substitutions} {
    set a 0
    list [catch {subst {0[set a 1}} msg] $a $msg
} {1 0 {missing close-bracket}}
test subst-5.7 {command substitutions} {
    set a 0
    list [catch {subst {0[set a 1; set a 2}} msg] $a $msg
} {1 1 {missing close-bracket}}

# repeat the tests above simulating cmd line input
test subst-5.8 {command substitutions} {
    set script {[subst {[set a 1}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}
test subst-5.9 {command substitutions} {
    set script {[subst {0[set a 1}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}
test subst-5.10 {command substitutions} {
    set script {[subst {0[set a 1; set a 2}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}

test subst-6.1 {clear the result after command substitution} -body {
    catch {unset a}
    subst {[concat foo] $a}
} -returnCodes error -result {can't read "a": no such variable}

................................................................................
test subst-8.5 {return in a subst} {
    subst {foo [return {]}; bogus code] bar}
} {foo ] bar}
test subst-8.6 {return in a subst} -returnCodes error -body {
    subst "foo \[return {x}; bogus code bar"
} -result {missing close-bracket}
test subst-8.7 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.8 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.9 {return in a variable subst} {
    subst {foo $var([return {x}]) bar}
} {foo x bar}

Changes to tests/tailcall.test.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
# can now actually measure using testnrelevels.
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth 
	#
	variable last [testnrelevels] 
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
................................................................................
    a b 0
} -cleanup {
    rename a {}
    rename b {}
} -result {0 0 0 0 0 0}

test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
    # 
    # This test is related to [bug d87cb182053fd79b3]: the fix to that bug was
    # to remove a call to TclSkipTailcall, which caused a violation of the
    # constant-space property of tailcall in that particular
    # configuration. This test was added to detect that, and insure that the
    # problem is fixed.
    #

................................................................................
    namespace eval b {
	variable x *::b
	proc xset args {error b::xset}
	proc moo {} {set x 0; variable y [::a::foo]; set x}
    }
    variable x *::
    proc xset args {error ::xset}
    list [::b::moo] | $x $a::x $b::x | $::b::y 
} -cleanup {
    unset x
    rename xset {}
    namespace delete a b
} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}


................................................................................
    apply {{} {
	catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1} 

test tailcall-12.3b0 {[Bug 2695587]} -body {
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
    }}
} -returnCodes 1 -result {invalid command name "foo"}
................................................................................
	set catch catch
	$catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1} 

# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
# standard catch behaviour is required.

test tailcall-13.1 {directly tailcalling the tailcall command is ok} {
    list [catch {






|

|







 







|







 







|







 







|







 







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
# can now actually measure using testnrelevels.
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth
	#
	variable last [testnrelevels]
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
................................................................................
    a b 0
} -cleanup {
    rename a {}
    rename b {}
} -result {0 0 0 0 0 0}

test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
    #
    # This test is related to [bug d87cb182053fd79b3]: the fix to that bug was
    # to remove a call to TclSkipTailcall, which caused a violation of the
    # constant-space property of tailcall in that particular
    # configuration. This test was added to detect that, and insure that the
    # problem is fixed.
    #

................................................................................
    namespace eval b {
	variable x *::b
	proc xset args {error b::xset}
	proc moo {} {set x 0; variable y [::a::foo]; set x}
    }
    variable x *::
    proc xset args {error ::xset}
    list [::b::moo] | $x $a::x $b::x | $::b::y
} -cleanup {
    unset x
    rename xset {}
    namespace delete a b
} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}


................................................................................
    apply {{} {
	catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1}

test tailcall-12.3b0 {[Bug 2695587]} -body {
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
    }}
} -returnCodes 1 -result {invalid command name "foo"}
................................................................................
	set catch catch
	$catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1}

# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
# standard catch behaviour is required.

test tailcall-13.1 {directly tailcalling the tailcall command is ok} {
    list [catch {

Changes to tests/tm.test.

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    ::tcl::tm::path list
} -result {geode snarf foo}


proc genpaths {base} {
    # Normalizing picks up drive letters on windows [Bug 1053568]
    set base [file normalize $base]
    lassign [split [package present Tcl] .] major minor 
    set results {}
    set base [file join $base tcl$major]
    lappend results [file join $base site-tcl]
    for {set i 0} {$i <= $minor} {incr i} {
	lappend results [file join $base ${major}.$i]
    }
    return $results






|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    ::tcl::tm::path list
} -result {geode snarf foo}


proc genpaths {base} {
    # Normalizing picks up drive letters on windows [Bug 1053568]
    set base [file normalize $base]
    lassign [split [package present Tcl] .] major minor
    set results {}
    set base [file join $base tcl$major]
    lappend results [file join $base site-tcl]
    for {set i 0} {$i <= $minor} {incr i} {
	lappend results [file join $base ${major}.$i]
    }
    return $results

Changes to tests/trace.test.

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
....
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
....
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
....
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
....
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
....
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
....
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
....
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
....
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0 
    trace variable x r {set x(foo) 1 ;#} 
    trace variable x r {unset -nocomplain x(bar) ;#} 
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0 
    trace variable x r {unset -nocomplain x(bar) ;#} 
    trace variable x r {set x(foo) 1 ;#} 
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0 
    trace variable x r {set x(foo) 1 ;#} 
    trace variable x r {unset -nocomplain x;#} 
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0 
    trace variable x r {unset -nocomplain x;#} 
    trace variable x r {set x(foo) 1 ;#} 
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace variable writes} {
    unset -nocomplain x
................................................................................
    set ::info
} {x {} array}
test trace-5.8 {array traces fire for undefined variables} {
    unset -nocomplain x
    trace add variable x array {set x(foo) 1 ;#}
    set res "names: [array names x]"
} {names: foo}
    
# Trace multiple trace types at once.

test trace-6.1 {multiple ops traced at once} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write unset} traceProc
    catch {set x}
................................................................................
    unset -nocomplain x
    set x 44
    set info {}
    trace add variable x read {traceTag 1}
    trace add variable x read {traceTag 2}
    trace add variable x read {traceTag 3}
    trace add variable x read {traceTag 4}
    trace add variable x read delTraces 
    trace add variable x read {traceTag 5}
    set x
    set info
} {5 1}

test trace-13.2 {leak when unsetting traced variable} \
    -constraints memory -body {
................................................................................
} [list 1 "wrong # args: should be \"trace info type name\""]

test trace-14.5 {trace command, invalid option} {
    list [catch {trace gorp} msg] $msg
} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]

# Again, [trace ... command] and [trace ... variable] share syntax and
# error message styles for their opList options; these loops test those 
# error messages.

set i 0
set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
set abbvs [list {a r u w} {d r} {}]
proc x {} {}
foreach type {variable command execution} err $errs abbvlist $abbvs {
................................................................................
foo {set b 1} enterstep
foo {set b 1} 0 1 leavestep
foo foo 0 1 leave}

test trace-28.2 {exec traces with 'error'} {
    set info {}
    set res {}
    
    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
................................................................................

    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]
    
    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
................................................................................
	    return "ok"
	}} 2 error leavestep
foo foo 0 error leave}}

test trace-28.3 {exec traces with 'return -code error'} {
    set info {}
    set res {}
    
    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
................................................................................

    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]
    
    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
................................................................................
test trace-28.4 {exec traces in slave with 'return -code error'} {
    interp create slave
    interp alias slave traceExecute {} traceExecute
    set info {}
    set res [interp eval slave {
	set info {}
	set res {}
	
	proc foo {} {
	    if {[catch {bar}]} {
		return "error"
	    } else {
		return "ok"
	    }
	}
	
	proc bar {} { return -code error "msg" }
	
	lappend res [foo]
	
	trace add execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]
	
	# With the trace active
	
	lappend res [foo]
	
	trace remove execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]
	
	list $res
    }]
    interp delete slave
    lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
		return "error"
................................................................................
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
	# internals 
	lset ::bar 1 2
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution lset enter dotrace
................................................................................

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls ::bar res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}
    
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
................................................................................

test trace-40.1 {execution trace errors become command errors} {
    proc foo args {}
    trace add execution foo enter {rename foo {}; error bar;#}
    catch foo m
    return -level 0 $m[unset m]
} bar
    
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
catch {rename untraced {}}
catch {rename traceproc {}}






|
|
|




|
|
|




|
|
|




|
|
|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







|

|

|


|

|

|


|







 







|







 







|







 







|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
....
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
....
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
....
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
....
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
....
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
....
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
....
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
....
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x(bar) ;#}
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x(bar) ;#}
    trace variable x r {set x(foo) 1 ;#}
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x;#}
    trace variable x r {set x(foo) 1 ;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace variable writes} {
    unset -nocomplain x
................................................................................
    set ::info
} {x {} array}
test trace-5.8 {array traces fire for undefined variables} {
    unset -nocomplain x
    trace add variable x array {set x(foo) 1 ;#}
    set res "names: [array names x]"
} {names: foo}

# Trace multiple trace types at once.

test trace-6.1 {multiple ops traced at once} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write unset} traceProc
    catch {set x}
................................................................................
    unset -nocomplain x
    set x 44
    set info {}
    trace add variable x read {traceTag 1}
    trace add variable x read {traceTag 2}
    trace add variable x read {traceTag 3}
    trace add variable x read {traceTag 4}
    trace add variable x read delTraces
    trace add variable x read {traceTag 5}
    set x
    set info
} {5 1}

test trace-13.2 {leak when unsetting traced variable} \
    -constraints memory -body {
................................................................................
} [list 1 "wrong # args: should be \"trace info type name\""]

test trace-14.5 {trace command, invalid option} {
    list [catch {trace gorp} msg] $msg
} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]

# Again, [trace ... command] and [trace ... variable] share syntax and
# error message styles for their opList options; these loops test those
# error messages.

set i 0
set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
set abbvs [list {a r u w} {d r} {}]
proc x {} {}
foreach type {variable command execution} err $errs abbvlist $abbvs {
................................................................................
foo {set b 1} enterstep
foo {set b 1} 0 1 leavestep
foo foo 0 1 leave}

test trace-28.2 {exec traces with 'error'} {
    set info {}
    set res {}

    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
................................................................................

    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]

    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
................................................................................
	    return "ok"
	}} 2 error leavestep
foo foo 0 error leave}}

test trace-28.3 {exec traces with 'return -code error'} {
    set info {}
    set res {}

    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
................................................................................

    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]

    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
................................................................................
test trace-28.4 {exec traces in slave with 'return -code error'} {
    interp create slave
    interp alias slave traceExecute {} traceExecute
    set info {}
    set res [interp eval slave {
	set info {}
	set res {}

	proc foo {} {
	    if {[catch {bar}]} {
		return "error"
	    } else {
		return "ok"
	    }
	}

	proc bar {} { return -code error "msg" }

	lappend res [foo]

	trace add execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]

	# With the trace active

	lappend res [foo]

	trace remove execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]

	list $res
    }]
    interp delete slave
    lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
		return "error"
................................................................................
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
	# internals
	lset ::bar 1 2
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution lset enter dotrace
................................................................................

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls ::bar res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}

test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
................................................................................

test trace-40.1 {execution trace errors become command errors} {
    proc foo args {}
    trace add execution foo enter {rename foo {}; error bar;#}
    catch foo m
    return -level 0 $m[unset m]
} bar

# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
catch {rename untraced {}}
catch {rename traceproc {}}

Changes to tests/unixForkEvent.test.

33
34
35
36
37
38
39
40
41
42
43
44
45
	    exit
	}
	# we are the original process
	while {![file readable [file join $myFolder result.txt]]} {}
	viewFile result.txt $myFolder
    } \
    -result {writable} \
    -cleanup { 
	catch { removeFolder $myFolder }
    }

::tcltest::cleanupTests
return






|





33
34
35
36
37
38
39
40
41
42
43
44
45
	    exit
	}
	# we are the original process
	while {![file readable [file join $myFolder result.txt]]} {}
	viewFile result.txt $myFolder
    } \
    -result {writable} \
    -cleanup {
	catch { removeFolder $myFolder }
    }

::tcltest::cleanupTests
return

Changes to tests/unixNotfy.test.

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { 
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
................................................................................
	vwait y
	close $f2
   	thread::create "thread::send [thread::id] {set x ok}"
	vwait x
	set x
    } \
    -result {ok} \
    -cleanup { 
	catch { close $f1 }
	catch { close $f2 }
	catch { removeFile foo }
	catch { removeFile foo2 }
    }

# cleanup
::tcltest::cleanupTests
return






|







 







|









30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
................................................................................
	vwait y
	close $f2
   	thread::create "thread::send [thread::id] {set x ok}"
	vwait x
	set x
    } \
    -result {ok} \
    -cleanup {
	catch { close $f1 }
	catch { close $f2 }
	catch { removeFile foo }
	catch { removeFile foo2 }
    }

# cleanup
::tcltest::cleanupTests
return

Changes to tests/unknown.test.

54
55
56
57
58
59
60
61
62
63
64
65
    list [catch {non-existent a b} msg] $msg $errorCode
} {1 {unknown failed} NONE}
 
# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
cleanupTests
return 

# Local Variables:
# mode: tcl
# End:






|




54
55
56
57
58
59
60
61
62
63
64
65
    list [catch {non-existent a b} msg] $msg $errorCode
} {1 {unknown failed} NONE}
 
# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/uplevel.test.

97
98
99
100
101
102
103



































































































104
105
106
107
108
109
110
...
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    uplevel
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.4 {error: not enough args} -returnCodes error -body {
    apply {{} {
	uplevel 1
    }}
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}




































































































proc a2 {} {
    uplevel a3
}
proc a3 {} {
    global x y
    set x [info level]
................................................................................
#

test uplevel-7.1 {var access, no LVT in either level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    namespace eval foo {
	set x 2 
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
................................................................................
} -result {3 3 3}

test uplevel-7.2 {var access, no LVT in upper level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    proc foo {} {
	set x 2 
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
................................................................................
	set x 1; #var in LVT
	unset -nocomplain y z
	foo
	list $x $y $z
    }
} -body {
    proc foo {} {
	set x 2 
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|







 







|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
...
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
    uplevel
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.4 {error: not enough args} -returnCodes error -body {
    apply {{} {
	uplevel 1
    }}
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.5 {level parsing} {
    apply {{} {uplevel 0 {}}}
} {}
test uplevel-4.6 {level parsing} {
    apply {{} {uplevel #0 {}}}
} {}
test uplevel-4.7 {level parsing} {
    apply {{} {uplevel [expr 0] {}}}
} {}
test uplevel-4.8 {level parsing} {
    apply {{} {uplevel #[expr 0] {}}}
} {}
test uplevel-4.9 {level parsing} {
    apply {{} {uplevel -0 {}}}
} {}
test uplevel-4.10 {level parsing} {
    apply {{} {uplevel #-0 {}}}
} {}
test uplevel-4.11 {level parsing} {
    apply {{} {uplevel [expr -0] {}}}
} {}
test uplevel-4.12 {level parsing} {
    apply {{} {uplevel #[expr -0] {}}}
} {}
test uplevel-4.13 {level parsing} {
    apply {{} {uplevel 1 {}}}
} {}
test uplevel-4.14 {level parsing} {
    apply {{} {uplevel #1 {}}}
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} {
    apply {{} {uplevel -0xffffffff {}}}
} {}
test uplevel-4.18 {level parsing} {
    apply {{} {uplevel #-0xffffffff {}}}
} {}
test uplevel-4.19 {level parsing} {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} {}
test uplevel-4.20 {level parsing} {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} {}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
} -returnCodes error -result {invalid command name "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
    apply {{} {uplevel [expr -1] {}}}
} -returnCodes error -result {invalid command name "-1"}
test uplevel-4.24 {level parsing} -body {
    apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.25 {level parsing} -body {
    apply {{} {uplevel 0xffffffff {}}}
} -returnCodes error -result {bad level "0xffffffff"}
test uplevel-4.26 {level parsing} -body {
    apply {{} {uplevel #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {level parsing} -body {
    apply {{} {uplevel [expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "4294967295"}
test uplevel-4.28 {level parsing} -body {
    apply {{} {uplevel #[expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
    apply {{} {uplevel 0.2 {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.30 {level parsing} -body {
    apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
    apply {{} {uplevel [expr 0.2] {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.32 {level parsing} -body {
    apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.33 {level parsing} -body {
    apply {{} {uplevel .2 {}}}
} -returnCodes error -result {invalid command name ".2"}
test uplevel-4.34 {level parsing} -body {
    apply {{} {uplevel #.2 {}}}
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
    apply {{} {uplevel [expr .2] {}}}
} -returnCodes error -result {bad level "0.2"}
test uplevel-4.36 {level parsing} -body {
    apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}




proc a2 {} {
    uplevel a3
}
proc a3 {} {
    global x y
    set x [info level]
................................................................................
#

test uplevel-7.1 {var access, no LVT in either level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    namespace eval foo {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
................................................................................
} -result {3 3 3}

test uplevel-7.2 {var access, no LVT in upper level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    proc foo {} {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
................................................................................
	set x 1; #var in LVT
	unset -nocomplain y z
	foo
	list $x $y $z
    }
} -body {
    proc foo {} {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }

Changes to tests/upvar.test.

473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
	    set w
	}
	return [a]
    }
} -returnCodes error -cleanup {
    namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}
    
test upvar-NS-1.5 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	namespace upvar test_ns_0 x w
	set w
    }
} -cleanup {






|







473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
	    set w
	}
	return [a]
    }
} -returnCodes error -cleanup {
    namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}

test upvar-NS-1.5 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	namespace upvar test_ns_0 x w
	set w
    }
} -cleanup {

Changes to tests/utf.test.

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
test utf-21.1 {TclUniCharIsAlnum} {
    # this returns 1 with Unicode 7 compliance
    string is alnum \u1040\u021f\u0220
} {1}
test utf-21.2 {unicode alnum char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220]
} {1 1}
test utf-21.3 {unicode print char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    regexp {^[[:print:]]+$} \ufbc1
} 1
test utf-21.4 {TclUniCharIsGraph} {
    # [Bug 3464428]






|







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
test utf-21.1 {TclUniCharIsAlnum} {
    # this returns 1 with Unicode 7 compliance
    string is alnum \u1040\u021f\u0220
} {1}
test utf-21.2 {unicode alnum char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220_\u203f\u2040\u2054\ufe33\ufe34\ufe4d\ufe4e\ufe4f\uff3f]
} {1 1}
test utf-21.3 {unicode print char in regc_locale.c} {
    # this returns 1 with Unicode 7 compliance
    regexp {^[[:print:]]+$} \ufbc1
} 1
test utf-21.4 {TclUniCharIsGraph} {
    # [Bug 3464428]

Changes to tests/util.test.

204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
....
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
} {a c}
test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
    # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.
    concat \xe0
} \xe0
test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
    # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
    # symptoms was Bug #2055782. 
    testconcatobj
} {}

proc Wrapper_Tcl_StringMatch {pattern string} {
    # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
    switch -glob -- $string $pattern {return 1} default {return 0}
}
................................................................................
    string index abcdefghijk 0xa
} k
test util-9.1.3 {TclGetIntForIndex} {
    string index abcdefghijk { 0xa }
} k
test util-9.2.0 {TclGetIntForIndex} {
    string index abcd end
} d 
test util-9.2.1 {TclGetIntForIndex} -body {
    string index abcd { end}
} -returnCodes error -match glob -result *
test util-9.2.2 {TclGetIntForIndex} -body {
    string index abcd {end }
} -returnCodes error -match glob -result *
test util-9.3 {TclGetIntForIndex} {
................................................................................
	binary scan [binary format q [expr double($input)]] wu x
	lappend r [format %#llx $x]
	binary scan [binary format q [expr double(-$input)]] wu x
	lappend r [format %#llx $x]
    }
    set r
} [list {*}{
    0x43fffffffffffffc 0xc3fffffffffffffc 
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffd 0xc3fffffffffffffd
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000






|







 







|







 







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
....
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
} {a c}
test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
    # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.
    concat \xe0
} \xe0
test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
    # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
    # symptoms was Bug #2055782.
    testconcatobj
} {}

proc Wrapper_Tcl_StringMatch {pattern string} {
    # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
    switch -glob -- $string $pattern {return 1} default {return 0}
}
................................................................................
    string index abcdefghijk 0xa
} k
test util-9.1.3 {TclGetIntForIndex} {
    string index abcdefghijk { 0xa }
} k
test util-9.2.0 {TclGetIntForIndex} {
    string index abcd end
} d
test util-9.2.1 {TclGetIntForIndex} -body {
    string index abcd { end}
} -returnCodes error -match glob -result *
test util-9.2.2 {TclGetIntForIndex} -body {
    string index abcd {end }
} -returnCodes error -match glob -result *
test util-9.3 {TclGetIntForIndex} {
................................................................................
	binary scan [binary format q [expr double($input)]] wu x
	lappend r [format %#llx $x]
	binary scan [binary format q [expr double(-$input)]] wu x
	lappend r [format %#llx $x]
    }
    set r
} [list {*}{
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffd 0xc3fffffffffffffd
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000

Changes to tests/var.test.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
...
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
catch {unset i}
catch {unset a}
catch {unset arr}
 
test var-1.1 {TclLookupVar, Array handling} -setup {
    catch {unset a}
} -body {
    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
    set i 10
    set arr(foo) 37
    list [$x i] $i [$x arr(foo)] $arr(foo)
} -result {11 11 38 38}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
    set x "global value"
    namespace eval test_ns_var {
................................................................................
} {1998}
test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
    catch {unset a}
} -constraints testupvar -body {
    set a 123321
    proc p {} {
	# create global xx linked to global a
	testupvar 1 a {} xx global 
    }
    list [p] $xx [set xx 789] $a
} -result {{} 123321 789 789}
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
    catch {unset a}
} -constraints testupvar -body {
    set a 456
    namespace eval test_ns_var {
	catch {unset ::test_ns_var::vv}
	proc p {} {
	    # create namespace var vv linked to global a
	    testupvar 1 a {} vv namespace 
	}
	p
    }
    list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
    catch {unset aaaaa}
................................................................................
	p
    }
} {{My name is ":"} :}
test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var { 
	variable arrayvar
	set arrayvar(1) x
	variable arrayvar(1) y
    }   
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
    variable
} {}
test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
    namespace eval test_ns_var {
	variable
................................................................................

test var-15.1 {segfault in [unset], [Bug 735335]} {
    proc A { name } {
	upvar $name var
	set var $name
    }
    #
    # Note that the variable name has to be 
    # unused previously for the segfault to
    # be triggered.
    #
    namespace eval test A useSomeUnlikelyNameHere
    namespace eval test unset useSomeUnlikelyNameHere
} {}
test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {






|







 







|











|







 







|



|







 







|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
...
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
catch {unset i}
catch {unset a}
catch {unset arr}
 
test var-1.1 {TclLookupVar, Array handling} -setup {
    catch {unset a}
} -body {
    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd
    set i 10
    set arr(foo) 37
    list [$x i] $i [$x arr(foo)] $arr(foo)
} -result {11 11 38 38}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
    set x "global value"
    namespace eval test_ns_var {
................................................................................
} {1998}
test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
    catch {unset a}
} -constraints testupvar -body {
    set a 123321
    proc p {} {
	# create global xx linked to global a
	testupvar 1 a {} xx global
    }
    list [p] $xx [set xx 789] $a
} -result {{} 123321 789 789}
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
    catch {unset a}
} -constraints testupvar -body {
    set a 456
    namespace eval test_ns_var {
	catch {unset ::test_ns_var::vv}
	proc p {} {
	    # create namespace var vv linked to global a
	    testupvar 1 a {} vv namespace
	}
	p
    }
    list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
    catch {unset aaaaa}
................................................................................
	p
    }
} {{My name is ":"} :}
test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var {
	variable arrayvar
	set arrayvar(1) x
	variable arrayvar(1) y
    }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
    variable
} {}
test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
    namespace eval test_ns_var {
	variable
................................................................................

test var-15.1 {segfault in [unset], [Bug 735335]} {
    proc A { name } {
	upvar $name var
	set var $name
    }
    #
    # Note that the variable name has to be
    # unused previously for the segfault to
    # be triggered.
    #
    namespace eval test A useSomeUnlikelyNameHere
    namespace eval test unset useSomeUnlikelyNameHere
} {}
test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {

Changes to tests/winPipe.test.

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big	
append big $big
append big $big
append big $big
append big $big

set path(little) [makeFile {} little]
set f [open $path(little) w] 
puts -nonewline $f "little"
close $f

set path(big) [makeFile {} big]
set f [open $path(big) w]
puts -nonewline $f $big
close $f






|






|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
append big $big
append big $big
append big $big

set path(little) [makeFile {} little]
set f [open $path(little) w]
puts -nonewline $f "little"
close $f

set path(big) [makeFile {} big]
set f [open $path(big) w]
puts -nonewline $f $big
close $f

Changes to tests/zlib.test.

871
872
873
874
875
876
877


















878
879
880
881
882
883
884
    set f [open $file rb]
    set d [read $f]
    close $f
    zlib gunzip $d -header noSuchNs::foo
} -cleanup {
    removeFile $file
} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}


















 
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
    set f [open $file rb]
    set d [read $f]
    close $f
    zlib gunzip $d -header noSuchNs::foo
} -cleanup {
    removeFile $file
} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}

test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup {
    set stream [zlib stream compress]
} -body {
    for {set opts {};set y 0} {$y < 60} {incr y} {
	for {set line {};set x 0} {$x < 100} {incr x} {
	    append line [binary format ccc $x $y 128]
	}
	if {$y == 59} {
	    set opts -finalize
	}
	$stream put {*}$opts $line
    }
    set data [$stream get]
    list [string length $data] [string length [zlib decompress $data]]
} -cleanup {
    $stream close
} -result {12026 18000}
 
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tools/genStubs.tcl.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.4

namespace eval genStubs {
    # libraryName --
    #
    #	The name of the entire library.  This value is used to compute
    #	the USE_*_STUBS macro and the name of the init file.

    variable libraryName "UNKNOWN"






<
<







6
7
8
9
10
11
12


13
14
15
16
17
18
19
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.



namespace eval genStubs {
    # libraryName --
    #
    #	The name of the entire library.  This value is used to compute
    #	the USE_*_STUBS macro and the name of the init file.

    variable libraryName "UNKNOWN"

Changes to tools/man2html.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/bin/sh
# \
exec tclsh "$0" ${1+"[email protected]"}

package require Tcl 8.4

# man2html.tcl --
#
# This file contains procedures that work in conjunction with the
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.




<
<







1
2
3
4


5
6
7
8
9
10
11
#!/bin/sh
# \
exec tclsh "$0" ${1+"[email protected]"}



# man2html.tcl --
#
# This file contains procedures that work in conjunction with the
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

Changes to tools/man2html1.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# man2html1.tcl --
#
# This file defines procedures that are used during the first pass of the
# man page to html conversion process. It is sourced by h.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

package require Tcl 8.4

# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.
#
# curFile -	tail of current man page.
#
# file -	file pointer; for both xref.tcl and contents.html






<
<







1
2
3
4
5
6
7


8
9
10
11
12
13
14
# man2html1.tcl --
#
# This file defines procedures that are used during the first pass of the
# man page to html conversion process. It is sourced by h.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.



# Global variables used by these scripts:
#
# state -	state variable that controls action of text proc.
#
# curFile -	tail of current man page.
#
# file -	file pointer; for both xref.tcl and contents.html

Changes to tools/man2html2.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# man2html2.tcl --
#
# This file defines procedures that are used during the second pass of the man
# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.

package require Tcl 8.4

# Global variables used by these scripts:
#
# NAME_file -	array indexed by NAME and containing file names used for
#		hyperlinks.
#
# textState -	state variable defining action of 'text' proc.
#






<
<







2
3
4
5
6
7
8


9
10
11
12
13
14
15
# man2html2.tcl --
#
# This file defines procedures that are used during the second pass of the man
# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.



# Global variables used by these scripts:
#
# NAME_file -	array indexed by NAME and containing file names used for
#		hyperlinks.
#
# textState -	state variable defining action of 'text' proc.
#

Changes to tools/tclZIC.tcl.

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#----------------------------------------------------------------------
#
# 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.
#----------------------------------------------------------------------

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.

set olsonFiles {
    africa antarctica asia australasia
    backward etcetera europe northamerica
    pacificnew southamerica systemv






<
<







26
27
28
29
30
31
32


33
34
35
36
37
38
39
#----------------------------------------------------------------------
#
# 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.
#----------------------------------------------------------------------



# Define the names of the Olson files that we need to load.
# We avoid the solar time files and the leap seconds.

set olsonFiles {
    africa antarctica asia australasia
    backward etcetera europe northamerica
    pacificnew southamerica systemv

Changes to tools/tcltk-man2html.tcl.

1
2
3
4
5
6
7
8
9
10
#!/usr/bin/env tclsh

if {[catch {package require Tcl 8.6} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
    exit 1
}


|







1
2
3
4
5
6
7
8
9
10
#!/usr/bin/env tclsh

if {[catch {package require Tcl 8.6-} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
    exit 1
}

Changes to unix/Makefile.in.

654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @[email protected]
	cd dltest ; $(MAKE) clean

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	cd dltest ; $(MAKE) distclean
................................................................................
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;

	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
................................................................................

# The following is a CYGWIN only source:
tclWinError.o: $(TOP_DIR)/win/tclWinError.c
	$(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c

# DTrace support

$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @[email protected]

$(DTRACE_HDR): $(DTRACE_SRC)
	$(DTRACE) -h $(DTRACE_SWITCHES) -o [email protected] -s $(DTRACE_SRC)

$(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS)
	$(DTRACE) -G $(DTRACE_SWITCHES) -o [email protected] -s $(DTRACE_SRC) $(TCL_OBJS)







|







 







|
|







 







|







654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @[email protected]
	cd dltest ; $(MAKE) clean

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	cd dltest ; $(MAKE) distclean
................................................................................
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.0.tm;

	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
................................................................................

# The following is a CYGWIN only source:
tclWinError.o: $(TOP_DIR)/win/tclWinError.c
	$(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c

# DTrace support

$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS) $(TOMMATH_OBJS): @[email protected]

$(DTRACE_HDR): $(DTRACE_SRC)
	$(DTRACE) -h $(DTRACE_SWITCHES) -o [email protected] -s $(DTRACE_SRC)

$(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS)
	$(DTRACE) -G $(DTRACE_SWITCHES) -o [email protected] -s $(DTRACE_SRC) $(TCL_OBJS)

Changes to unix/configure.

4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi






|







4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi

Changes to unix/tcl.m4.

1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"






|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"

Changes to unix/tclUnixNotfy.c.

1
2
3
4
5
6
7
8
9
10
11
...
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
429
430
431
432
433
434
435

436
437
438

439
440
441
442
443
444
445
....
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
....
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
....
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
#define AT_FORK_INIT_VALUE 0
#define RESET_ATFORK_MUTEX 1
/*
 * tclUnixNotify.c --
 *
 *	This file contains the implementation of the select()-based
 *	Unix-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
................................................................................
/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
static void	NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = AT_FORK_INIT_VALUE;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
 
/*
 * Import of Windows API when building threaded with Cygwin.
................................................................................
extern unsigned char __stdcall	ResetEvent(void *);
extern unsigned char __stdcall	TranslateMessage(const MSG *);

/*
 * Threaded-cygwin specific constants and functions in this file:
 */

static const WCHAR NotfyClassName[] = L"TclNotifier";
static DWORD __stdcall	NotifierProc(void *hwnd, unsigned int message,
			    void *wParam, void *lParam);
#endif /* TCL_THREADS && __CYGWIN__ */
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
................................................................................

	    class.style = 0;
	    class.cbClsExtra = 0;
	    class.cbWndExtra = 0;
	    class.hInstance = TclWinGetTclInstance();
	    class.hbrBackground = NULL;
	    class.lpszMenuName = NULL;
	    class.lpszClassName = NotfyClassName;
	    class.lpfnWndProc = NotifierProc;
	    class.hIcon = NULL;
	    class.hCursor = NULL;

	    RegisterClassW(&class);
	    tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
		    class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
................................................................................
#if defined(HAVE_PTHREAD_ATFORK)
	/*
	 * Install pthread_atfork handlers to clean up the notifier in the
	 * child of a fork.
	 */

	if (!atForkInit) {
	    int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);

	    if (result) {
		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif /* HAVE_PTHREAD_ATFORK */
................................................................................

	    if (triggerPipe != -1) {
		if (write(triggerPipe, "q", 1) != 1) {
		    Tcl_Panic("Tcl_FinalizeNotifier: %s",
			    "unable to write q to triggerPipe");
		}
		close(triggerPipe);

		while(triggerPipe != -1) {
		    pthread_cond_wait(&notifierCV, &notifierMutex);
		}

		if (notifierThreadRunning) {
		    int result = pthread_join((pthread_t) notifierThread, NULL);

		    if (result) {
			Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
				"thread");
		    }
................................................................................
    TclpThreadExit(0);
}
 
#if defined(HAVE_PTHREAD_ATFORK)
/*
 *----------------------------------------------------------------------
 *
 * AtForkPrepare --
 *
 *	Lock the notifier in preparation for a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkPrepare(void)
{
#if RESET_ATFORK_MUTEX == 0
    pthread_mutex_lock(&notifierInitMutex);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * AtForkParent --
 *
 *	Unlock the notifier in the parent after a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkParent(void)
{
#if RESET_ATFORK_MUTEX == 0
    pthread_mutex_unlock(&notifierInitMutex);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * AtForkChild --
 *
 *	Unlock and reinstall the notifier in the child after a fork.
 *
 * Results:
 *	None.
 *
................................................................................

static void
AtForkChild(void)
{
    if (notifierThreadRunning == 1) {
	pthread_cond_destroy(&notifierCV);
    }
#if RESET_ATFORK_MUTEX == 0
    pthread_mutex_unlock(&notifierInitMutex);
#else
    pthread_mutex_init(&notifierInitMutex, NULL);
    pthread_mutex_init(&notifierMutex, NULL);
#endif
    pthread_cond_init(&notifierCV, NULL);

    /*
     * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists)
     * atForkInit == 0: InitNotifier was never called
     * notifierCount != 0: unbalanced  InitNotifier() / FinalizeNotifier calls
     * waitingListPtr != 0: there are threads currently waiting for events.
................................................................................

	    /*
	     * The tsdPtr from before the fork is copied as well.  But since
	     * we are paranoic, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, NotfyClassName,
		    NotfyClassName, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);
#else
	    pthread_cond_destroy(&tsdPtr->waitCV);
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif
	    /*
<
<

|







 







|
<
<







 







|







 







|







 







|







 







>



>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<


<







 







|
|








1
2
3
4
5
6
7
8
9
...
191
192
193
194
195
196
197
198


199
200
201
202
203
204
205
...
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
...
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
...
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
...
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
....
1343
1344
1345
1346
1347
1348
1349
















































1350
1351
1352
1353
1354
1355
1356
....
1362
1363
1364
1365
1366
1367
1368



1369
1370

1371
1372
1373
1374
1375
1376
1377
....
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410

/*
 * tclUnixNotfy.c --
 *
 *	This file contains the implementation of the select()-based
 *	Unix-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
................................................................................
/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
static void	NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = 0;


static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
 
/*
 * Import of Windows API when building threaded with Cygwin.
................................................................................
extern unsigned char __stdcall	ResetEvent(void *);
extern unsigned char __stdcall	TranslateMessage(const MSG *);

/*
 * Threaded-cygwin specific constants and functions in this file:
 */

static const WCHAR className[] = L"TclNotifier";
static DWORD __stdcall	NotifierProc(void *hwnd, unsigned int message,
			    void *wParam, void *lParam);
#endif /* TCL_THREADS && __CYGWIN__ */
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
................................................................................

	    class.style = 0;
	    class.cbClsExtra = 0;
	    class.cbWndExtra = 0;
	    class.hInstance = TclWinGetTclInstance();
	    class.hbrBackground = NULL;
	    class.lpszMenuName = NULL;
	    class.lpszClassName = className;
	    class.lpfnWndProc = NotifierProc;
	    class.hIcon = NULL;
	    class.hCursor = NULL;

	    RegisterClassW(&class);
	    tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
		    class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
................................................................................
#if defined(HAVE_PTHREAD_ATFORK)
	/*
	 * Install pthread_atfork handlers to clean up the notifier in the
	 * child of a fork.
	 */

	if (!atForkInit) {
	    int result = pthread_atfork(NULL, NULL, AtForkChild);

	    if (result) {
		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif /* HAVE_PTHREAD_ATFORK */
................................................................................

	    if (triggerPipe != -1) {
		if (write(triggerPipe, "q", 1) != 1) {
		    Tcl_Panic("Tcl_FinalizeNotifier: %s",
			    "unable to write q to triggerPipe");
		}
		close(triggerPipe);
		pthread_mutex_lock(&notifierMutex);
		while(triggerPipe != -1) {
		    pthread_cond_wait(&notifierCV, &notifierMutex);
		}
		pthread_mutex_unlock(&notifierMutex);
		if (notifierThreadRunning) {
		    int result = pthread_join((pthread_t) notifierThread, NULL);

		    if (result) {
			Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
				"thread");
		    }
................................................................................
    TclpThreadExit(0);
}
 
#if defined(HAVE_PTHREAD_ATFORK)
/*
 *----------------------------------------------------------------------
 *
















































 * AtForkChild --
 *
 *	Unlock and reinstall the notifier in the child after a fork.
 *
 * Results:
 *	None.
 *
................................................................................

static void
AtForkChild(void)
{
    if (notifierThreadRunning == 1) {
	pthread_cond_destroy(&notifierCV);
    }



    pthread_mutex_init(&notifierInitMutex, NULL);
    pthread_mutex_init(&notifierMutex, NULL);

    pthread_cond_init(&notifierCV, NULL);

    /*
     * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists)
     * atForkInit == 0: InitNotifier was never called
     * notifierCount != 0: unbalanced  InitNotifier() / FinalizeNotifier calls
     * waitingListPtr != 0: there are threads currently waiting for events.
................................................................................

	    /*
	     * The tsdPtr from before the fork is copied as well.  But since
	     * we are paranoic, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, className,
		    className, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);
#else
	    pthread_cond_destroy(&tsdPtr->waitCV);
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif
	    /*

Changes to unix/tclUnixThrd.c.

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
...
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
...
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
...
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
...
711
712
713
714
715
716
717








718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;

/*
 * These are for the critical sections inside this file.
 */

#define MASTER_LOCK	pthread_mutex_lock(&masterLock)
#define MASTER_UNLOCK	pthread_mutex_unlock(&masterLock)

#endif /* TCL_THREADS */
 
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
 *
................................................................................
    pthread_mutex_lock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeLock
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.
 *
 * Results:
 *	None.
 *
................................................................................
void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr;

    if (*mutexPtr == NULL) {
	MASTER_LOCK;
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
	    pthread_mutex_init(pmutexPtr, NULL);
	    *mutexPtr = (Tcl_Mutex)pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	MASTER_UNLOCK;
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    const Tcl_Time *timePtr) /* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    pthread_mutex_t *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	MASTER_LOCK;

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	MASTER_UNLOCK;
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    if (timePtr == NULL) {
	pthread_cond_wait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;
................................................................................
 
#ifdef TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static volatile int initialized = 0;
static pthread_key_t key;

typedef struct allocMutex {
    Tcl_Mutex tlock;
    pthread_mutex_t plock;
} allocMutex;

................................................................................
    allocMutex* lockPtr = (allocMutex*) mutex;
    if (!lockPtr) {
	return;
    }
    pthread_mutex_destroy(&lockPtr->plock);
    free(lockPtr);
}









void
TclpFreeAllocCache(
    void *ptr)
{
    if (ptr != NULL) {
	/*
	 * Called by the pthread lib when a thread exits
	 */

	TclFreeAllocCache(ptr);
	pthread_setspecific(key, NULL);

    } else if (initialized) {
	/*
	 * Called by us in TclFinalizeThreadAlloc() during the library
	 * finalization initiated from Tcl_Finalize()
	 */

	pthread_key_delete(key);
	initialized = 0;
    }
}

void *
TclpGetAllocCache(void)
{
    if (!initialized) {
	pthread_mutex_lock(allocLockPtr);
	if (!initialized) {
	    pthread_key_create(&key, TclpFreeAllocCache);
	    initialized = 1;
	}
	pthread_mutex_unlock(allocLockPtr);
    }
    return pthread_getspecific(key);
}

void
TclpSetAllocCache(
    void *arg)
{






<
<
<
<
<
<
<







 







|







 







|










|







 







|












|







 







<







 







>
>
>
>
>
>
>
>













|
<
<
<
<
<

<






<
<
<
<
<
<
<
<







40
41
42
43
44
45
46







47
48
49
50
51
52
53
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
...
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
669
670
671
672
673
674
675

676
677
678
679
680
681
682
...
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731





732

733
734
735
736
737
738








739
740
741
742
743
744
745
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;








#endif /* TCL_THREADS */
 
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
 *
................................................................................
    pthread_mutex_lock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeLock
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.
 *
 * Results:
 *	None.
 *
................................................................................
void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    pthread_mutex_t *pmutexPtr;

    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&masterLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
	    pthread_mutex_init(pmutexPtr, NULL);
	    *mutexPtr = (Tcl_Mutex)pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    const Tcl_Time *timePtr) /* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    pthread_mutex_t *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	pthread_mutex_lock(&masterLock);

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    if (timePtr == NULL) {
	pthread_cond_wait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;
................................................................................
 
#ifdef TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC

static pthread_key_t key;

typedef struct allocMutex {
    Tcl_Mutex tlock;
    pthread_mutex_t plock;
} allocMutex;

................................................................................
    allocMutex* lockPtr = (allocMutex*) mutex;
    if (!lockPtr) {
	return;
    }
    pthread_mutex_destroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
{
    pthread_mutex_lock(allocLockPtr);
    pthread_key_create(&key, TclpFreeAllocCache);
    pthread_mutex_unlock(allocLockPtr);
}

void
TclpFreeAllocCache(
    void *ptr)
{
    if (ptr != NULL) {
	/*
	 * Called by the pthread lib when a thread exits
	 */

	TclFreeAllocCache(ptr);
	pthread_setspecific(key, NULL);

    } else {





	pthread_key_delete(key);

    }
}

void *
TclpGetAllocCache(void)
{








    return pthread_getspecific(key);
}

void
TclpSetAllocCache(
    void *arg)
{

Changes to win/Makefile.in.

656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
................................................................................
test: test-tcl test-packages

test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "package ifneeded Tcltest ${VERSION}@[email protected] [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)

# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@[email protected] [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(SCRIPT)







|
|







 







|






|







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm;
	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
................................................................................
test: test-tcl test-packages

test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "package ifneeded Tcltest ${VERSION}@[email protected] [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)

# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@[email protected] [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) $(SCRIPT)

Changes to win/coffbase.txt.

30
31
32
33
34
35
36

37
38
39
40
41
42
tdom		0x109E0000	0x00080000
tclvfs		0x10A70000	0x00010000
tkvideo		0x10B00000	0x00010000
tclsdl		0x10B20000	0x00080000
vqtcl		0x10C00000	0x00010000
tdbc		0x10C40000	0x00010000
thread		0x10C80000	0x00020000

;
; insert new packages here
;
snack		0x1E000000	0x00400000
sound		0x1E400000	0x00400000
snackogg	0x1E800000	0x00200000






>






30
31
32
33
34
35
36
37
38
39
40
41
42
43
tdom		0x109E0000	0x00080000
tclvfs		0x10A70000	0x00010000
tkvideo		0x10B00000	0x00010000
tclsdl		0x10B20000	0x00080000
vqtcl		0x10C00000	0x00010000
tdbc		0x10C40000	0x00010000
thread		0x10C80000	0x00020000
nsf		0x10ca0000	0x00080000
;
; insert new packages here
;
snack		0x1E000000	0x00400000
sound		0x1E400000	0x00400000
snackogg	0x1E800000	0x00200000

Changes to win/configure.

4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \[email protected]"
	CC_EXENAME="-o \[email protected]"







|







4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wsign-compare -Wdeclaration-after-statement"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \[email protected]"
	CC_EXENAME="-o \[email protected]"

Changes to win/makefile.vc.

585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.1 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
	@echo Please wait while the tests are collected...
	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
		package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.1 "$(TCLREGLIB:\=/)" registry]
<<
	type tests.log | more
!endif

runtest: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)






|





|







585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
<<
!else
	@echo Please wait while the tests are collected...
	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
		package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]
<<
	type tests.log | more
!endif

runtest: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

Changes to win/tcl.m4.

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	# Specify the CC output file names based on the target name
	CC_OBJNAME=&