Tcl Source Code

Check-in [4ab23eded7]
Login

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

Overview
Comment:Merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | amg-array-enum-c-api
Files: files | file ages | folders
SHA1: 4ab23eded78d52c87f61ef4807b7924df973404e
User & Date: andy 2016-12-02 21:00:11
Context
2016-12-02
21:18
Merge trunk check-in: 02df281049 user: andy tags: amg-array-enum-c-api
21:00
Merge trunk check-in: 4ab23eded7 user: andy tags: amg-array-enum-c-api
20:50
Experiment with wrapping [::tcltest::test] check-in: 297167a9bf user: andy tags: amg-array-enum-c-api
18:18
Added long comment explaining history and work in progress making bytearray interfaces usable. check-in: d42a114238 user: dgp tags: trunk
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
	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.








|







843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	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.

3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
	[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):







|







3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
	[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):
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789

	+----------------------+
	| 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]







|







3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789

	+----------------------+
	| 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
	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







|







943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
	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
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288

	* 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.








|







1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288

	* 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.

1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
 * 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)







|

|







1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
 * 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
    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.







<
<
<
<
<
<
<







3019
3020
3021
3022
3023
3024
3025







3026
3027
3028
3029
3030
3031
3032
    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.
3048
3049
3050
3051
3052
3053
3054








3055
3056
3057
3058
3059
3060
3061
	 * 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







>
>
>
>
>
>
>
>







3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
	 * 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
3150
3151
3152
3153
3154
3155
3156







3157
3158
3159
3160
3161
3162
3163
     * 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.







>
>
>
>
>
>
>







3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
     * 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
    { "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







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

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

>
>
>
>
>
>
>
>





|







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






214
215
216
217
218
219
220
#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







>
>
>
>
>
>







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
#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
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
    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 --







|







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
    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 --
367
368
369
370
371
372
373

374
375
376
377
378
379
380
381
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;
    }







>
|







446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
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;
    }
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
    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;







>
|







490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
    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;
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
 */

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 --







|





>
>
>
|
>
>
>
|
|

|
|
|
>
|
|

|
|

|
|
|
<







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

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 --
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

    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 --
 *







|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632

    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 --
 *
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652
	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);
    }







>
|







725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
	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/tclCmdMZ.c.

2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
static int
StringReptCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1;
    char *string2;
    int count, index, length1, length2;
    Tcl_Obj *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string count");
	return TCL_ERROR;
    }

    if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for cases that allow us to skip copying stuff.
     */

    if (count == 1) {
	Tcl_SetObjResult(interp, objv[1]);
	goto done;
    } else if (count < 1) {
	goto done;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    if (length1 <= 0) {
	goto done;
    }

    /*
     * Only build up a string that has data. Instead of building it up with
     * repeated appends, we just allocate the necessary space once and copy
     * the string value in.
     *
     * We have to worry about overflow [Bugs 714106, 2561746].
     * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
     * We need to keep 2 <= length2 <= INT_MAX.
     */

    if (count > INT_MAX/length1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"result exceeds max size for a Tcl value (%d bytes)",
		INT_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    length2 = length1 * count;

    /*
     * Include space for the NUL.
     */

    string2 = attemptckalloc((unsigned) length2 + 1);
    if (string2 == NULL) {
	/*
	 * Alloc failed. Note that in this case we try to do an error message
	 * since this is a case that's most likely when the alloc is large and
	 * that's easy to do with this API. Note that if we fail allocating a
	 * short string, this will likely keel over too (and fatally).
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"string size overflow, out of memory allocating %u bytes",
		length2 + 1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    for (index = 0; index < count; index++) {
	memcpy(string2 + (length1 * index), string1, (size_t) length1);
    }
    string2[length2] = '\0';

    /*
     * We have to directly assign this instead of using Tcl_SetStringObj (and
     * indirectly TclInitStringRep) because that makes another copy of the
     * data.
     */

    TclNewObj(resultPtr);
    resultPtr->bytes = string2;
    resultPtr->length = length2;
    Tcl_SetObjResult(interp, resultPtr);

  done:
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringRplcCmd --







<
<
|

















|

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

<

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


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

<
<







2114
2115
2116
2117
2118
2119
2120


2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140






















2141
2142

2143



2144













2145
2146














2147


2148
2149
2150
2151
2152
2153
2154
static int
StringReptCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{


    int count;
    Tcl_Obj *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string count");
	return TCL_ERROR;
    }

    if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for cases that allow us to skip copying stuff.
     */

    if (count == 1) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    } else if (count < 1) {






















	return TCL_OK;
    }





    if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {













	return TCL_ERROR;
    }














    Tcl_SetObjResult(interp, resultPtr);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringRplcCmd --

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.

3143
3144
3145
3146
3147
3148
3149


3150
3151
3152
3153
3154
3155
3156
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);


MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr,







>
>







3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, Tcl_Obj **objPtrPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, Tcl_Parse *parsePtr,
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
 * 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/tclStringObj.c.

2468
2469
2470
2471
2472
2473
2474




2475
2476
2477
2478
2479
2480
2481
		    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':







>
>
>
>







2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
		    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':
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
		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++;
	    }







|

|







2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
	    /* TODO: support for bignum arguments */
	    case 'l':
		++size;
		p++;
		break;
	    case 'h':
		size = -1;
	    default:
		p++;
	    }
2605
2606
2607
2608
2609
2610
2611












































































































































2612
2613
2614
2615
2616
2617
2618
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}













































































































































/*
 *---------------------------------------------------------------------------
 *
 * TclStringCatObjv --
 *
 *	Performs the [string cat] function.







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







2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringRepeat --
 *
 *	Performs the [string repeat] function.
 *
 * Results:
 * 	A standard Tcl result.
 *
 * Side effects:
 * 	Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
 * 	of count copies of the value in objPtr.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int count,
    Tcl_Obj **objPtrPtr)
{
    Tcl_Obj *objResultPtr;
    int length = 0, unichar = 0, done = 1;
    int binary = TclIsPureByteArray(objPtr);

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    if (!binary) {
	if (objPtr->typePtr == &tclStringType) {
	    String *stringPtr = GET_STRING(objPtr);
	    if (stringPtr->hasUnicode) {
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	Tcl_GetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	Tcl_GetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	Tcl_GetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	*objPtrPtr = objPtr;
	return TCL_OK;
    }

    if (count > INT_MAX/length) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return TCL_ERROR;
    }

    if (binary) {
	/* Efficiently produce a pure byte array result */
	objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr)
		: objPtr;

	Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
	Tcl_SetByteArrayLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendBytesToByteArray(objResultPtr,
		Tcl_GetByteArrayFromObj(objResultPtr, NULL),
		(count - done) * length);
    } else if (unichar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	if (Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %llu 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);
	    done *= 2;
	}
	Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
		(count - done) * length);
    } else {
	/* Efficiently concatenate string reps */
	if (Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
	} else {
	    TclFreeIntRep(objPtr);
	    objResultPtr = objPtr;
	}
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr),
		(count - done) * length);
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCatObjv --
 *
 *	Performs the [string cat] function.
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
	/* 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 {







|







2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
	/* 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 {
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817

	    /* 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--) {







|
|













|
|







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
2958
2959
2960
2961

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







|



|

|

|

|







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

Changes to generic/tclVar.c.

1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
		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, dictPtr,
		&elemLen, &elemPtrs);







|







1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
		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, dictPtr,
		&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 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