Tcl Source Code

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

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

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | utf-max
Files: files | file ages | folders
SHA3-256: c1bdc62c2a092c346184fda9c74522ce83b4009bc3accd3e3945f741417ac050
User & Date: jan.nijtmans 2019-04-03 19:52:38
Context
2019-05-10
07:46
merge 8.7 check-in: f3302db091 user: jan.nijtmans tags: utf-max
2019-04-03
19:52
Merge 8.7 check-in: c1bdc62c2a user: jan.nijtmans tags: utf-max
2019-04-02
18:23
merge-mark check-in: 5b3cc9e2a9 user: jan.nijtmans tags: core-8-branch
2019-03-28
22:49
Merge 8.7 check-in: eebb1e7ee1 user: jan.nijtmans tags: utf-max
Changes
Hide Diffs Unified Diffs Show Whitespace Changes Patch

Changes to doc/info.n.

whitespace changes only

Changes to generic/tclCmdAH.c.

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int value;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	value = 0;
    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit(value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *






|








|


|







928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt value;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	value = 0;
    } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit((int)value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclCmdMZ.c.

4368
4369
4370
4371
4372
4373
4374





4375
4376
4377
4378
4379
4380
4381
....
4421
4422
4423
4424
4425
4426
4427

4428
4429

4430



4431
4432
4433
4434
4435
4436
4437
	middle -= start;		     /* execution time in microsecs */

    #ifdef TCL_WIDE_CLICKS
	/* convert execution time in wide clicks to microsecs */
	middle *= TclpWideClickInMicrosec();
    #endif






	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
................................................................................
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}


	/* estimated net execution time (in millisecs) */
	if (!calibrate) {

	    objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);



	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	* Construct the result as a list because many programs have always parsed
	* as such (extracting the first element, typically).
	*/






>
>
>
>
>







 







>


>
|
>
>
>







4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
....
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
	middle -= start;		     /* execution time in microsecs */

    #ifdef TCL_WIDE_CLICKS
	/* convert execution time in wide clicks to microsecs */
	middle *= TclpWideClickInMicrosec();
    #endif

	if (!count) { /* no iterations - avoid divide by zero */
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
................................................................................
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}

    retRes:
	/* estimated net execution time (in millisecs) */
	if (!calibrate) {
	    if (middle >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
	    } else {
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	* Construct the result as a list because many programs have always parsed
	* as such (extracting the first element, typically).
	*/

Changes to generic/tclProcess.c.

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
................................................................................

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {






|







 







|







536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
...
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
................................................................................

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {

Changes to generic/tclTest.c.

48
49
50
51
52
53
54

55
56
57
58
59
60
61
...
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
...
570
571
572
573
574
575
576





577
578
579
580
581
582
583
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
....
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021




5022
5023
5024
5025
5026
5027
5028
/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;


/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_Obj *listPtr;
    Tcl_Obj **objv;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
................................................................................
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }






    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
................................................................................
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
     */

    listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (listPtr != NULL) {
	if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
		TCL_EXACT, &index) == TCL_OK)) {
	    switch (index) {
	    case 0:
		return TCL_ERROR;
................................................................................
static int
TestbytestringObjCmd(
    void *unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);




    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *






>







 







<
|







 







>
>
>
>
>







 







|
|
|







 







|







>
>
>
>







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563
...
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
...
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
....
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;
static const Tcl_ObjType *properByteArrayType;

/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{

    Tcl_Obj **objv, *objPtr;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
................................................................................
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    objPtr = Tcl_NewStringObj("abc", 3);
    (void)Tcl_GetByteArrayFromObj(objPtr, &index);
    properByteArrayType = objPtr->typePtr;
    Tcl_DecrRefCount(objPtr);

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
................................................................................
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
     */

    objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (objPtr != NULL) {
	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
		TCL_EXACT, &index) == TCL_OK)) {
	    switch (index) {
	    case 0:
		return TCL_ERROR;
................................................................................
static int
TestbytestringObjCmd(
    void *unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n = 0;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
    if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) {
	Tcl_AppendResult(interp, "testbytestring expects bytes", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclTestObj.c.

381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
...
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
...
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
................................................................................
	    return TCL_ERROR;
	}
	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
				  &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, or not", NULL);
	return TCL_ERROR;
................................................................................
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    long longValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
................................................................................
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setlong") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmaxlong") == 0) {
	long maxLong = LONG_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], maxLong);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxLong));
	}
    } else if (strcmp(subCmd, "ismaxlong") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((longValue == LONG_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}






|

|







 







|

|







 







|







 







|







 







|
|




|

|

|






|



|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
...
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
...
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
...
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
................................................................................
	    return TCL_ERROR;
	}
	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
				  &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, or not", NULL);
	return TCL_ERROR;
................................................................................
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    Tcl_WideInt wideValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
................................................................................
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setint") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmax") == 0) {
	Tcl_WideInt maxWide = WIDE_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
	}
    } else if (strcmp(subCmd, "ismax") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((wideValue == WIDE_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}

Changes to generic/tclTestProcBodyObj.c.

336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
	    strcmp(version, packageVersion) == 0));
    return TCL_OK;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






