Changes On Branch 419fdde9fcbe084c
Not logged in

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

Changes In Branch dgp-properbytearray Through [419fdde9fc] Excluding Merge-Ins

This is equivalent to a diff from 80c345bf67 to 419fdde9fc

2019-03-18
15:46
merge trunk check-in: 16657b8526 user: dgp tags: dgp-properbytearray
2019-03-15
21:17
Merge 8.7 check-in: 3dcb7571f5 user: jan.nijtmans tags: trunk
15:51
merge trunk check-in: 84d2435115 user: dgp tags: dgp-refactor
2019-03-14
22:47
Merge trunk check-in: 419fdde9fc user: jan.nijtmans tags: dgp-properbytearray
20:03
merge-mark check-in: 80c345bf67 user: jan.nijtmans tags: trunk
19:52
Make internal libtommath stub entries deprecated: Those are not supposed to be called in extensions check-in: 99c1ed4d8a user: jan.nijtmans tags: core-8-branch
2019-03-13
20:44
Eliminate many (mostly harmless) MSVC warning messages. Tcl 9 compiles warning-free now on MSVC. check-in: cf865c6e2b user: jan.nijtmans tags: trunk
2019-03-08
15:09
merge trunk check-in: 2a00aec29a user: dgp tags: dgp-properbytearray

Changes to generic/tclBinary.c.
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
51
52
53
54
55
56
57


58
59
60
61

62
63
64
65
66
67
68







-
-




-








#define BINARY_SCAN_MAX_CACHE	260

/*
 * Prototypes for local procedures defined in this file:
 */

static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
			    size_t *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
157
158
159
160
161
162
163




164
165
166
167
168
169
170







-
-
-
-








/*
 * The following object types represent an array of bytes. The intent is
 * to allow arbitrary binary data to pass through Tcl as a Tcl value
 * without loss or damage. Such values are useful for things like
 * encoded strings or Tk images to name just two.
 *
 * It's strange to have two Tcl_ObjTypes in place for this task when
 * one would do, so a bit of detail and history how we got to this point
 * and where we might go from here.
 *
 * A bytearray is an ordered sequence of bytes. Each byte is an integer
 * value in the range [0-255].  To be a Tcl value type, we need a way to
 * encode each value in the value set as a Tcl string.  The simplest
 * encoding is to represent each byte value as the same codepoint value.
 * A bytearray of N bytes is encoded into a Tcl string of N characters
 * where the codepoint of each character is the value of corresponding byte.
 * This approach creates a one-to-one map between all bytearray values
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
245
246
247
248
249
250
251








252
253
254
255
256
257
258







-
-
-
-
-
-
-
-







    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL
};

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

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

447
448
449
450
451
452
453
454
455
456

457
458
459


460

461

462
463
464
465
466
467
468
432
433
434
435
436
437
438



439



440
441
442
443
444
445
446
447
448
449
450
451
452







-
-
-
+
-
-
-
+
+

+

+







    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;
    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);

    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) {
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    if (lengthPtr != NULL) {
		*lengthPtr = 0;
	    }
	    return NULL;
	}
	irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    }
    baPtr = GET_BYTEARRAY(irPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = baPtr->used;
    }
    return baPtr->bytes;
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
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







-
+










-
-
-
+
+
+
-
-
+
-
-
+
-
+







 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t length)			/* New length for internal byte array. */
    size_t length)		/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep *irPtr;

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

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	if (length == 0) {
	    Tcl_SetByteArrayObj(objPtr, NULL, 0);
	} else if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) {
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
	    return NULL;
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
	}
	irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
536
537
538
539
540
541
542
543
544
545

546
547



548
549

550
551
552



553












































554
555
556
557
558
559
560
561
562
563


564
565
566

567
568
569
570
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
518
519
520
521
522
523
524
525
526

527


528
529
530
531

532


533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587




588
589



590





591
592



593

594

595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614







615
616
617
618
619
620
621









-
+
-
-
+
+
+

-
+
-
-

+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
+
+
-
-
-
+
-
-
-
-
-


-
-
-

-
+
-




















-
-
-
-
-
-
-







 *	The return value is always TCL_OK.
 *
 * Side effects:
 *	A ByteArray object is stored as the internal rep of objPtr.
 *
 *----------------------------------------------------------------------
 */

static int
SetByteArrayFromAny(
MakeByteArray(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
    Tcl_Obj *objPtr,
    int earlyOut,
    ByteArray **byteArrayPtrPtr) 
{
    size_t length;
    int length, proper = 1;
    int improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    const char *src = TclGetStringFromObj(objPtr, &length);
    ByteArray *byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
    const char *srcEnd = src + length;
    Tcl_UniChar ch = 0;

    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	if (ch > 255) {
	  proper = 0;
	  if (earlyOut) {
	    ckfree(byteArrayPtr);
	    *byteArrayPtrPtr = NULL;
	    return proper;
	  }
	}
	*dst++ = UCHAR(ch);
    }
    byteArrayPtr->used = dst - byteArrayPtr->bytes;
    byteArrayPtr->allocated = length;

    *byteArrayPtrPtr = byteArrayPtr;
    return proper;
}

Tcl_Obj *
TclNarrowToBytes(
    Tcl_Obj *objPtr)
{
    if (NULL == TclFetchIntRep(objPtr, &properByteArrayType)) {
	Tcl_ObjIntRep ir;
	ByteArray *byteArrayPtr;

	if (0 == MakeByteArray(objPtr, 0, &byteArrayPtr)) {
	    objPtr = Tcl_NewObj();
	    TclInvalidateStringRep(objPtr);
	}
	SET_BYTEARRAY(&ir, byteArrayPtr);
	Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
    }
    Tcl_IncrRefCount(objPtr);
    return objPtr;
}

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }


    if (0 == MakeByteArray(objPtr, 1, &byteArrayPtr)) {
    src = TclGetStringFromObj(objPtr, &length);
    srcEnd = src + length;

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

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

    SET_BYTEARRAY(&ir, byteArrayPtr);
    Tcl_StoreIntRep(objPtr,
    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
	    improper ? &tclByteArrayType : &properByteArrayType, &ir);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeByteArrayInternalRep --
 *
 *	Deallocate the storage associated with a ByteArray data object's
 *	internal representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees memory.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
}

static void
FreeProperByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
}

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
652
653
654
655
656
657
658
659
660
661
662
663
664
633
634
635
636
637
638
639

640
641
642
643
644





















645
646
647
648
649
650
651







-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

static void
DupByteArrayInternalRep(
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    size_t length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}

static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length));
760
761
762
763
764
765
766
767
768
769

770
771
772
773


774

775
776
777
778
779
780
781
747
748
749
750
751
752
753



754




755
756

757
758
759
760
761
762
763
764







-
-
-
+
-
-
-
-
+
+
-
+







    if (len == 0) {
	/* Append zero bytes is a no-op. */
	return;
    }

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) {
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	    Tcl_Panic("attempt to append bytes to non-bytearray");
	}
	}
	irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);

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

923
924
925
926
927
928
929

930


931
932
933
934
935
936
937
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
921
922







+
-
+
+







	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		Tcl_Obj *copy = TclNarrowToBytes(objv[arg]);
		(void)TclGetByteArrayFromObj(objv[arg], &count);
		(void)TclGetByteArrayFromObj(copy, &count);
		Tcl_DecrRefCount(copy);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    if (cmd == 'a' || cmd == 'A') {
		offset += count;
	    } else if (cmd == 'b' || cmd == 'B') {
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095


1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1071
1072
1073
1074
1075
1076
1077
1078
1079


1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101







+

-
-
+
+












+







	    continue;
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
	    unsigned char *bytes;
	    Tcl_Obj *copy = TclNarrowToBytes(objv[arg++]);

	    bytes = TclGetByteArrayFromObj(objv[arg], &length);
	    arg++;
	    bytes = TclGetByteArrayFromObj(copy, &length);

	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, count);
	    } else {
		memcpy(cursor, bytes, length);
		memset(cursor + length, pad, count - length);
	    }
	    cursor += count;
	    Tcl_DecrRefCount(copy);
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

	    str = TclGetStringFromObj(objv[arg], &length);
1398
1399
1400
1401
1402
1403
1404





1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399

1400
1401
1402
1403
1404
1405
1406







+
+
+
+
+



-







    Tcl_HashTable numberCacheHash;
    Tcl_HashTable *numberCachePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"value formatString ?varName ...?");
	return TCL_ERROR;
    }
    buffer = TclGetByteArrayFromObj(objv[1], &length);
    if (buffer == NULL) {
	Tcl_AppendResult(interp, "binary scan expects bytes", NULL);
	return TCL_ERROR;
    }
    numberCachePtr = &numberCacheHash;
    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
    buffer = TclGetByteArrayFromObj(objv[1], &length);
    format = TclGetString(objv[2]);
    arg = 3;
    offset = 0;
    while (*format != '\0') {
	str = format;
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
2449
2450
2451
2452
2453
2454
2455
2456
2457






2458
2459
2460
2461
2462
2463
2464
2440
2441
2442
2443
2444
2445
2446

2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460







-

+
+
+
+
+
+







    size_t offset = 0, count = 0;

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

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[1], &count);
    if (data == NULL) {
	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
	*cursor++ = HexDigits[(data[offset] & 0x0f)];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
2645
2646
2647
2648
2649
2650
2651
2652
2653





2654
2655
2656
2657
2658
2659
2660
2641
2642
2643
2644
2645
2646
2647

2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660







-

+
+
+
+
+







	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = TclGetByteArrayFromObj(objv[objc-1], &count);
    if (data == NULL) {
	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
	return TCL_ERROR;
    }
    resultObj = Tcl_NewObj();
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
2745
2746
2747
2748
2749
2750
2751





2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763





2764
2765
2766
2767
2768
2769
2770
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765

2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779







+
+
+
+
+









-


+
+
+
+
+







		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetByteArrayFromObj(objv[i+1], &wrapcharlen);
	    if (wrapchar == NULL) {
		Tcl_AppendResult(interp,
			"binary encode -wrapchar expects bytes", NULL);
		return TCL_ERROR;
	    }
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = TclGetByteArrayFromObj(objv[objc-1], &count);
    if (data == NULL) {
	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
	return TCL_ERROR;
    }
    resultObj = Tcl_NewObj();
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
Changes to generic/tclCmdAH.c.
444
445
446
447
448
449
450





451
452
453
454
455
456
457
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462







+
+
+
+
+







	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) TclGetByteArrayFromObj(data, &length);
    if (bytesPtr == NULL) {
	Tcl_AppendResult(interp, "encoding conversion expects bytes", NULL);
	Tcl_FreeEncoding(encoding);
	return TCL_ERROR;
    }
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

Changes to generic/tclIO.c.
4114
4115
4116
4117
4118
4119
4120
4121

4122
4123
4124
4125
4126
4127
4128
4114
4115
4116
4117
4118
4119
4120

4121
4122
4123
4124
4125
4126
4127
4128







-
+







				 * buffer. */
    size_t len)			/* Length of string in bytes, or -1 for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    int result;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr, *copy;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    chanPtr = statePtr->topChanPtr;

4141
4142
4143
4144
4145
4146
4147

4148


4149
4150

4151
4152
4153
4154
4155
4156
4157
4141
4142
4143
4144
4145
4146
4147
4148

4149
4150
4151

4152
4153
4154
4155
4156
4157
4158
4159







+
-
+
+

-
+







     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    copy = TclNarrowToBytes(objPtr);
    src = (char *) TclGetByteArrayFromObj(objPtr, &len);
    src = (char *) TclGetByteArrayFromObj(copy, &len);
    TclDecrRefCount(objPtr);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    TclDecrRefCount(copy);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteObj --
4193
4194
4195
4196
4197
4198
4199



4200
4201




4202
4203
4204
4205
4206
4207
4208
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204


4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215







+
+
+
-
-
+
+
+
+







    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }
    if (statePtr->encoding == NULL) {
	int result;
	Tcl_Obj *copy = TclNarrowToBytes(objPtr);

	src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
	src = (char *) TclGetByteArrayFromObj(copy, &srcLen);
	result = WriteBytes(chanPtr, src, srcLen);
	Tcl_DecrRefCount(copy);
	return result;
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
4553
4554
4555
4556
4557
4558
4559
4560


4561
4562
4563
4564
4565
4566
4567
4560
4561
4562
4563
4564
4565
4566

4567
4568
4569
4570
4571
4572
4573
4574
4575







-
+
+







     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */

    if ((statePtr->encoding == NULL)
	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) {
		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))
	    && Tcl_GetByteArrayFromObj(objPtr, NULL) != NULL) {
	return TclGetsObjBinary(chan, objPtr);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

Changes to generic/tclIOGT.c.
440
441
442
443
444
445
446

447
448
449





450
451
452
453
454
455
456

457
458




459
460
461
462

463
464








465
466
467
468
469
470
471
440
441
442
443
444
445
446
447



448
449
450
451
452
453
454
455
456
457
458
459
460


461
462
463
464
465
466
467
468
469


470
471
472
473
474
475
476
477
478
479
480
481
482
483
484







+
-
-
-
+
+
+
+
+







+
-
-
+
+
+
+




+
-
-
+
+
+
+
+
+
+
+








    case TRANSMIT_DOWN:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	if (resBuf) {
	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
		resLen);
	break;
	    Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),
		    (char *) resBuf, resLen);
	    break;
	}
	goto nonBytes;

    case TRANSMIT_SELF:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	if (resBuf) {
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;
	    Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	    break;
	}
	goto nonBytes;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	if (resBuf) {
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;
	    ResultAdd(&dataPtr->result, resBuf, resLen);
	    break;
	}
	nonBytes:
	Tcl_AppendResult(interp, "chan transform callback received non-bytes",
		NULL);
	Tcl_Release(eval);
	return TCL_ERROR;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */

	resObj = Tcl_GetObjResult(eval);
Changes to generic/tclIORChan.c.
444
445
446
447
448
449
450

451
452
453
454
455
456
457
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458







+







 * Global constant strings (messages). ==================
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_read_nonbyte = "{read delivered nonbyte result}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost    = "{Owner lost}";
1314
1315
1316
1317
1318
1319
1320



1321

1322
1323
1324
1325
1326
1327
1328
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324

1325
1326
1327
1328
1329
1330
1331
1332







+
+
+
-
+








	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);

    if (bytev == NULL) {
	SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte);
        goto invalid;
    if ((size_t)toRead < bytec) {
    } else if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec + 1 > 1) {
2999
3000
3001
3002
3003
3004
3005



3006

3007
3008
3009
3010
3011
3012
3013
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012

3013
3014
3015
3016
3017
3018
3019
3020







+
+
+
-
+







	     */

	    size_t bytec = 0;		/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    if (bytev == NULL) {
		ForwardSetStaticError(paramPtr, msg_read_nonbyte);
		paramPtr->input.toRead = -1;
	    if (paramPtr->input.toRead < bytec) {
	    } else if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = TCL_IO_FAILURE;
	    } else {
		if (bytec + 1 > 1) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
Changes to generic/tclInt.h.
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2674
2675
2676
2677
2678
2679
2680

2681
2682
2683
2684
2685
2686
2687







-








/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
3028
3029
3030
3031
3032
3033
3034

3035
3036
3037
3038
3039
3040
3041
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041







+







MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, size_t numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *	TclNarrowToBytes(Tcl_Obj *objPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
Changes to generic/tclObj.c.
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
370
371
372
373
374
375
376

377
378
379
380
381
382
383







-







TclInitObjSubsystem(void)
{
    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclByteArrayType);
    Tcl_RegisterObjType(&tclDoubleType);
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
Changes to generic/tclTest.c.
5016
5017
5018
5019
5020
5021
5022




5023
5024
5025
5026
5027
5028
5029
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033







+
+
+
+







    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_AppendResult(interp, "testbytestring expects bytes", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
Changes to tests/binary.test.
2912
2913
2914
2915
2916
2917
2918
2919

2920
2921
2922
2923
2924
2925
2926
2912
2913
2914
2915
2916
2917
2918

2919
2920
2921
2922
2923
2924
2925
2926







-
+







} [binary format H* abcd]

test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body {
    # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX <= 4):
    binary encode hex \U0001f415
    binary scan \U0001f415 a* v; set v
    set str {}
} -result {}
} -result * -match glob -returnCodes error

# ----------------------------------------------------------------------
# cleanup

::tcltest::cleanupTests
return

Changes to tests/execute.test.
985
986
987
988
989
990
991
992

993
994
995
996
997
998
999
985
986
987
988
989
990
991

992
993
994
995
996
997
998
999







-
+







    } else {
	set result SUCCESS
    }
    set result
} SUCCESS

test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
    apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
    apply {s {binary scan [binary format a $s] c x; list $x [scan $s$s %c%c]}} \u0130
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
    interp create slave
} -body {
    # If [Bug 2802881] is not fixed, this will segfault
    slave eval {
	trace add variable ::errorInfo write {expr {$foo} ;#}
Changes to tests/obj.test.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

50
51
52

53
54
55
56
57
58
59
22
23
24
25
26
27
28

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

48
49
50

51
52
53
54
55
56
57
58







-



















-
+


-
+







testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName
	dict
	regexp
	string
    } {
        set first [string first $t [testobj types]]
        set r [expr {$r && ($first != -1)}]
    }
    set result $r
} {1}

test obj-2.1 {Tcl_GetObjType error} testobj {
    list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
} {0 1 {no type foo found}}
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 12]
    lappend result [testobj convert 1 bytearray]
    lappend result [testobj convert 1 string]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12 12 bytearray 3}
} {{} 12 12 string 3}

test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]