Tcl Source Code

Check-in [933afe0b2e]
Login

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

Overview
Comment:merge trunk; update changes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-1-rc
Files: files | file ages | folders
SHA1: 933afe0b2e2ca569e18614c8e1ce5bdb41eec13f
User & Date: dgp 2013-09-16 18:59:14
Context
2013-09-17
12:17
merge trunk; update changes check-in: fa66765e6a user: dgp tags: rc1, core-8-6-1-rc
2013-09-16
18:59
merge trunk; update changes check-in: 933afe0b2e user: dgp tags: core-8-6-1-rc
2013-09-13
14:12
merge mark check-in: 15cf5b6ebb user: dgp tags: trunk
2013-09-03
18:50
doc fix exposed by `make html` check-in: 41dfc40c2a user: dgp tags: rc0, core-8-6-1-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.










1


2
3
4
5
6
7
8
9
10
11












12
13
14
15
16
17
18









2013-08-30  Don Porter  <[email protected]>



	* generic/tcl.h:	Bump version number to 8.6.1.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:













2013-08-03  Donal Fellows  <[email protected]>

	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
	by the autoloading mechanism.

2013-08-02  Donal Fellows  <[email protected]>
>
>
>
>
>
>
>
>
>
|
>
>










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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
A NOTE ON THE CHANGELOG:
Starting in early 2011, Tcl source code has been under the management of
fossil, hosted at http://core.tcl.tk/tcl/ .  Fossil presents a "Timeline"
view of changes made that is superior in every way to a hand edited log file.
Because of this, many Tcl developers are now out of the habit of maintaining
this log file.  You may still find useful things in it, but the Timeline is
a better first place to look now.
============================================================================

2013-09-16  Don Porter  <[email protected]>

	*** 8.6.1 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump version number to 8.6.1.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2013-09-09  Donal Fellows  <[email protected]>

	* generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
	the internal representation of method bodies during cloning in order
	to ensure that any bound references to instance variables are removed.

2013-09-01  Donal Fellows  <[email protected]>

	* generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that
	whitespace at the end of a string don't cause the decoder to drop the
	last decoded byte.

2013-08-03  Donal Fellows  <[email protected]>

	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
	by the autoloading mechanism.

2013-08-02  Donal Fellows  <[email protected]>

Changes to changes.

8286
8287
8288
8289
8290
8291
8292




8293
8294
8295

2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)

2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)

2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)





Many optmizations, improvements, and tightened stack management in bytecode.

--- Released 8.6.1, Septemer 18, 2013 --- http://core.tcl.tk/tcl/ for details 







>
>
>
>


|
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299

2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)

2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)

2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)

2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter)

2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows)

Many optmizations, improvements, and tightened stack management in bytecode.

--- Released 8.6.1, Septemer 19, 2013 --- http://core.tcl.tk/tcl/ for details 

Changes to generic/tclBasic.c.

2171
2172
2173
2174
2175
2176
2177
2178

2179
2180
2181
2182
2183
2184
2185
 *
 * Results:
 *	The return value is a token for the command, which can be used in
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If a command named "cmdName" already exists for interp, it is
 * 	first deleted.  Then the new command is created from the arguments.

 *
 *	In the future, during bytecode evaluation when "cmdName" is seen as
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *







|
>







2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
 *
 * Results:
 *	The return value is a token for the command, which can be used in
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If a command named "cmdName" already exists for interp, it is
 *	first deleted.  Then the new command is created from the arguments.
 *	[***] (See below for exception).
 *
 *	In the future, during bytecode evaluation when "cmdName" is seen as
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
2237
2238
2239
2240
2241
2242
2243
2244


2245

















2246
2247
2248
2249
2250
2251
2252
2253
	tail = cmdName;
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    TclInvalidateNsPath(nsPtr);
    if (!isNew) {
	cmdPtr = Tcl_GetHashValue(hPtr);



	/*

















	 * Command already exists; delete it. Be careful to preserve any
	 * existing import links so we can restore them down below. That way,
	 * you can redefine a command and its import status will remain
	 * intact.
	 */

	oldRefPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = NULL;








>
>

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







2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
	tail = cmdName;
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    TclInvalidateNsPath(nsPtr);
    if (!isNew) {
	cmdPtr = Tcl_GetHashValue(hPtr);

	/* Command already exists. */

	/*
	 * [***] This is wrong.  See Tcl Bug a16752c252.  
	 * However, this buggy behavior is kept under particular
	 * circumstances to accommodate deployed binaries of the
	 * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
	 * that crash if the bug is fixed.
	 */

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
	    cmdPtr->objClientData = clientData;
	    return (Tcl_Command) cmdPtr;
	}

	/*
	 * Otherwise, we delete the old command. Be careful to preserve any
	 * existing import links so we can restore them down below. That way,
	 * you can redefine a command and its import status will remain
	 * intact.
	 */

	oldRefPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = NULL;
4675
4676
4677
4678
4679
4680
4681









4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707

4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727









4728
4729

4730
4731
4732
4733
4734
4735
4736
	traceCode = TclCheckExecutionTraces(interp, command, length,
		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
    }
    newEpoch = cmdPtr->cmdEpoch;
    TclCleanupCommandMacro(cmdPtr);

    if (traceCode != TCL_OK) {









	return traceCode;
    }
    if (cmdEpoch != newEpoch) {
	*cmdPtrPtr = NULL;
    }
    return TCL_OK;
}

static int
TEOV_RunLeaveTraces(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];


    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	int length;
	const char *command = Tcl_GetStringFromObj(commandPtr, &length);


	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
    }
    Tcl_DecrRefCount(commandPtr);

    /*
     * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
     * Prevent that by resetting the cmdPtr field and dealing right here with
     * cmdPtr->refCount.
     */

    TclCleanupCommandMacro(cmdPtr);

    if (traceCode != TCL_OK) {









	return traceCode;
    }

    return result;
}

static inline Command *
TEOV_LookupCmdFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *namePtr,







>
>
>
>
>
>
>
>
>




















<
<
<
|
|

>









<










>
>
>
>
>
>
>
>
>
|

>







4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730



4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743

4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
	traceCode = TclCheckExecutionTraces(interp, command, length,
		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
    }
    newEpoch = cmdPtr->cmdEpoch;
    TclCleanupCommandMacro(cmdPtr);

    if (traceCode != TCL_OK) {
	if (traceCode == TCL_ERROR) {
	    Tcl_Obj *info;

	    TclNewLiteralStringObj(info, "\n    (enter trace on \"");
	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
	    Tcl_AppendToObj(info, "\")", 2);
	    Tcl_AppendObjToErrorInfo(interp, info);
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	}
	return traceCode;
    }
    if (cmdEpoch != newEpoch) {
	*cmdPtrPtr = NULL;
    }
    return TCL_OK;
}

static int
TEOV_RunLeaveTraces(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];



    int length;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
    }


    /*
     * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
     * Prevent that by resetting the cmdPtr field and dealing right here with
     * cmdPtr->refCount.
     */

    TclCleanupCommandMacro(cmdPtr);

    if (traceCode != TCL_OK) {
	if (traceCode == TCL_ERROR) {
	    Tcl_Obj *info;

	    TclNewLiteralStringObj(info, "\n    (leave trace on \"");
	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
	    Tcl_AppendToObj(info, "\")", 2);
	    Tcl_AppendObjToErrorInfo(interp, info);
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	}
	result = traceCode;
    }
    Tcl_DecrRefCount(commandPtr);
    return result;
}

static inline Command *
TEOV_LookupCmdFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *namePtr,

Changes to generic/tclBinary.c.

2382
2383
2384
2385
2386
2387
2388
2389
2390

2391


2392
2393
2394
2395
2396
2397
2398