|











336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
	    strcmp(version, packageVersion) == 0));
    return TCL_OK;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclUtil.c.

3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
....
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj *value;
    int prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
................................................................................
     */

    if (Tcl_IsSafe(interp)) {
	return (char *) "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
 
/*
 *----------------------------------------------------------------------
 *






|







 







|



|







3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
....
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj *value;
    Tcl_WideInt prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
................................................................................
     */

    if (Tcl_IsSafe(interp)) {
	return (char *) "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = (int)prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclZlib.c.

418
419
420
421
422
423
424

425
426
427
428
429
430
431
...
481
482
483
484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;

    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
................................................................................
    /*
     * Ignore the 'size' field, since that is controlled by the size of the
     * input data.
     */

    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
	    (long *) &headerPtr->header.time) != TCL_OK) {
	goto error;
    }


    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
	goto error;
    }






>







 







|
|


>







418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
...
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;
    Tcl_WideInt wideValue;
    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
................................................................................
    /*
     * Ignore the 'size' field, since that is controlled by the size of the
     * input data.
     */

    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value,
	    &wideValue) != TCL_OK) {
	goto error;
    }
    headerPtr->header.time = wideValue;

    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
	goto error;
    }

Changes to macosx/tclMacOSXFCmd.c.

188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
...
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewBooleanObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
................................................................................
    OSType *osTypePtr)		/* Place to store resulting OSType. */
{
    int result = TCL_OK;

    if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
	result = SetOSTypeFromAny(interp, objPtr);
    }
    *osTypePtr = (OSType) objPtr->internalRep.longValue;
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NewOSTypeObj --
................................................................................
    const OSType osType)	/* OSType used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    objPtr->internalRep.longValue = (long) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.longValue = (long) osType;
	objPtr->typePtr = &tclOSTypeType;
    }
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return result;
}
 
................................................................................
static void
UpdateStringOfOSType(
    register Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * update. */
{
    const int size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.longValue;
    int written = 0;
    Tcl_Encoding encoding;
    char src[5];

    TclOOM(dst, size);

    src[0] = (char) (osType >> 24);






|







 







|







 







|







 







|







 







|







188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
...
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
................................................................................
    OSType *osTypePtr)		/* Place to store resulting OSType. */
{
    int result = TCL_OK;

    if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
	result = SetOSTypeFromAny(interp, objPtr);
    }
    *osTypePtr = (OSType) objPtr->internalRep.wideValue;
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NewOSTypeObj --
................................................................................
    const OSType osType)	/* OSType used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
	objPtr->typePtr = &tclOSTypeType;
    }
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return result;
}
 
................................................................................
static void
UpdateStringOfOSType(
    register Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * update. */
{
    const int size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.wideValue;
    int written = 0;
    Tcl_Encoding encoding;
    char src[5];

    TclOOM(dst, size);

    src[0] = (char) (osType >> 24);

Changes to tests/cmdMZ.test.

356
357
358
359
360
361
362
363



364
365
366
367
368
369
370
371
} {1 {expected integer but got "b"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {



    regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {after 0} 20]
    set m2 [timerate {after 1} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \






|
>
>
>
|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
} {1 {expected integer but got "b"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {after 0} 20]
    set m2 [timerate {after 1} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \

Changes to tests/obj.test.

472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
test obj-26.1 {UpdateStringOfInt} testobj {
    set result ""
    lappend result [testintobj set 1 512]
    lappend result [testintobj mult10 1]
    lappend result [testintobj get 1]       ;# must update string rep
} {512 5120 5120}

test obj-27.1 {Tcl_NewLongObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    testintobj setmaxlong 1
    lappend result [testintobj ismaxlong 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 1 int 1}

test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 77 int 2}
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 12.34]
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}

test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj {
    set result ""
    lappend result [testintobj setlong 1 22]
    lappend result [testintobj mult10 1]   ;# gets existing long int rep
} {22 220}
test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj {
    set result ""
    lappend result [testintobj setlong 1 477]
    lappend result [testintobj div10 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {477 47 int}
test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {abc 1 {expected integer but got "abc"}}
test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {{} 1 {expected integer but got ""}}

test obj-30.1 {Ref counting and object deletion, simple types} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 1024]






|


|
|








|







|




|

|
|

|

|



|


|


|


|







472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
test obj-26.1 {UpdateStringOfInt} testobj {
    set result ""
    lappend result [testintobj set 1 512]
    lappend result [testintobj mult10 1]
    lappend result [testintobj get 1]       ;# must update string rep
} {512 5120 5120}

test obj-27.1 {Tcl_NewWideObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    testintobj setmax 1
    lappend result [testintobj ismax 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 1 int 1}

test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 77 int 2}
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 12.34]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}

test obj-29.1 {Tcl_GetWideIntFromObj, existing int object} testobj {
    set result ""
    lappend result [testintobj setint 1 22]
    lappend result [testintobj mult10 1]   ;# gets existingint rep
} {22 220}
test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj {
    set result ""
    lappend result [testintobj setint 1 477]
    lappend result [testintobj div10 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {477 47 int}
test obj-29.3 {Tcl_GetWideIntFromObj, error converting to int} testobj {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result $msg
} {abc 1 {expected integer but got "abc"}}
test obj-29.4 {Tcl_GetWideIntFromObj, error converting from "empty string"} testobj {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result $msg
} {{} 1 {expected integer but got ""}}

test obj-30.1 {Ref counting and object deletion, simple types} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 1024]

Changes to tests/utf.test.

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
    testnumutfchars ""
} {0}
test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
} {7}
test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"]
} {1}
test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars {
    testnumutfchars "" 0
} {0}
test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"] 2
} {1}
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 10
} {7}
test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"] 2
} {1}
# Bug [2738427]: Tcl_NumUtfChars(...) no overflow check
test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xE2\x82\xAC"] 2






|











|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
    testnumutfchars ""
} {0}
test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"]
} {7}
test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"]
} {1}
test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars {
    testnumutfchars "" 0
} {0}
test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"] 2
} {1}
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] 10
} {7}
test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"] 2
} {1}
# Bug [2738427]: Tcl_NumUtfChars(...) no overflow check
test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xE2\x82\xAC"] 2

Changes to unix/tclUnixFCmd.c.

1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
....
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
....
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
....
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
....
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
....
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    long gid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    long uid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    long mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
................................................................................
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
................................................................................
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(
	    fileAttributes & attributeArray[objIndex]);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
................................................................................
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes






|



|







 







|



|







 







|







 







|



|







 







|
|







 







|







1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
....
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
....
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
....
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
....
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
....
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    Tcl_WideInt gid;
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    Tcl_WideInt uid;
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_WideInt mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
................................................................................
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
................................................................................
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewWideIntObj(
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
................................................................................
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes

Changes to win/tclWinFCmd.c.

1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
		 */

		attr = 0;
	    }
	}
    }

    *attributePtrPtr = Tcl_NewBooleanObj(attr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --






|







1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
		 */

		attr = 0;
	    }
	}
    }

    *attributePtrPtr = Tcl_NewWideIntObj(attr != 0);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --