Tcl Source Code

Check-in [fddd7e3bda]
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 (still has test failure in socket.test)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-456
Files: files | file ages | folders
SHA1: fddd7e3bdac05dce18c2ff3166045b49acd8ac88
User & Date: jan.nijtmans 2016-12-20 09:30:02
Context
2016-12-20
11:47
merge fork check-in: dcc31e850c user: jan.nijtmans tags: tip-456
09:30
merge trunk (still has test failure in socket.test) check-in: fddd7e3bda user: jan.nijtmans tags: tip-456
2016-12-16
16:14
Some more internal use of size_t in stead of int. No functional change. check-in: 54ab350c68 user: jan.nijtmans tags: trunk
2016-12-14
16:03
Update the documentation check-in: a2d596da81 user: limeboy tags: tip-456
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.2000.

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
	* generic/tcl.decls:
	* generic/tclIO.c: updated Tcl_IsChannelShared,
	Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel,
	Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
	new stacked channel implementation. Their stub slots were also moved
	to give preference to the new 8.3.2 stub functions. This will cause an
	incompatability with 8.4a1 only.
	(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
	didn't set nonBlocking correctly when resetting the flags for the
	write side. [Bug: 6261]

	* doc/ChnlStack.3:
	* doc/CrtChannel.3:
	* generic/tcl.decls:






|







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
	* generic/tcl.decls:
	* generic/tclIO.c: updated Tcl_IsChannelShared,
	Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel,
	Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
	new stacked channel implementation. Their stub slots were also moved
	to give preference to the new 8.3.2 stub functions. This will cause an
	incompatibility with 8.4a1 only.
	(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
	didn't set nonBlocking correctly when resetting the flags for the
	write side. [Bug: 6261]

	* doc/ChnlStack.3:
	* doc/CrtChannel.3:
	* generic/tcl.decls:

Changes to ChangeLog.2002.

843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
....
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
....
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
	TCL_MEM_DEBUG is used. [Bug 583445]

	* win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe
	if there was something to write. This may prevent infinite wait on
	exit.

	* tests/exec.test: marked exec-18.1 unixOnly until the Windows
	incompatability (in the test, not the core) can be resolved.

	* tests/http.test (http-3.11): added close $fp that was causing an
	error on Windows because the file was not closed before deleting.

	* unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static
	function only appear when HAVE_CFBUNDLE is defined.

................................................................................
	[regsub] returns the modified string.
	* doc/regsub.n: Updated docs.
	* tests/regexp.test: Updated and added tests.

	* compat/strtoll.c (strtoll):
	* compat/strtoull.c (strtoull):
	* unix/tclUnixPort.h:
	* win/tclWinPort.h: Const-ing 64-bit compatability declarations. Note
	that the return pointer is non-const because it is entirely legal for
	the functions to be called from somewhere that owns the string being
	passed. Fixes problem reported by Larry Virden.

2002-02-21  David Gravereaux <[email protected]>

	* win/mkd.bat (removed):
................................................................................

	+----------------------+
	| TIP #72 IMPLEMENTED. |
	+----------------------+

	There are a lot of changes from this TIP, so please see
	http://purl.org/tcl/tip/72.html for discussion of
	backward-compatability issues, but the main ones modifications are in:

	* generic/tcl.h: New types.
	* generic/tcl.decls: New public functions.
	* generic/tclExecute.c: 64-bit aware bytecode engine.
	* generic/tclBinary.c: 64-bit handling in [binary] command.
	* generic/tclScan.c: 64-bit handling in [scan] command.
	* generic/tclCmdAH.c: 64-bit handling in [file] and [format]






|







 







|







 







|







843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
....
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
....
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
	TCL_MEM_DEBUG is used. [Bug 583445]

	* win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe
	if there was something to write. This may prevent infinite wait on
	exit.

	* tests/exec.test: marked exec-18.1 unixOnly until the Windows
	incompatibility (in the test, not the core) can be resolved.

	* tests/http.test (http-3.11): added close $fp that was causing an
	error on Windows because the file was not closed before deleting.

	* unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static
	function only appear when HAVE_CFBUNDLE is defined.

................................................................................
	[regsub] returns the modified string.
	* doc/regsub.n: Updated docs.
	* tests/regexp.test: Updated and added tests.

	* compat/strtoll.c (strtoll):
	* compat/strtoull.c (strtoull):
	* unix/tclUnixPort.h:
	* win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note
	that the return pointer is non-const because it is entirely legal for
	the functions to be called from somewhere that owns the string being
	passed. Fixes problem reported by Larry Virden.

2002-02-21  David Gravereaux <[email protected]>

	* win/mkd.bat (removed):
................................................................................

	+----------------------+
	| TIP #72 IMPLEMENTED. |
	+----------------------+

	There are a lot of changes from this TIP, so please see
	http://purl.org/tcl/tip/72.html for discussion of
	backward-compatibility issues, but the main ones modifications are in:

	* generic/tcl.h: New types.
	* generic/tcl.decls: New public functions.
	* generic/tclExecute.c: 64-bit aware bytecode engine.
	* generic/tclBinary.c: 64-bit handling in [binary] command.
	* generic/tclScan.c: 64-bit handling in [scan] command.
	* generic/tclCmdAH.c: 64-bit handling in [file] and [format]

Changes to ChangeLog.2003.

943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
....
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
	function in multiple interfaces simultaneously.

	* generic/tcl.decls: Duplicated some namespace declarations from
	tclInt.decls here, as mandated by TIP #139. This is OK since the
	declarations match and will end up using the declarations in the
	public code from now on because of #include ordering. Keeping the old
	declarations in tclInt.decls; there's no need to gratuitously break
	compatability for those extensions which are already clients of the
	namespace code.

2003-08-23  Zoran Vasiljevic  <[email protected]>

	* generic/tclIOUtil.c: merged fixes for thread-unsafe handling of
	filesystem records [Bug 753315]. This also fixed the [Bug 788780]
	* generic/tclPathObj.c: merged fixes for thread-unsafe handling of
................................................................................

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept
	dictionaries for maps.  This is much trickier than it looks, since map
	entry ordering is significant. [Bug 759936]

	* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
	and [array set] work with dictionaries, producing them and consuming
	them. Note that for compatability reasons, you will never get a dict
	from feeding a string literal to [array set] since that alters the
	trace behaviour of "multi-key" sets. [Bug 759935]

2003-06-23  Vince Darley  <[email protected]>

	* generic/tclTrace.c: fix to Window debug build compilation error.







|







 







|







943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
....
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
	function in multiple interfaces simultaneously.

	* generic/tcl.decls: Duplicated some namespace declarations from
	tclInt.decls here, as mandated by TIP #139. This is OK since the
	declarations match and will end up using the declarations in the
	public code from now on because of #include ordering. Keeping the old
	declarations in tclInt.decls; there's no need to gratuitously break
	compatibility for those extensions which are already clients of the
	namespace code.

2003-08-23  Zoran Vasiljevic  <[email protected]>

	* generic/tclIOUtil.c: merged fixes for thread-unsafe handling of
	filesystem records [Bug 753315]. This also fixed the [Bug 788780]
	* generic/tclPathObj.c: merged fixes for thread-unsafe handling of
................................................................................

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept
	dictionaries for maps.  This is much trickier than it looks, since map
	entry ordering is significant. [Bug 759936]

	* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
	and [array set] work with dictionaries, producing them and consuming
	them. Note that for compatibility reasons, you will never get a dict
	from feeding a string literal to [array set] since that alters the
	trace behaviour of "multi-key" sets. [Bug 759935]

2003-06-23  Vince Darley  <[email protected]>

	* generic/tclTrace.c: fix to Window debug build compilation error.

Changes to ChangeLog.2004.

1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
	code splitting [Bug 925620] removing the need for several #ifdef's,
	and tests and fix for an unreported Windows glob problem ('glob -dir
	C: -tails *').

2004-10-07  Donal K. Fellows  <[email protected]>

	* *.3: Convert CONST to const and VOID to void so we document how
	people should actually use the Tcl API and not the compatability hacks
	that it has to have.

	* doc/man.macros, *.3: Update .AS macro so it can know how wide to
	make the third column of the argument list. Update documentation for C
	API (only users) to take advantage of this.

	* doc/FileSystem.3: Formatting fixes for greater documentation






|







1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
	code splitting [Bug 925620] removing the need for several #ifdef's,
	and tests and fix for an unreported Windows glob problem ('glob -dir
	C: -tails *').

2004-10-07  Donal K. Fellows  <[email protected]>

	* *.3: Convert CONST to const and VOID to void so we document how
	people should actually use the Tcl API and not the compatibility hacks
	that it has to have.

	* doc/man.macros, *.3: Update .AS macro so it can know how wide to
	make the third column of the argument list. Update documentation for C
	API (only users) to take advantage of this.

	* doc/FileSystem.3: Formatting fixes for greater documentation

Changes to generic/tcl.h.

1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
 * TCL_ONE_WORD_KEYS:		The keys are pointers, the pointer is stored
 *				in the entry.
 * TCL_CUSTOM_TYPE_KEYS:	The keys are arbitrary types which are copied
 *				into the entry.
 * TCL_CUSTOM_PTR_KEYS:		The keys are pointers to arbitrary types, the
 *				pointer is stored in the entry.
 *
 * While maintaining binary compatability the above have to be distinct values
 * as they are used to differentiate between old versions of the hash table
 * which don't have a typePtr and new ones which do. Once binary compatability
 * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
 * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
 * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
 * accessed from the entry and not the behaviour.
 */

#define TCL_STRING_KEYS		(0)






|

|







1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
 * TCL_ONE_WORD_KEYS:		The keys are pointers, the pointer is stored
 *				in the entry.
 * TCL_CUSTOM_TYPE_KEYS:	The keys are arbitrary types which are copied
 *				into the entry.
 * TCL_CUSTOM_PTR_KEYS:		The keys are pointers to arbitrary types, the
 *				pointer is stored in the entry.
 *
 * While maintaining binary compatibility the above have to be distinct values
 * as they are used to differentiate between old versions of the hash table
 * which don't have a typePtr and new ones which do. Once binary compatibility
 * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
 * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
 * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
 * accessed from the entry and not the behaviour.
 */

#define TCL_STRING_KEYS		(0)

Changes to generic/tclBasic.c.

3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
....
3048
3049
3050
3051
3052
3053
3054








3055
3056
3057
3058
3059
3060
3061
....
3150
3151
3152
3153
3154
3155
3156







3157
3158
3159
3160
3161
3162
3163
    Tcl_Command cmd)		/* Token for command to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = (Command *) cmd;
    ImportRef *refPtr, *nextRefPtr;
    Tcl_Command importCmd;

    /*
     * Bump the command epoch counter. This will invalidate all cached
     * references that point to this command.
     */

    cmdPtr->cmdEpoch++;

    /*
     * The code here is tricky. We can't delete the hash table entry before
     * invoking the deletion callback because there are cases where the
     * deletion callback needs to invoke the command (e.g. object systems such
     * as OTcl). However, this means that the callback could try to delete or
     * rename the command. The deleted flag allows us to detect these cases
     * and skip nested deletes.
................................................................................
	 * three times, everything goes up in smoke. [Bug 1220058]
	 */

	if (cmdPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
	    cmdPtr->hPtr = NULL;
	}








	return 0;
    }

    /*
     * We must delete this command, even though both traces and delete procs
     * may try to avoid this (renaming the command etc). Also traces and
     * delete procs may try to delete the command themsevles. This flag
................................................................................
     * cmdPtr->hptr, and make sure that no-one else has already deleted the
     * hash entry.
     */

    if (cmdPtr->hPtr != NULL) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = NULL;







    }

    /*
     * A number of tests for particular kinds of commands are done by checking
     * whether the objProc field holds a known value. Set the field to NULL so
     * that such tests won't have false positives when applied to deleted
     * commands.






<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>







3019
3020
3021
3022
3023
3024
3025







3026
3027
3028
3029
3030
3031
3032
....
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
....
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
    Tcl_Command cmd)		/* Token for command to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = (Command *) cmd;
    ImportRef *refPtr, *nextRefPtr;
    Tcl_Command importCmd;








    /*
     * The code here is tricky. We can't delete the hash table entry before
     * invoking the deletion callback because there are cases where the
     * deletion callback needs to invoke the command (e.g. object systems such
     * as OTcl). However, this means that the callback could try to delete or
     * rename the command. The deleted flag allows us to detect these cases
     * and skip nested deletes.
................................................................................
	 * three times, everything goes up in smoke. [Bug 1220058]
	 */

	if (cmdPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
	    cmdPtr->hPtr = NULL;
	}

	/*
	 * Bump the command epoch counter. This will invalidate all cached
	 * references that point to this command.
	 */

	cmdPtr->cmdEpoch++;

	return 0;
    }

    /*
     * We must delete this command, even though both traces and delete procs
     * may try to avoid this (renaming the command etc). Also traces and
     * delete procs may try to delete the command themsevles. This flag
................................................................................
     * cmdPtr->hptr, and make sure that no-one else has already deleted the
     * hash entry.
     */

    if (cmdPtr->hPtr != NULL) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = NULL;

	/*
	 * Bump the command epoch counter. This will invalidate all cached
	 * references that point to this command.
	 */

	cmdPtr->cmdEpoch++;
    }

    /*
     * A number of tests for particular kinds of commands are done by checking
     * whether the objProc field holds a known value. Set the field to NULL so
     * that such tests won't have false positives when applied to deleted
     * commands.

Changes to generic/tclBinary.c.

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
...
207
208
209
210
211
212
213






214
215
216
217
218
219
220
...
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
...
367
368
369
370
371
372
373

374
375
376
377
378
379
380
381
...
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
...
446
447
448
449
450
451
452
453
454
455
456
457
458



459



460
461
462
463
464
465

466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481
482
...
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652
    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
 * The following object type represents an array of bytes. An array of bytes
 * is not equivalent to an internationalized string. Conceptually, a string is
 * an array of 16-bit quantities organized as a sequence of properly formed
 * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
 * Accessor functions are provided to convert a ByteArray to a String or a

 * String to a ByteArray. Two or more consecutive bytes in an array of bytes
 * may look like a single UTF-8 character if the array is casually treated as
 * a string. But obtaining the String from a ByteArray is guaranteed to
 * produced properly formed UTF-8 sequences so that there is a one-to-one map
 * between bytes and characters.
 *


 * Converting a ByteArray to a String proceeds by casting each byte in the
 * array to a 16-bit quantity, treating that number as a Unicode character,
 * and storing the UTF-8 version of that Unicode character in the String. For
 * ByteArrays consisting entirely of values 1..127, the corresponding String
















 * representation is the same as the ByteArray representation.
 *
 * Converting a String to a ByteArray proceeds by getting the Unicode
 * representation of each character in the String, casting it to a byte by
 * truncating the upper 8 bits, and then storing the byte in the ByteArray.
 * Converting from ByteArray to String and back to ByteArray is not lossy, but
 * converting an arbitrary String to a ByteArray may be.






















































 */

const Tcl_ObjType tclByteArrayType = {
    "bytearray",
    FreeByteArrayInternalRep,
    DupByteArrayInternalRep,
    UpdateStringOfByteArray,








    SetByteArrayFromAny
};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
................................................................................
#define BYTEARRAY_SIZE(len) \
		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)







 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
 *	This procedure is creates a new ByteArray object and initializes it
................................................................................
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
    }
    objPtr->typePtr = &tclByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
................................................................................
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;


    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = baPtr->used;
    }
................................................................................
    int length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }

    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
................................................................................
 */

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    int length;
    const char *src, *srcEnd;
    unsigned char *dst;
    ByteArray *byteArrayPtr;
    Tcl_UniChar ch;




    if (objPtr->typePtr != &tclByteArrayType) {



	src = TclGetStringFromObj(objPtr, &length);
	srcEnd = src + length;

	byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
	for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	    src += Tcl_UtfToUniChar(src, &ch);

	    *dst++ = UCHAR(ch);
	}

	byteArrayPtr->used = dst - byteArrayPtr->bytes;
	byteArrayPtr->allocated = length;

	TclFreeIntRep(objPtr);
	objPtr->typePtr = &tclByteArrayType;

	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FreeByteArrayInternalRep --
................................................................................

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
    SET_BYTEARRAY(copyPtr, copyArrayPtr);

    copyPtr->typePtr = &tclByteArrayType;
}
 
/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfByteArray --
 *
................................................................................
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/* Append zero bytes is a no-op. */
	return;
    }

    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }






|
|
|
|
<
>
|
|
|
<
<

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

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


|




>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







 







|







 







>
|







 







>
|







 







|





>
>
>
|
>
>
>
|
|

|
|
|
>
|
|

|
|

|
<
>
|
<







 







|







 







>
|







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
...
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
...
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
...
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
...
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
...
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
...
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
 * The following object types represent an array of bytes. The intent is
 * to allow arbitrary binary data to pass through Tcl as a Tcl value
 * without loss or damage. Such values are useful for things like
 * encoded strings or Tk images to name just two.

 *
 * It's strange to have two Tcl_ObjTypes in place for this task when
 * one would do, so a bit of detail and history how we got to this point
 * and where we might go from here.


 *
 * A bytearray is an ordered sequence of bytes. Each byte is an integer
 * value in the range [0-255].  To be a Tcl value type, we need a way to
 * encode each value in the value set as a Tcl string.  The simplest
 * encoding is to represent each byte value as the same codepoint value.
 * A bytearray of N bytes is encoded into a Tcl string of N characters
 * where the codepoint of each character is the value of corresponding byte.
 * This approach creates a one-to-one map between all bytearray values
 * and a subset of Tcl string values.
 * 
 * When converting a Tcl string value to the bytearray internal rep, the
 * question arises what to do with strings outside that subset?  That is,
 * those Tcl strings containing at least one codepoint greater than 255?
 * The obviously correct answer is to raise an error!  That string value
 * does not represent any valid bytearray value. Full Stop.  The
 * setFromAnyProc signature has a completion code return value for just
 * this reason, to reject invalid inputs.
 * 
 * Unfortunately this was not the path taken by the authors of the
 * original tclByteArrayType.  They chose to accept all Tcl string values
 * as acceptable string encodings of the bytearray values that result
 * from masking away the high bits of any codepoint value at all. This
 * meant that every bytearray value had multiple accepted string
 * representations.
 *





 * The implications of this choice are truly ugly.  When a Tcl value has
 * a string representation, we are required to accept that as the true
 * value.  Bytearray values that possess a string representation cannot
 * be processed as bytearrays because we cannot know which true value
 * that bytearray represents.  The consequence is that we drag around
 * an internal rep that we cannot make any use of.  This painful price
 * is extracted at any point after a string rep happens to be generated
 * for the value.  This happens even when the troublesome codepoints
 * outside the byte range never show up.  This happens rather routinely
 * in normal Tcl operations unless we burden the script writer with the
 * cognitive burden of avoiding it.  The price is also paid by callers
 * of the C interface.  The routine
 *
 *	unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
 *
 * has a guarantee to always return a non-NULL value, but that value
 * points to a byte sequence that cannot be used by the caller to  
 * process the Tcl value absent some sideband testing that objPtr
 * is "pure".  Tcl offers no public interface to perform this test,
 * so callers either break encapsulation or are unavoidably buggy.  Tcl
 * has defined a public interface that cannot be used correctly. The
 * Tcl source code itself suffers the same problem, and has been buggy,
 * but progressively less so as more and more portions of the code have
 * been retrofitted with the required "purity testing".  The set of values
 * able to pass the purity test can be increased via the introduction of
 * a "canonical" flag marker, but the only way the broken interface itself
 * can be discarded is to start over and define the Tcl_ObjType properly.
 * Bytearrays should simply be usable as bytearrays without a kabuki
 * dance of testing.
 *
 * The Tcl_ObjType "properByteArrayType" is (nearly) a correct 
 * implementation of bytearrays.  Any Tcl value with the type
 * properByteArrayType can have its bytearray value fetched and
 * used with confidence that acting on that value is equivalent to
 * acting on the true Tcl string value.  This still implies a side
 * testing burden -- past mistakes will not let us avoid that
 * immediately, but it is at least a conventional test of type, and
 * can be implemented entirely by examining the objPtr fields, with
 * no need to query the intrep, as a canonical flag would require.
 *
 * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can
 * be revised to admit the possibility of returning NULL when the true
 * value is not a valid bytearray, we need a mechanism to retain
 * compatibility with the deployed callers of the broken interface.
 * That's what the retained "tclByteArrayType" provides.  In those
 * unusual circumstances where we convert an invalid bytearray value
 * to a bytearray type, it is to this legacy type.  Essentially any
 * time this legacy type gets used, it's a signal of a bug being ignored.
 * A TIP should be drafted to remove this connection to the broken past
 * so that Tcl 9 will no longer have any trace of it.  Prescribing a
 * migration path will be the key element of that work.  The internal
 * changes now in place are the limit of what can be done short of
 * interface repair.  They provide a great expansion of the histories
 * over which bytearray values can be useful in the meanwhile.
 */

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeByteArrayInternalRep,
    DupByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL
};

const Tcl_ObjType tclByteArrayType = {
    "bytearray",
    FreeByteArrayInternalRep,
    DupByteArrayInternalRep,
    NULL,
    SetByteArrayFromAny
};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
................................................................................
#define BYTEARRAY_SIZE(len) \
		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return (objPtr->typePtr == &properByteArrayType);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
 *	This procedure is creates a new ByteArray object and initializes it
................................................................................
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
    }
    objPtr->typePtr = &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
................................................................................
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;

    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = baPtr->used;
    }
................................................................................
    int length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
................................................................................
 */

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    int length, improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    ByteArray *byteArrayPtr;
    Tcl_UniChar ch;

    if (objPtr->typePtr == &properByteArrayType) {
	return TCL_OK;
    }
    if (objPtr->typePtr == &tclByteArrayType) {
	return TCL_OK;
    }

    src = TclGetStringFromObj(objPtr, &length);
    srcEnd = src + length;

    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += Tcl_UtfToUniChar(src, &ch);
	improper = improper || (ch > 255);
	*dst++ = UCHAR(ch);
    }

    byteArrayPtr->used = dst - byteArrayPtr->bytes;
    byteArrayPtr->allocated = length;

    TclFreeIntRep(objPtr);

    objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FreeByteArrayInternalRep --
................................................................................

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
    SET_BYTEARRAY(copyPtr, copyArrayPtr);

    copyPtr->typePtr = srcPtr->typePtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfByteArray --
 *
................................................................................
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/* Append zero bytes is a no-op. */
	return;
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

Changes to generic/tclClock.c.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
....
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
};

/*
 * Structure containing the client data for [clock]
 */

typedef struct ClockClientData {
    int refCount;		/* Number of live references. */
    Tcl_Obj **literals;		/* Pool of object literals. */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

................................................................................
static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = clientData;
    int i;

    data->refCount--;
    if (data->refCount == 0) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);
	ckfree(data);
    }
}






|







 







|
<







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
....
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
};

/*
 * Structure containing the client data for [clock]
 */

typedef struct ClockClientData {
    size_t refCount;		/* Number of live references. */
    Tcl_Obj **literals;		/* Pool of object literals. */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

................................................................................
static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = clientData;
    int i;

    if (data->refCount-- <= 1) {

	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);
	ckfree(data);
    }
}

Changes to generic/tclEncoding.c.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
				 * type. Passed to conversion functions. */
    LengthProc *lengthProc;	/* Function to compute length of
				 * null-terminated strings in this encoding.
				 * If nullSize is 1, this is strlen; if
				 * nullSize is 2, this is a function that
				 * returns the number of bytes in a 0x0000
				 * terminated string. */
    int refCount;		/* Number of uses of this structure. */
    Tcl_HashEntry *hPtr;	/* Hash table entry that owns this encoding. */
} Encoding;

/*
 * The following structure is the clientData for a dynamically-loaded,
 * table-driven encoding created by LoadTableEncoding(). It maps between
 * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
................................................................................
    Tcl_Encoding encoding)
{
    Encoding *encodingPtr = (Encoding *) encoding;

    if (encodingPtr == NULL) {
	return;
    }
    if (encodingPtr->refCount<=0) {
	Tcl_Panic("FreeEncoding: refcount problem !!!");
    }
    encodingPtr->refCount--;
    if (encodingPtr->refCount == 0) {
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	ckfree(encodingPtr->name);






|







 







<
<
<
|
<







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
840
841
842
843
844
845
846



847

848
849
850
851
852
853
854
				 * type. Passed to conversion functions. */
    LengthProc *lengthProc;	/* Function to compute length of
				 * null-terminated strings in this encoding.
				 * If nullSize is 1, this is strlen; if
				 * nullSize is 2, this is a function that
				 * returns the number of bytes in a 0x0000
				 * terminated string. */
    size_t refCount;		/* Number of uses of this structure. */
    Tcl_HashEntry *hPtr;	/* Hash table entry that owns this encoding. */
} Encoding;

/*
 * The following structure is the clientData for a dynamically-loaded,
 * table-driven encoding created by LoadTableEncoding(). It maps between
 * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
................................................................................
    Tcl_Encoding encoding)
{
    Encoding *encodingPtr = (Encoding *) encoding;

    if (encodingPtr == NULL) {
	return;
    }



    if (encodingPtr->refCount-- <= 1) {

	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	ckfree(encodingPtr->name);

Changes to generic/tclIO.c.

7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SeekOld, Tcl_TellOld --
 *
 *	Backward-compatability versions of the seek/tell interface that do not
 *	support 64-bit offsets. This interface is not documented or expected
 *	to be supported indefinitely.
 *
 * Results:
 *	As for Tcl_Seek and Tcl_Tell respectively, except truncated to
 *	whatever value will fit in an 'int'.
 *






|







7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SeekOld, Tcl_TellOld --
 *
 *	Backward-compatibility versions of the seek/tell interface that do not
 *	support 64-bit offsets. This interface is not documented or expected
 *	to be supported indefinitely.
 *
 * Results:
 *	As for Tcl_Seek and Tcl_Tell respectively, except truncated to
 *	whatever value will fit in an 'int'.
 *

Changes to generic/tclInt.h.

4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
 * but we don't do that at the moment since this is purely about efficiency.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclIsPureByteArray(objPtr) \
	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:






|
<







4423
4424
4425
4426
4427
4428
4429
4430

4431
4432
4433
4434
4435
4436
4437
 * but we don't do that at the moment since this is purely about efficiency.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:

Changes to generic/tclInterp.c.

406
407
408
409
410
411
412

413
414
415
416
417
418
419
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"

"	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
"	{\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
"	if {[info exists tcl_libPath]\n"
"		&& [catch {llength $tcl_libPath} len] == 0} {\n"
"	    for {set i 0} {$i < $len} {incr i} {\n"
"		lappend scripts [list lindex \\$tcl_libPath $i]\n"






>







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"
"	{file join $grandParentDir tcl[info tclversion] library} \\\n"
"	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
"	{\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
"	if {[info exists tcl_libPath]\n"
"		&& [catch {llength $tcl_libPath} len] == 0} {\n"
"	    for {set i 0} {$i < $len} {incr i} {\n"
"		lappend scripts [list lindex \\$tcl_libPath $i]\n"

Changes to generic/tclStringObj.c.

1861
1862
1863
1864
1865
1866
1867








1868
1869
1870
1871
1872
1873
1874
....
2468
2469
2470
2471
2472
2473
2474




2475
2476
2477
2478
2479
2480
2481
....
2496
2497
2498
2499
2500
2501
2502
2503
2504




2505







2506
2507
2508
2509
2510
2511
2512
....
2704
2705
2706
2707
2708
2709
2710
2711

2712
2713
2714
2715
2716
2717
2718
2719
....
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
....
2927
2928
2929
2930
2931
2932
2933
2934

2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949

2950
2951
2952
2953
2954
2955
2956
2957
		format += step;
		step = Tcl_UtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
	    } else {
		useWide = 1;
#endif
	    }








	}

	format += step;
	span = format;

	/*
	 * Step 6. The actual conversion character.
................................................................................
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    (long) va_arg(argList, int)));
		    break;
		case 1:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    va_arg(argList, long)));
		    break;




		}
		break;
	    case 'e':
	    case 'E':
	    case 'f':
	    case 'g':
	    case 'G':
................................................................................
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
	    /* TODO: support for wide (and bignum?) arguments */
	    case 'l':




		size = 1;







		p++;
		break;
	    case 'h':
		size = -1;
	    default:
		p++;
	    }
................................................................................
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %lu bytes",

			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
................................................................................
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way
	 * to handle failure to allocate enough space. Following
	 * stanza may panic.
	 */ 
	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
................................................................................

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %lu bytes",

			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %lu bytes",

			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {






>
>
>
>
>
>
>
>







 







>
>
>
>







 







|

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







 







|
>
|







 







|







 







|
>
|













|
>
|







1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
....
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
....
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
....
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
....
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
....
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
		format += step;
		step = Tcl_UtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
	    } else {
		useWide = 1;
#endif
	    }
	} else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) {
	    format += (step + 2);
	    step = Tcl_UtfToUniChar(format, &ch);
	    useBig = 1;
	} else if (ch == 'L') {
	    format += step;
	    step = Tcl_UtfToUniChar(format, &ch);
	    useBig = 1;
	}

	format += step;
	span = format;

	/*
	 * Step 6. The actual conversion character.
................................................................................
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    (long) va_arg(argList, int)));
		    break;
		case 1:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    va_arg(argList, long)));
		    break;
		case 2:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
			    va_arg(argList, Tcl_WideInt)));
		    break;
		}
		break;
	    case 'e':
	    case 'E':
	    case 'f':
	    case 'g':
	    case 'G':
................................................................................
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
	    /* TODO: support for bignum arguments */
	    case 'l':
		++size;
		p++;
		break;
	    case 'L':
		size = 2;
		p++;
		break;
	    case 'I':
		if (p[1]=='6' && p[2]=='4') {
		    p += 2;
		    size = 2;
		}
		p++;
		break;
	    case 'h':
		size = -1;
	    default:
		p++;
	    }
................................................................................
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %"
			TCL_LL_MODIFIER "u bytes",
			(Tcl_WideUInt)STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
................................................................................
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way
	 * to handle failure to allocate enough space. Following
	 * stanza may panic.
	 */
	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
................................................................................

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_LL_MODIFIER "u bytes",
			(Tcl_WideUInt)STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_LL_MODIFIER "u bytes",
			(Tcl_WideUInt)STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {

Changes to generic/tclStringRep.h.

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
    (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:
 */






|



|

|

|

|












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
    (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", \
		      (int)STRING_MAXCHARS);					\
	}								\
    } while (0)
#define stringAttemptAlloc(numChars) \
    (String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), 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.

313
314
315
316
317
318
319



320
321
322
323
324
325
326
...
644
645
646
647
648
649
650


651
652
653
654
655
656
657
....
3812
3813
3814
3815
3816
3817
3818





































3819
3820
3821
3822
3823
3824
3825
			    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_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,
................................................................................
    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






>
>
>







 







>
>







 







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







313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
...
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
....
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
			    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		TestprintObjCmd(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_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, "testprint", TestprintObjCmd,
	    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,
................................................................................
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    iPtr->packagePrefer = PKG_PREFER_STABLE;
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestprintObjCmd --
 *
 *	This procedure implements the "testprint" command.  It is
 *	used for being able to test the Tcl_ObjPrintf() function.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestprintObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_WideInt argv1 = 0;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");   
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --
 *
 *	This procedure implements the "testregexp" command. It is used to give

Changes to generic/tclVar.c.

2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatability reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);






|







2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);

Changes to library/http/http.tcl.

1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
    if {$http(-urlencoding) ne ""} {
	set string [encoding convertto $http(-urlencoding) $string]
	return [string map $formMap $string]
    }
    set converted [string map $formMap $string]
    if {[string match "*\[\u0100-\uffff\]*" $converted]} {
	regexp "\[\u0100-\uffff\]" $converted badChar
	# Return this error message for maximum compatability... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}

# http::ProxyRequired --






|







1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
    if {$http(-urlencoding) ne ""} {
	set string [encoding convertto $http(-urlencoding) $string]
	return [string map $formMap $string]
    }
    set converted [string map $formMap $string]
    if {[string match "*\[\u0100-\uffff\]*" $converted]} {
	regexp "\[\u0100-\uffff\]" $converted badChar
	# Return this error message for maximum compatibility... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}

# http::ProxyRequired --

Changes to tests/fCmd.test.

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
...
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
catch [list package require -exact Tcltest [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint win2000orXP 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
    catch {
	# Is the registry extension already static to this shell?
	try {
................................................................................
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
        if {$major > 5} {
            testConstraint winVista 1
        } elseif {$major == 5} {
            testConstraint win2000orXP 1
        }
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
................................................................................
    testchmod 0o444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win win2000orXP testchmod} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
................................................................................
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {win win2000orXP testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}






|







 







<
|
|
|
|
<







 







|







 







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
62
63
64
65
66
67
68

69
70
71
72

73
74
75
76
77
78
79
...
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
...
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
catch [list package require -exact Tcltest [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winXP 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
    catch {
	# Is the registry extension already static to this shell?
	try {
................................................................................
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]

    if {$major > 5} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 1

    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
................................................................................
    testchmod 0o444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win testchmod} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
................................................................................
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {win winXP testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}

Changes to tests/registry.test.

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
...
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "baz\u00c7bar blat"
test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
................................................................................
} 1
test registry-6.17 {GetValue: Unicode value names} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} foobar
test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "foo ba\u30b7r baz"
test registry-6.19 {GetValue: values with Unicode strings} {win reg english} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
................................................................................
} "foo ba\u00c7r baz"
test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "foo ba r baz"
test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} [string repeat x 16383]

test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
................................................................................
} -returnCodes error -result {bad key "\foobar": must start with a valid root}
test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\\\
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
    registry values \\\\\\HKEY_CLASSES_ROOT
} -returnCodes error -result {unable to open key: The network address is invalid.}
test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\gaspode
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values foobar






|







 







|







 







|







 







|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
...
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "baz\u00c7bar blat"
test registry-4.8 {GetKeyNames: Unicode} {win reg} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
................................................................................
} 1
test registry-6.17 {GetValue: Unicode value names} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} foobar
test registry-6.18 {GetValue: values with Unicode strings} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "foo ba\u30b7r baz"
test registry-6.19 {GetValue: values with Unicode strings} {win reg english} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
................................................................................
} "foo ba\u00c7r baz"
test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "foo ba r baz"
test registry-6.21 {GetValue: very long value names and values} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} [string repeat x 16383]

test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
................................................................................
} -returnCodes error -result {bad key "\foobar": must start with a valid root}
test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\\\
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body {
    registry values \\\\\\HKEY_CLASSES_ROOT
} -returnCodes error -result {unable to open key: The network address is invalid.}
test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values \\\\gaspode
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body {
    registry values foobar

Changes to tests/util.test.

16
17
18
19
20
21
22

23
24
25
26
27
28
29
....
4012
4013
4014
4015
4016
4017
4018
























4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint controversialNaN 1
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]


# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
................................................................................
    0x43fffffffffffffd 0xc3fffffffffffffd
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000
}]

























set ::tcl_precision $saved_precision

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:






>







 







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










16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
....
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint controversialNaN 1
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
testConstraint testprint [llength [info commands testprint]]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
................................................................................
    0x43fffffffffffffd 0xc3fffffffffffffd
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000
}]

test util-18.1 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr 2**63-1]
} {9223372036854775807}

test util-18.2 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr 2**63-1]
} {9223372036854775807}

test util-18.3 {Tcl_ObjPrintf} {testprint} {
    testprint %Ld [expr 2**63-1]
} {9223372036854775807}

test util-18.4 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr -2**63]
} {-9223372036854775808}

test util-18.5 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr -2**63]
} {-9223372036854775808}

test util-18.6 {Tcl_ObjPrintf} {testprint} {
    testprint %Ld [expr -2**63]
} {-9223372036854775808}

set ::tcl_precision $saved_precision

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/winFCmd.test.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
...
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
...
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
...
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
...
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
...
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
...
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
....
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
....
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
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint win2000orXP 0
testConstraint winOlderThan2000 0
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
testConstraint testchmod      [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0

................................................................................
	}
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint winOnly]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
        if {$major > 5} {
            testConstraint winVista 1
        } elseif {$major == 5} {
            testConstraint win2000orXP 1
        }
    } else {
	testConstraint winOlderThan2000 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
    foreach p [glob -nocomplain -type f -directory $dir *] {
................................................................................
    set fd [open tf2 w]
    testfile mv tf1 tf2
} -cleanup {
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EACCES
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EEXIST
test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
................................................................................
test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EACCES
test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    # under 95, this would actually succeed and move the current dir out from
    # under the current process!
    file delete /tf1
    testfile mv [pwd] /tf1
} -returnCodes error -result EACCES
test winFCmd-1.21 {TclpRenameFile: long src} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv $longname tf1
................................................................................
    createfile tf1
    testfile cp tf1 ""
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win win2000orXP testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EINVAL
test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win nt winOlderThan2000 testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EACCES
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile cp tf1 tf2
    list [contents tf1] [contents tf2]
} -cleanup {
................................................................................
    close $fd
    catch {testchmod 0o666 tf1}
    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mkdir td1
} -cleanup {
    cleanup
................................................................................
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
................................................................................
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
	{win emptyTest} {
    # can't make it happen
} {}
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
    cleanup
................................................................................
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {win nt testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
    # Windows7 returns EEXIST, XP returns EACCES
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} -setup {
................................................................................
    cleanup
} -result {./td1}
test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
    list [file attributes / -longname] [file attributes \\ -longname]
} -constraints {win} -result {/ /}
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
    catch {file delete -force -- c:/td1}
} -constraints {win win2000orXP} -body {
    createfile c:/td1 {}
    string tolower [file attributes c:/td1 -longname]
} -cleanup {
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.7 {ConvertFileNameFormat} -body {
    string tolower [file attributes //bisque/tcl/ws -longname]
................................................................................
test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
    file normalize cOm1
} -result COM1
test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
} -result COM1

test winFCmd-19.1 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.2 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/../windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list tcl[pid].tmp]]
test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list "tcl[pid].tmp "]]

test winFCmd-19.9 {Windows devices path names} -constraints nt -body {
    file normalize //./com1
} -result //./com1


# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
#foreach source {tef ted tnf tnd "" nul com1} {






|
<







 







|

<
|
|
|
|
<
<
<







 







|


<
<
<
<
<


|







 







|


<
<
<
<
<


|
<
<







 







|


<
<
<
<
<







 







|







 







|







 







|







 







|







 







|







 







|


|


|










|










|










|










|










|











|







17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
..
51
52
53
54
55
56
57
58
59

60
61
62
63



64
65
66
67
68
69
70
...
196
197
198
199
200
201
202
203
204
205





206
207
208
209
210
211
212
213
214
215
...
224
225
226
227
228
229
230
231
232
233





234
235
236


237
238
239
240
241
242
243
...
437
438
439
440
441
442
443
444
445
446





447
448
449
450
451
452
453
...
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
...
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
...
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
...
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
....
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
....
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
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
1407
1408
1409
1410
1411
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint winXP 0

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
testConstraint testchmod      [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0

................................................................................
	}
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]

    if {$major > 5} {
	testConstraint winVista 1
    } elseif {$major == 5} {
	testConstraint winXP 1



    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
    foreach p [glob -nocomplain -type f -directory $dir *] {
................................................................................
    set fd [open tf2 w]
    testfile mv tf1 tf2
} -cleanup {
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL





test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EEXIST
test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
................................................................................
test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL





test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    cleanup
} -constraints {win testfile} -body {


    file delete /tf1
    testfile mv [pwd] /tf1
} -returnCodes error -result EACCES
test winFCmd-1.21 {TclpRenameFile: long src} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv $longname tf1
................................................................................
    createfile tf1
    testfile cp tf1 ""
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile cp nul tf1
} -returnCodes error -result EINVAL





test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile cp tf1 tf2
    list [contents tf1] [contents tf2]
} -cleanup {
................................................................................
    close $fd
    catch {testchmod 0o666 tf1}
    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mkdir td1
} -cleanup {
    cleanup
................................................................................
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod} -body {
................................................................................
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
} -constraints {win cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
	{win emptyTest} {
    # can't make it happen
} {}
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
    cleanup
................................................................................
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
    # Windows7 returns EEXIST, XP returns EACCES
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} -setup {
................................................................................
    cleanup
} -result {./td1}
test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
    list [file attributes / -longname] [file attributes \\ -longname]
} -constraints {win} -result {/ /}
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
    catch {file delete -force -- c:/td1}
} -constraints {win winXP} -body {
    createfile c:/td1 {}
    string tolower [file attributes c:/td1 -longname]
} -cleanup {
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.7 {ConvertFileNameFormat} -body {
    string tolower [file attributes //bisque/tcl/ws -longname]
................................................................................
test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
    file normalize cOm1
} -result COM1
test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
} -result COM1

test winFCmd-19.1 {Windows extended path names} -constraints win -body {
    file normalize //?/c:/windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.2 {Windows extended path names} -constraints win -body {
    file normalize //?/c:/windows/../windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.3 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.4 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.5 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.6 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.7 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list tcl[pid].tmp]]
test winFCmd-19.8 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list "tcl[pid].tmp "]]

test winFCmd-19.9 {Windows devices path names} -constraints win -body {
    file normalize //./com1
} -result //./com1


# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
#foreach source {tef ted tnf tnd "" nul com1} {

Changes to tests/winFile.test.

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
...
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
namespace import -force ::tcltest::*

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0
testConstraint win2000 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
    testConstraint win2000 1
}

test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
} -match glob -result *
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob [email protected]}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
    makeFile {} GlobCapS
    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]
} -cleanup {
................................................................................
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win nt notNTFS win2000
} -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    # Clean out all well-known ACLs
    catch {cacls $fname /E /R "Everyone"} result
    catch {cacls $fname /E /R $user} result
................................................................................
    catch {cacls $fname /E /R $owner} result
    cacls $fname /E /P $user:N
    test_access $fname 0 0
} -result {}
test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
} -constraints {
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    test_access $fname 1 0
} -result {}
test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
} -constraints {
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:W
    test_access $fname 0 1
} -result {}
test winFile-4.3 {
    Enhanced NTFS user/group permissions: test read+write
} -constraints {
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    cacls $fname /E /G $user:W
    test_access $fname 1 1
} -result {}
test winFile-4.4 {
    Enhanced NTFS user/group permissions: test full access
} -constraints {
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:F
    test_access $fname 1 1






<




<
<
<




|



|







 







|







 







|










|











|












|







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
...
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
namespace import -force ::tcltest::*

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0


if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}




test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
} -match glob -result *
test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
    catch {glob [email protected]}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
    makeFile {} GlobCapS
    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]
} -cleanup {
................................................................................
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS
} -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    # Clean out all well-known ACLs
    catch {cacls $fname /E /R "Everyone"} result
    catch {cacls $fname /E /R $user} result
................................................................................
    catch {cacls $fname /E /R $owner} result
    cacls $fname /E /P $user:N
    test_access $fname 0 0
} -result {}
test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    test_access $fname 1 0
} -result {}
test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:W
    test_access $fname 0 1
} -result {}
test winFile-4.3 {
    Enhanced NTFS user/group permissions: test read+write
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    cacls $fname /E /G $user:W
    test_access $fname 1 1
} -result {}
test winFile-4.4 {
    Enhanced NTFS user/group permissions: test full access
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:F
    test_access $fname 1 1

Changes to tests/winPipe.test.

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
    exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
	{win cat32 AllocConsole} {
    # would block waiting for human input
} {}
................................................................................
    puts $f \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
    proc readResults {f} {
	global x result
	if { [eof $f] } {
	    close $f
	    set x 1
	} else {
	    set line [read $f ]






|



|







 







|







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
    exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win exec cat32} {
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
	{win cat32 AllocConsole} {
    # would block waiting for human input
} {}
................................................................................
    puts $f \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
    proc readResults {f} {
	global x result
	if { [eof $f] } {
	    close $f
	    set x 1
	} else {
	    set line [read $f ]

Changes to unix/tcl.m4.

2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
#	Check for broken function.
#
# Arguments:
#	funcName - function to test for
#	advancedTest - the advanced test to run if the function is present
#
# Results:
#	Might cause compatability versions of the function to be used.
#	Might affect the following vars:
#		USE_COMPAT	(implicit)
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[
    AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0)






|







2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
#	Check for broken function.
#
# Arguments:
#	funcName - function to test for
#	advancedTest - the advanced test to run if the function is present
#
# Results:
#	Might cause compatibility versions of the function to be used.
#	Might affect the following vars:
#		USE_COMPAT	(implicit)
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[
    AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0)

Changes to win/makefile.vc.

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#		above may be used (comma separated).  'none' will over-ride
#		everything to nothing.
#
#		compdbg  = Enables byte compilation logging.
#		memdbg   = Enables the debugging memory allocator.
#
#	CHECKS=64bit,fullwarn,nodep,none
#		Sets special macros for checking compatability.
#
#		64bit    = Enable 64bit portability warnings (if available)
#		fullwarn = Builds with full compiler and link warnings enabled.
#			    Very verbose.
#		nodep	 = Turns off compatability macros to ensure the core
#			    isn't being built with deprecated functions.
#
#	MACHINE=(ALPHA|AMD64|IA64|IX86)
#		Set the machine type used for the compiler, linker, and
#		resource compiler.  This hook is needed to tell the tools
#		when alternate platforms are requested.  IX86 is the default
#		when not specified. If the CPU environment variable has been






|




|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#		above may be used (comma separated).  'none' will over-ride
#		everything to nothing.
#
#		compdbg  = Enables byte compilation logging.
#		memdbg   = Enables the debugging memory allocator.
#
#	CHECKS=64bit,fullwarn,nodep,none
#		Sets special macros for checking compatibility.
#
#		64bit    = Enable 64bit portability warnings (if available)
#		fullwarn = Builds with full compiler and link warnings enabled.
#			    Very verbose.
#		nodep	 = Turns off compatibility macros to ensure the core
#			    isn't being built with deprecated functions.
#
#	MACHINE=(ALPHA|AMD64|IA64|IX86)
#		Set the machine type used for the compiler, linker, and
#		resource compiler.  This hook is needed to tell the tools
#		when alternate platforms are requested.  IX86 is the default
#		when not specified. If the CPU environment variable has been