2399
2400
2401
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i=0 ; i<2 ; i++) {
	    if (data < dataend) {
		c = *data++;




		if (!isxdigit((int) c)) {
		    if (strict || !isspace(c)) {
			goto badChar;
		    }
		    i--;
		    continue;
		}

		value <<= 4;
		c -= '0';
		if (c > 9) {
		    c += ('0' - 'A') + 10;
		}
		if (c > 16) {
		    c += ('A' - 'a');
		}
		value |= (c & 0xf);
	    } else {

		value <<= 4;
		cut++;
	    }
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
    if (cut > size) {
	cut = size;
    }







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







2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411

2412
2413
2414

2415
2416
2417
2418
2419
2420
2421
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
		if (strict || !isspace(c)) {
		    goto badChar;
		}
		i--;
		continue;
	    }

	    value <<= 4;
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= (c & 0xf);

	}
	if (i < 2) {
	    cut++;

	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
    if (cut > size) {
	cut = size;
    }

Changes to generic/tclCompCmds.c.

2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
    int bodyRange, nextRange;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 5) {
	return TCL_ERROR;
    }








|







2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int bodyCodeOffset, nextCodeOffset, jumpDist;
    int bodyRange, nextRange;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 5) {
	return TCL_ERROR;
    }

2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the for.
     */

    testCodeOffset = CurrentOffset(envPtr);

    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
	bodyCodeOffset += 3;
	nextCodeOffset += 3;
	testCodeOffset += 3;
    }

    SetLineInformation(2);
    TclCompileExprWords(interp, testTokenPtr, 1, envPtr);

    jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
    if (jumpDist > 127) {







<
<
<
|


<







2305
2306
2307
2308
2309
2310
2311



2312
2313
2314

2315
2316
2317
2318
2319
2320
2321
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the for.
     */




    if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
	bodyCodeOffset += 3;
	nextCodeOffset += 3;

    }

    SetLineInformation(2);
    TclCompileExprWords(interp, testTokenPtr, 1, envPtr);

    jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
    if (jumpDist > 127) {

Changes to generic/tclCompExpr.c.

486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and 
				 * TclFixupForwardJump(). */
    int depth;			/* Remember the currStackDepth of the
				 * CompileEnv here. */
    int offset;			/* Data used to compute jump lengths to pass
				 * to TclFixupForwardJump() */
    int convert;		/* Temporary storage used to compute whether
				 * numeric conversion will be needed following
				 * the operator we're compiling. */
    struct JumpList *next;	/* Point to next item on the stack */
} JumpList;

/*
 * Declarations for local functions to this file:
 */








<
<
<
<
<
<
<







486
487
488
489
490
491
492







493
494
495
496
497
498
499
 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and 
				 * TclFixupForwardJump(). */







    struct JumpList *next;	/* Point to next item on the stack */
} JumpList;

/*
 * Declarations for local functions to this file:
 */

2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
    while (1) {
	int next;
	JumpList *freePtr, *newJump;

	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    switch (nodePtr->lexeme) {
	    case QUESTION:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		break;
	    }
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;







|
<
<
<
<
<
<
<
<

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







2250
2251
2252
2253
2254
2255
2256
2257








2258














2259
2260
2261
2262
2263
2264
2265
    while (1) {
	int next;
	JumpList *freePtr, *newJump;

	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    if (nodePtr->lexeme == QUESTION) {








		convert = 1;














	    }
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
2313
2314
2315
2316
2317
2318
2319



2320
2321
2322


2323
2324
2325
2326
2327
2328


2329
2330
2331
2332
2333
2334



2335

2336
2337
2338


2339
2340
2341
2342
2343
2344
2345
		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:



		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case COLON:


		CLANG_ASSERT(jumpPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->next->jump);
		envPtr->currStackDepth = jumpPtr->depth;
		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
		jumpPtr->convert = convert;


		convert = 1;
		break;
	    case AND:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case OR:



		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);

		break;
	    }
	} else {


	    switch (nodePtr->lexeme) {
	    case START:
	    case QUESTION:
		if (convert && (nodePtr == rootPtr)) {
		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
		}
		break;







>
>
>



>
>
|

|
|
<
|
>
>



<
<

>
>
>
|
>



>
>







2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302

2303
2304
2305
2306
2307
2308


2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case COLON:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->jump);
		TclAdjustStackDepth(-1, envPtr);

		if (convert) {
		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
		}
		convert = 1;
		break;
	    case AND:


	    case OR:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
		break;
	    }
	} else {
	    int pc1, pc2, target;

	    switch (nodePtr->lexeme) {
	    case START:
	    case QUESTION:
		if (convert && (nodePtr == rootPtr)) {
		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
		}
		break;
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386


2387
2388
2389



2390
2391
2392
2393
2394
2395
2396

2397
2398
2399
2400
2401
2402
2403
2404

2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
		 * Each comma implies another function argument.
		 */

		numWords++;
		break;
	    case COLON:
		CLANG_ASSERT(jumpPtr);
		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
			(envPtr->codeNext - envPtr->codeStart)
			- jumpPtr->next->jump.codeOffset, 127)) {
		    jumpPtr->offset += 3;
		}
		TclFixupForwardJump(envPtr, &jumpPtr->jump,
			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
		convert |= jumpPtr->convert;
		envPtr->currStackDepth = jumpPtr->depth + 1;


		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);



		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);

		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
			&jumpPtr->next->jump);
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->next->next->jump);
		TclAdjustStackDepth(-1, envPtr);

		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    jumpPtr->next->next->jump.codeOffset += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
			127);
		convert = 0;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;







|
<
|
|

<
|
|
<
>
>



>
>
>







>
|
|
<


|
|

>
|

|



|
|

<
<
<
<
<
<
<







2352
2353
2354
2355
2356
2357
2358
2359

2360
2361
2362

2363
2364

2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382

2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397







2398
2399
2400
2401
2402
2403
2404
		 * Each comma implies another function argument.
		 */

		numWords++;
		break;
	    case COLON:
		CLANG_ASSERT(jumpPtr);
		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {

		    jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
		    convert = 1;
		}

		target = jumpPtr->jump.codeOffset + 2;
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {

		    target += 3;
		}
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		TclFixupForwardJump(envPtr, &jumpPtr->jump,
			target - jumpPtr->jump.codeOffset, 127);

		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		pc1 = CurrentOffset(envPtr);
		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
			: INST_JUMP_TRUE1, 0, envPtr);

		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		pc2 = CurrentOffset(envPtr);
		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
		TclAdjustStackDepth(-1, envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
			envPtr->codeStart + pc1 + 1);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    pc2 += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
			envPtr->codeStart + pc2 + 1);
		convert = 0;







		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;

Changes to generic/tclOOMethod.c.

1286
1287
1288
1289
1290
1291
1292
1293


1294

































1295
1296



1297








1298
1299
1300
1301
1302
1303
1304
static int
CloneProcedureMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));




































    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;



    pm2Ptr->procPtr->refCount++;








    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
    }
    *newClientData = pm2Ptr;
    return TCL_OK;
}








|
>
>

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


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







1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
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
static int
CloneProcedureMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pm2Ptr;
    Tcl_Obj *bodyObj, *argsObj;
    CompiledLocal *localPtr;

    /*
     * Copy the argument list.
     */

    argsObj = Tcl_NewObj();
    for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *argObj = Tcl_NewObj();

	    Tcl_ListObjAppendElement(NULL, argObj,
		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
	}
    }

    /*
     * Must strip the internal representation in order to ensure that any
     * bound references to instance variables are removed. [Bug 3609693]
     */

    bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
    TclFreeIntRep(bodyObj);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;
    Tcl_IncrRefCount(argsObj);
    Tcl_IncrRefCount(bodyObj);
    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
	    &pm2Ptr->procPtr) != TCL_OK) {
	Tcl_DecrRefCount(argsObj);
	Tcl_DecrRefCount(bodyObj);
	ckfree(pm2Ptr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(argsObj);
    Tcl_DecrRefCount(bodyObj);

    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
    }
    *newClientData = pm2Ptr;
    return TCL_OK;
}


Changes to generic/tclParse.c.

9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 
#include <assert.h>
#include "tclInt.h"
#include "tclParse.h"


/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with either signed or
 * unsigned characters, so it has 384 entries. The first 128 entries
 * correspond to negative character values, the next 256 correspond to
 * positive character values. The last 128 entries are identical to the first







<


>







9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 

#include "tclInt.h"
#include "tclParse.h"
#include <assert.h>

/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with either signed or
 * unsigned characters, so it has 384 entries. The first 128 entries
 * correspond to negative character values, the next 256 correspond to
 * positive character values. The last 128 entries are identical to the first

Changes to generic/tclTest.c.

4404
4405
4406
4407
4408
4409
4410

















4411
4412

4413
4414
4415
4416
4417
4418
4419
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc > 6) {
	Tcl_SetResult(interp, "too many args", TCL_STATIC);
	return TCL_ERROR;
    }

















    Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
	    argv[5], NULL);

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetobjerrorcodeCmd --







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







4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc > 6) {
	Tcl_SetResult(interp, "too many args", TCL_STATIC);
	return TCL_ERROR;
    }
    switch (argc) {
    case 1:
	Tcl_SetErrorCode(interp, "NONE", NULL);
	break;
    case 2:
	Tcl_SetErrorCode(interp, argv[1], NULL);
	break;
    case 3:
	Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
	break;
    case 4:
	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
	break;
    case 5:
	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
	break;
    case 6:
	Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
		argv[5], NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetobjerrorcodeCmd --

Changes to generic/tclUtil.c.

3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
 */

static void
UpdateStringOfEndOffset(
    register Tcl_Obj *objPtr)
{
    char buffer[TCL_INTEGER_SPACE + 5];
    register int len;

    memcpy(buffer, "end", 4);
    len = sizeof("end") - 1;
    if (objPtr->internalRep.longValue != 0) {
	buffer[len++] = '-';
	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
    }
    objPtr->bytes = ckalloc((unsigned) len+1);
    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
    objPtr->length = len;







|


<







3576
3577
3578
3579
3580
3581
3582
3583
3584
3585

3586
3587
3588
3589
3590
3591
3592
 */

static void
UpdateStringOfEndOffset(
    register Tcl_Obj *objPtr)
{
    char buffer[TCL_INTEGER_SPACE + 5];
    register int len = 3;

    memcpy(buffer, "end", 4);

    if (objPtr->internalRep.longValue != 0) {
	buffer[len++] = '-';
	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
    }
    objPtr->bytes = ckalloc((unsigned) len+1);
    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
    objPtr->length = len;

Changes to library/auto.tcl.

508
509
510
511
512
513
514


























515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
        set name "::$name"
    }

    # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse that
    # replacement.
    return [string map [list \0 \$] $name]
}



























if {[llength $::auto_mkindex_parser::initCommands]} {
    return
}

# Register all of the procedures for the auto_mkindex parser that will build
# the "tclIndex" file.

# AUTO MKINDEX:  proc name arglist body
# Adds an entry to the auto index list for the given procedure name.

auto_mkindex_parser::command proc {name args} {
    variable index
    variable scriptFile
    # Do some fancy reformatting on the "source" call to handle platform
    # differences with respect to pathnames.  Use format just so that the
    # command is a little easier to read (otherwise it'd be full of
    # backslashed dollar signs, etc.
    append index [list set auto_index([fullname $name])] \
	    [format { [list source [file join $dir %s]]} \
	    [file split $scriptFile]] "\n"
}

# Conditionally add support for Tcl byte code files.  There are some tricky
# details here.  First, we need to get the tbcload library initialized in the
# current interpreter.  We cannot load tbcload into the slave until we have
# done so because it needs access to the tcl_patchLevel variable.  Second,
# because the package index file may defer loading the library until we invoke







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












|
<
<
<
<
<
<
<
<







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553








554
555
556
557
558
559
560
        set name "::$name"
    }

    # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse that
    # replacement.
    return [string map [list \0 \$] $name]
}

# auto_mkindex_parser::indexEntry --
#
# Used by commands like "proc" within the auto_mkindex parser to add a
# correctly-quoted entry to the index. This is shared code so it is done
# *right*, in one place.
#
# Arguments:
# name -		Name that is being added to index.

proc auto_mkindex_parser::indexEntry {name} {
    variable index
    variable scriptFile

    # We convert all metacharacters to their backslashed form, and pre-split
    # the file name that we know about (which will be a proper list, and so
    # correctly quoted).

    set name [string range [list \}[fullname $name]] 2 end]
    set filenameParts [file split $scriptFile]

    append index [format \
	    {set auto_index(%s) [list source [file join $dir %s]]%s} \
	    $name $filenameParts \n]
    return
}

if {[llength $::auto_mkindex_parser::initCommands]} {
    return
}

# Register all of the procedures for the auto_mkindex parser that will build
# the "tclIndex" file.

# AUTO MKINDEX:  proc name arglist body
# Adds an entry to the auto index list for the given procedure name.

auto_mkindex_parser::command proc {name args} {
    indexEntry $name








}

# Conditionally add support for Tcl byte code files.  There are some tricky
# details here.  First, we need to get the tbcload library initialized in the
# current interpreter.  We cannot load tbcload into the slave until we have
# done so because it needs access to the tcl_patchLevel variable.  Second,
# because the package index file may defer loading the library until we invoke
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    variable index
	    variable scriptFile
	    # Do some nice reformatting of the "source" call, to get around
	    # path differences on different platforms.  We use the format
	    # command just so that the code is a little easier to read.
	    append index [list set auto_index([fullname $name])] \
		    [format { [list source [file join $dir %s]]} \
		    [file split $scriptFile]] "\n"
	}
    }
}

# AUTO MKINDEX:  namespace eval name command ?arg arg...?
# Adds the namespace name onto the context stack and evaluates the associated
# body of commands.







|
<
<
<
<
<
<
<







573
574
575
576
577
578
579
580







581
582
583
584
585
586
587
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    indexEntry $name







	}
    }
}

# AUTO MKINDEX:  namespace eval name command ?arg arg...?
# Adds the namespace name onto the context stack and evaluates the associated
# body of commands.
606
607
608
609
610
611
612







613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630




631
632
633
634
            catch {$parser eval "_%@namespace import $args"}
        }
	ensemble {
	    variable parser
	    variable contextStack
	    if {[lindex $args 0] eq "create"} {
		set name ::[join [lreverse $contextStack] ::]







		# create artifical proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?
# Adds an entry to the auto index list for the given class name.
foreach cmd {oo::class class} {
    auto_mkindex_parser::command $cmd {ecmd name {body ""}} {
	if {$cmd eq "create"} {
	    variable index
	    variable scriptFile
	    append index [format "set %s \[list source \[%s]]\n" \
			      [list auto_index([fullname $name])] \
			      [list file join $dir {*}[file split $scriptFile]]]
	}




    }
}

return







>
>
>
>
>
>
>









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




617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639

640
641
642




643
644
645
646
647
648
649
650
651
            catch {$parser eval "_%@namespace import $args"}
        }
	ensemble {
	    variable parser
	    variable contextStack
	    if {[lindex $args 0] eq "create"} {
		set name ::[join [lreverse $contextStack] ::]
		catch {
		    set name [dict get [lrange $args 1 end] -command]
		    if {![string match ::* $name]} {
			set name ::[join [lreverse $contextStack] ::]$name
		    }
		    regsub -all ::+ $name :: name
		}
		# create artifical proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?
# Adds an entry to the auto index list for the given class name.

auto_mkindex_parser::command oo::class {op name {body ""}} {
    if {$op eq "create"} {
	indexEntry $name




    }
}
auto_mkindex_parser::command class {op name {body ""}} {
    if {$op eq "create"} {
	indexEntry $name
    }
}

return

Changes to library/tm.tcl.

233
234
235
236
237
238
239









240
241
242
243
244
245
246
		    try {
			package vcompare $pkgversion 0
		    } on error {} {
			# Ignore everything where the version part is not
			# acceptable to "package vcompare".
			continue
		    }










		    # We have found a candidate, generate a "provide script"
		    # for it, and remember it.  Note that we are using ::list
		    # to do this; locally [list] means something else without
		    # the namespace specifier.

		    # NOTE. When making changes to the format of the provide







>
>
>
>
>
>
>
>
>







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
		    try {
			package vcompare $pkgversion 0
		    } on error {} {
			# Ignore everything where the version part is not
			# acceptable to "package vcompare".
			continue
		    }

		    if {[package ifneeded $pkgname $pkgversion] ne {}} {
			# There's already a provide script registered for
			# this version of this package.  Since all units of
			# code claiming to be the same version of the same
			# package ought to be identical, just stick with
			# the one we already have.
			continue
		    }

		    # We have found a candidate, generate a "provide script"
		    # for it, and remember it.  Note that we are using ::list
		    # to do this; locally [list] means something else without
		    # the namespace specifier.

		    # NOTE. When making changes to the format of the provide

Changes to tests/binary.test.

2495
2496
2497
2498
2499
2500
2501




























2502
2503
2504
2505
2506
2507
2508
test binary-71.9 {binary decode hex} -body {
    set r [binary decode hex "6"]
    list [string length $r] $r
} -result {0 {}}
test binary-71.10 {binary decode hex} -body {
    string length [binary decode hex " "]
} -result 0





























test binary-72.1 {binary encode base64} -body {
    binary encode base64
} -returnCodes error -match glob -result "wrong # args: *"
test binary-72.2 {binary encode base64} -body {
    binary encode base64 abc
} -result {YWJj}







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







2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
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
2536
test binary-71.9 {binary decode hex} -body {
    set r [binary decode hex "6"]
    list [string length $r] $r
} -result {0 {}}
test binary-71.10 {binary decode hex} -body {
    string length [binary decode hex " "]
} -result 0
test binary-71.11 {binary decode hex: Bug b98fa55285} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {29 38}
test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}
test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}
test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}

test binary-72.1 {binary encode base64} -body {
    binary encode base64
} -returnCodes error -match glob -result "wrong # args: *"
test binary-72.2 {binary encode base64} -body {
    binary encode base64 abc
} -result {YWJj}

Changes to tests/error.test.

178
179
180
181
182
183
184










185
186
187
188
189
190
191
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
    proc f x {g $x$x}
    proc g x {error G:$x}
    catch {f 12} m d
    dict get $d -errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}











# Errors in error command itself

test error-5.1 {errors in error command} {
    list [catch {error} msg] $msg
} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
test error-5.2 {errors in error command} {







>
>
>
>
>
>
>
>
>
>







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
    proc f x {g $x$x}
    proc g x {error G:$x}
    catch {f 12} m d
    dict get $d -errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.8 {errorstack from exec traces} -body {
    proc foo args {}
    proc goo {} foo
    trace add execution foo enter {error bar;#}
    catch goo m d
    dict get $d -errorstack
} -cleanup {
    rename goo {}; rename foo {}
    unset -nocomplain m d
} -result {INNER {error bar} CALL goo UP 1}

# Errors in error command itself

test error-5.1 {errors in error command} {
    list [catch {error} msg] $msg
} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
test error-5.2 {errors in error command} {

Changes to tests/oo.test.

1835
1836
1837
1838
1839
1840
1841






























1842
1843
1844
1845
1846
1847
1848
	method <cloned> {a b} {}
    }
    interp alias {} Bar {} oo::copy [Foo create foo]
    Bar bar
} -returnCodes error -cleanup {
    Foo destroy
} -result {wrong # args: should be "::bar <cloned> a b"}































test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}







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







1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
	method <cloned> {a b} {}
    }
    interp alias {} Bar {} oo::copy [Foo create foo]
    Bar bar
} -returnCodes error -cleanup {
    Foo destroy
} -result {wrong # args: should be "::bar <cloned> a b"}
test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
    oo::class create FooClass
    set result {}
} -body {
    set obj1 [FooClass new]
    oo::objdefine $obj1 {
	variable var 
	method m {} {
	    set var foo
	}
	method get {} {
	    return $var
	}
	export eval
    }

    $obj1 m
    lappend result [$obj1 get]
    set obj2 [oo::copy $obj1]
    $obj2 eval {
	set var bar
    }
    lappend result [$obj2 get]
    $obj1 eval {
	set var grill
    }
    lappend result [$obj1 get] [$obj2 get]
} -cleanup {
    FooClass destroy
} -result {foo bar grill bar}

test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}

Changes to tests/zlib.test.

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278

279


280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
# Input is headers from fetching SPDY draft
# Dictionary is that which is proposed _in_ SPDY draft
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
test zlib-8.8 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    set compressed [read $inSide]
    catch {zlib decompress $compressed} err opt
    list [string length [zlib compress $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
test zlib-8.9 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream decompress]
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    set result [fconfigure $outSide -checksum]
    chan pop $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    lappend result [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {3064818174 358 358}
test zlib-8.10 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    set compressed [read $inSide]

    catch {zlib inflate $compressed} err opt


    list [string length [zlib deflate $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {254 212 {data error} {TCL ZLIB DATA}}
test zlib-8.11 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream inflate]
} -constraints zlib -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    list [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.12 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide
    fconfigure $outSide -blocking 0 -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.13 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary
    fconfigure $inSide -translation binary
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.14 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide
    fconfigure $outSide -blocking 0 -buffering none -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.15 {transformtion and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -buffering none -translation binary
    fconfigure $inSide -translation binary







|
















|
















|








>
|
>
>







|















|
















|
















|















|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
# Input is headers from fetching SPDY draft
# Dictionary is that which is proposed _in_ SPDY draft
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
test zlib-8.8 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    set compressed [read $inSide]
    catch {zlib decompress $compressed} err opt
    list [string length [zlib compress $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
test zlib-8.9 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream decompress]
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    set result [fconfigure $outSide -checksum]
    chan pop $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    lappend result [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {3064818174 358 358}
test zlib-8.10 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    set compressed [read $inSide]
    catch {
	zlib inflate $compressed
	throw UNREACHABLE "should be unreachable"
    } err opt
    list [string length [zlib deflate $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {254 212 {data error} {TCL ZLIB DATA}}
test zlib-8.11 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream inflate]
} -constraints zlib -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary -buffering none
    fconfigure $inSide -blocking 0 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    list [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.12 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide
    fconfigure $outSide -blocking 0 -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.13 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -translation binary
    fconfigure $inSide -translation binary
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.14 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide
    fconfigure $outSide -blocking 0 -buffering none -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.15 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 0 -buffering none -translation binary
    fconfigure $inSide -translation binary

Changes to unix/tclUnixFCmd.c.

458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
	    return TCL_ERROR;
	}
    }

    switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
    case S_IFLNK: {
	char linkBuf[MAXPATHLEN];
	int length;

	length = readlink(src, linkBuf, sizeof(linkBuf));
							/* INTL: Native. */
	if (length == -1) {
	    return TCL_ERROR;
	}
	linkBuf[length] = '\0';
	if (symlink(linkBuf, dst) < 0) {		/* INTL: Native. */
	    return TCL_ERROR;







|


|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
	    return TCL_ERROR;
	}
    }

    switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
    case S_IFLNK: {
	char linkBuf[MAXPATHLEN+1];
	int length;

	length = readlink(src, linkBuf, MAXPATHLEN);
							/* INTL: Native. */
	if (length == -1) {
	    return TCL_ERROR;
	}
	linkBuf[length] = '\0';
	if (symlink(linkBuf, dst) < 0) {		/* INTL: Native. */
	    return TCL_ERROR;

Changes to unix/tclUnixSock.c.

1354
1355
1356
1357
1358
1359
1360

1361
1362
1363
1364
1365
1366
1367
	status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
        if (status == -1) {
	    if (howfar < BIND) {
		howfar = BIND;
		my_errno = errno;
	    }       
            close(sock);

            continue;
        }
        if (port == 0 && chosenport == 0) {
            address sockname;
            socklen_t namelen = sizeof(sockname);

            /*







>







1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
	status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
        if (status == -1) {
	    if (howfar < BIND) {
		howfar = BIND;
		my_errno = errno;
	    }       
            close(sock);
            sock = -1;
            continue;
        }
        if (port == 0 && chosenport == 0) {
            address sockname;
            socklen_t namelen = sizeof(sockname);

            /*
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389
        status = listen(sock, SOMAXCONN);
        if (status < 0) {
	    if (howfar < LISTEN) {
		howfar = LISTEN;
		my_errno = errno;
	    }
            close(sock);

            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */
            







>







1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
        status = listen(sock, SOMAXCONN);
        if (status < 0) {
	    if (howfar < LISTEN) {
		howfar = LISTEN;
		my_errno = errno;
	    }
            close(sock);
            sock = -1;
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */