Tcl Source Code

Changes On Branch tip-346
Login

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

Changes In Branch tip-346 Excluding Merge-Ins

This is equivalent to a diff from c297f05cb1 to ba23b468ed

2022-10-08
14:46
TIP #346: Error on Failed String Encodings check-in: a106c26dd5 user: jan.nijtmans tags: core-8-branch
04:28
TIP #636 starting imiplementation. check-in: 85db0230f9 user: griffin tags: tip-636
02:39
Sync with core-8-branch Closed-Leaf check-in: 1fd2fe2478 user: griffin tags: abstractlist-with-625
2022-10-07
22:49
Merge tip-346 check-in: fc99b89662 user: jan.nijtmans tags: tip633-fconfigure-tolerantencoding
18:59
Merge 8.7 Closed-Leaf check-in: ba23b468ed user: jan.nijtmans tags: tip-346
15:21
Merge 8.7 check-in: b35370f1d5 user: jan.nijtmans tags: trunk, main
15:19
On Windows, env(HOME) should be handled case-insensitive in fCmd.test check-in: c297f05cb1 user: jan.nijtmans tags: core-8-branch
15:18
Use GotFlag/SetFlag/ResetFlag macro's wherever appropriate check-in: 98cddde746 user: jan.nijtmans tags: core-8-branch
2022-09-26
12:31
Merge 8.7 check-in: 1aa9452e1d user: jan.nijtmans tags: tip-346

Changes to generic/tcl.h.

2116
2117
2118
2119
2120
2121
2122

2123
2124
2125
2126
2127
2128
2129
#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#define TCL_ENCODING_STOPONERROR	0x04
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10
#define TCL_ENCODING_MODIFIED		0x20
#define TCL_ENCODING_NOCOMPLAIN		0x40


/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large







>







2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#define TCL_ENCODING_STOPONERROR	0x04
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10
#define TCL_ENCODING_MODIFIED		0x20
#define TCL_ENCODING_NOCOMPLAIN		0x40
#define TCL_ENCODING_STRICT			0x44

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large

Changes to generic/tclCmdAH.c.

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
    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4


     * 5) -failindex val data				-> objc = 4
     * 6) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	bytesPtr = Tcl_GetString(objv[1]);
	if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
		&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;




	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
		&& !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvFromError;
	    }







>
>
|
|












>
>
>
>







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
    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4
     * 5) -strict data				-> objc = 3
     * 6) -strict encoding data			-> objc = 4
     * 7) -failindex val data				-> objc = 4
     * 8) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	bytesPtr = Tcl_GetString(objv[1]);
	if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
		&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 's'
		&& !strncmp(bytesPtr, "-strict", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_STRICT;
	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
		&& !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvFromError;
	    }
600
601
602
603
604
605
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
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvFromError;
	}
    } else {
    encConvFromError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
    if (!(flags & TCL_ENCODING_STOPONERROR)) {
	bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
    } else
#endif
    bytesPtr = (char *) TclGetBytesFromObj(interp, data, &length);
    if (bytesPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
	    flags, &ds);
    if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    char buf[TCL_INTEGER_SPACE];
	    sprintf(buf, "%u", result);







|

















|







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
635
636
637
638
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvFromError;
	}
    } else {
    encConvFromError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-strict? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
    if (!(flags & TCL_ENCODING_STOPONERROR)) {
	bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
    } else
#endif
    bytesPtr = (char *) TclGetBytesFromObj(interp, data, &length);
    if (bytesPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
	    flags, &ds);
    if ((!(flags & TCL_ENCODING_NOCOMPLAIN) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    char buf[TCL_INTEGER_SPACE];
	    sprintf(buf, "%u", result);
710
711
712
713
714
715
716




717
718
719
720
721
722
723
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	stringPtr = Tcl_GetString(objv[1]);
	if (stringPtr[0] == '-' && stringPtr[1] == 'n'
		&& !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;




	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 'f'
		&& !strncmp(stringPtr, "-failindex", strlen(stringPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvToError;
	    }







>
>
>
>







716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	stringPtr = Tcl_GetString(objv[1]);
	if (stringPtr[0] == '-' && stringPtr[1] == 'n'
		&& !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 's'
		&& !strncmp(stringPtr, "-strict", strlen(stringPtr))) {
	    flags = TCL_ENCODING_STRICT;
	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 'f'
		&& !strncmp(stringPtr, "-failindex", strlen(stringPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvToError;
	    }
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
760
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvToError;
	}
    } else {
    encConvToError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
	    flags, &ds);
    if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    /* I hope, wide int will cover size_t data type */
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    size_t pos = Tcl_NumUtfChars(stringPtr, result);







|










|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvToError;
	}
    } else {
    encConvToError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-strict? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
	    flags, &ds);
    if ((!(flags & TCL_ENCODING_NOCOMPLAIN) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    /* I hope, wide int will cover size_t data type */
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    size_t pos = Tcl_NumUtfChars(stringPtr, result);

Changes to generic/tclEncoding.c.

2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED)
#   define STOPONERROR !(flags & TCL_ENCODING_NOCOMPLAIN)
#else
#   define STOPONERROR (flags & TCL_ENCODING_STOPONERROR)
#endif

static int
UtfToUtfProc(
    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_MODIFIED */







|







2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED)
#   define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN) || (flags & TCL_ENCODING_STOPONERROR))
#else
#   define STOPONERROR (flags & TCL_ENCODING_STOPONERROR)
#endif

static int
UtfToUtfProc(
    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_MODIFIED */
2355
2356
2357
2358
2359
2360
2361




2362




2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xC080.
	     */

	    *dst++ = *src++;
	} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)




		&& (UCHAR(src[1]) == 0x80) && !(flags & TCL_ENCODING_MODIFIED)) {




	    /*
	     * Convert 0xC080 to real nulls when we are in output mode.
	     */

	    *dst++ = 0;
	    src += 2;
	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*
	     * Always check before using TclUtfToUCS4. Not doing can so
	     * cause it run beyond the end of the buffer! If we happen such an
	     * incomplete char its bytes are made to represent themselves







>
>
>
>
|
>
>
>
>

|

<







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
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xC080.
	     */

	    *dst++ = *src++;
	} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)
		&& (UCHAR(src[1]) == 0x80) && (!(flags & TCL_ENCODING_MODIFIED) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT))) {
	    /*
	     * If in input mode, and -strict is specified: This is an error.
	     */
	    if (flags & TCL_ENCODING_MODIFIED) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

	    /*
	     * Convert 0xC080 to real nulls when we are in output mode, with or without '-strict'.
	     */

	    *dst++ = 0;
	    src += 2;
	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*
	     * Always check before using TclUtfToUCS4. Not doing can so
	     * cause it run beyond the end of the buffer! If we happen such an
	     * incomplete char its bytes are made to represent themselves

Changes to generic/tclIO.c.

4388
4389
4390
4391
4392
4393
4394








4395
4396
4397
4398
4399
4400
4401
    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
    char safe[BUFFER_PADDING];
    int encodingError = 0;

    if (srcLen) {
        WillWrite(chanPtr);
    }









    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);








>
>
>
>
>
>
>
>







4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
    char safe[BUFFER_PADDING];
    int encodingError = 0;

    if (srcLen) {
        WillWrite(chanPtr);
    }

    /*
     * Transfer encoding strict option to the encoding flags
     */

    if (statePtr->flags & CHANNEL_ENCODING_STRICT) {
	statePtr->outputEncodingFlags |= TCL_ENCODING_STRICT;
    }

    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

4703
4704
4705
4706
4707
4708
4709








4710
4711
4712
4713
4714
4715
4716
     * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
     * produce ByteArray objects.
     */

    if (encoding == NULL) {
	encoding = GetBinaryEncoding();
    }









    /*
     * Object used by FilterInputBytes to keep track of how much data has been
     * consumed from the channel buffers.
     */

    gs.objPtr		= objPtr;







>
>
>
>
>
>
>
>







4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
     * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
     * produce ByteArray objects.
     */

    if (encoding == NULL) {
	encoding = GetBinaryEncoding();
    }

    /*
     * Transfer encoding strict option to the encoding flags
     */

    if (statePtr->flags & CHANNEL_ENCODING_STRICT) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    }

    /*
     * Object used by FilterInputBytes to keep track of how much data has been
     * consumed from the channel buffers.
     */

    gs.objPtr		= objPtr;
5460
5461
5462
5463
5464
5465
5466









5467
5468
5469
5470
5471
5472
5473
	    }
	}
	spaceLeft = length - offset;
	dst = objPtr->bytes + offset;
	*gsPtr->dstPtr = dst;
    }
    gsPtr->state = statePtr->inputEncodingState;









    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);

    /*
     * Make sure that if we go through 'gets', that we reset the







>
>
>
>
>
>
>
>
>







5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
	    }
	}
	spaceLeft = length - offset;
	dst = objPtr->bytes + offset;
	*gsPtr->dstPtr = dst;
    }
    gsPtr->state = statePtr->inputEncodingState;

    /*
     * Transfer encoding strict option to the encoding flags
     */

    if (statePtr->flags & CHANNEL_ENCODING_STRICT) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    }

    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);

    /*
     * Make sure that if we go through 'gets', that we reset the
6231
6232
6233
6234
6235
6236
6237








6238
6239
6240
6241
6242
6243
6244
	unsigned int size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }









    /*
     * This routine is burdened with satisfying several constraints. It cannot
     * append more than 'charsToRead` chars onto objPtr. This is measured
     * after encoding and translation transformations are completed. There is
     * no precise number of src bytes that can be associated with the limit.
     * Yet, when we are done, we must know precisely the number of src bytes







>
>
>
>
>
>
>
>







6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
	unsigned int size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }

    /*
     * Transfer encoding strict option to the encoding flags
     */

    if (statePtr->flags & CHANNEL_ENCODING_STRICT) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    }

    /*
     * This routine is burdened with satisfying several constraints. It cannot
     * append more than 'charsToRead` chars onto objPtr. This is measured
     * after encoding and translation transformations are completed. There is
     * no precise number of src bytes that can be associated with the limit.
     * Yet, when we are done, we must know precisely the number of src bytes
7967
7968
7969
7970
7971
7972
7973










7974
7975
7976
7977
7978
7979
7980
	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
	    Tcl_DStringEndSublist(dsPtr);
	}
	if (len > 0) {
	    return TCL_OK;
	}










    }
    if (len == 0 || HaveOpt(1, "-translation")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-translation");
	}
	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {







>
>
>
>
>
>
>
>
>
>







8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
	    Tcl_DStringEndSublist(dsPtr);
	}
	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(1, "-strictencoding")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-strictencoding");
	}
	Tcl_DStringAppendElement(dsPtr,
		(flags & CHANNEL_ENCODING_STRICT) ? "1" : "0");
	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(1, "-translation")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-translation");
	}
	if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
		(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
8220
8221
8222
8223
8224
8225
8226










8227
8228
8229
8230
8231
8232
8233
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;










	return TCL_OK;
    } else if (HaveOpt(1, "-translation")) {
	const char *readMode, *writeMode;

	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}







>
>
>
>
>
>
>
>
>
>







8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	return TCL_OK;
    } else if (HaveOpt(1, "-strictencoding")) {
	int newMode;

	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (newMode) {
	    statePtr->flags |= CHANNEL_ENCODING_STRICT;
	}
	return TCL_OK;
    } else if (HaveOpt(1, "-translation")) {
	const char *readMode, *writeMode;

	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}

Changes to generic/tclIO.h.

269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
					 * to get a complete character. When
					 * set, file events will not be
					 * delivered for buffered data until
					 * the state of the channel
					 * changes. */
#define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
					 * being used. */


#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on







|
>







269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
					 * to get a complete character. When
					 * set, file events will not be
					 * delivered for buffered data until
					 * the state of the channel
					 * changes. */
#define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
					 * being used. */
#define CHANNEL_ENCODING_STRICT	(1<<18)	/* set if option
					 * -strictencoding is set to 1 */
#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on

Changes to tests/cmdAH.test.

17
18
19
20
21
22
23

24
25
26
27
28
29
30

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

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]

testConstraint time64bit [expr {
    $::tcl_platform(pointerSize) >= 8 ||
    [llength [info command testsize]] && [testsize st_mtime] >= 8
}]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0







>







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

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

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint time64bit [expr {
    $::tcl_platform(pointerSize) >= 8 ||
    [llength [info command testsize]] && [testsize st_mtime] >= 8
}]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208







|







175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    encoding system iso8859-1
    encoding convertto jis0208 乎
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208







|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    encoding system iso8859-1
    encoding convertto jis0208 乎
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208
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
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertto -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertto -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertto -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertto -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertfrom -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertfrom -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertto -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertto -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.19.1 {convertrom -failindex with correct data} -body {
    encoding convertfrom -failindex test ABC
    set test
} -returnCodes 0 -result -1
test cmdAH-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup {







|


|








|


|


|


|


|







|




|







|







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
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertto -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body {
    encoding convertto -failindex 2 -nocomplain ABC
} -returnCodes 1 -result {unknown encoding "-nocomplain"}
test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertto -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertto -failindex 2 -nocomplain utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertfrom -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertfrom -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertto -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
    proc encoding_test {} {
        encoding convertto -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.19.1 {convertrom -failindex with correct data} -body {
    encoding convertfrom -failindex test ABC
    set test
} -returnCodes 0 -result -1
test cmdAH-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup {
345
346
347
348
349
350
351



















352
353
354
355
356
357
358
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result {41 1} -cleanup {
    rename encoding_test ""
}




















test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, tildeexpand, type, volumes, or writable}







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







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result {41 1} -cleanup {
    rename encoding_test ""
}
test cmdAH-4.22 {convertfrom -strict} -body {
    encoding convertfrom -strict utf-8 A\x00B
} -result A\x00B

test cmdAH-4.23 {convertfrom -strict} -body {
    encoding convertfrom -strict utf-8 A\xC0\x80B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\xC0'}

test cmdAH-4.24 {convertto -strict} -body {
    encoding convertto -strict utf-8 A\x00B
} -result A\x00B

test cmdAH-4.25 {convertfrom -strict} -constraints knownBug -body {
    encoding convertfrom -strict utf-8 A\x80B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'}

test cmdAH-4.26 {convertto -strict} -constraints {testbytestring knownBug} -body {
    encoding convertto -strict utf-8 A[testbytestring \x80]B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'}

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, tildeexpand, type, volumes, or writable}

Changes to tests/encoding.test.

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
    string length [encoding convertfrom -nocomplain "\x20"]
} 1
test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
    string length [encoding convertto -nocomplain "\x20"]
} 1
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"}

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {







|


|







665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
    string length [encoding convertfrom -nocomplain "\x20"]
} 1
test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
    string length [encoding convertto -nocomplain "\x20"]
} 1
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {

Changes to tests/ioCmd.test.

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
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo







|











|









|







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
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -strictencoding 0 -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -strictencoding 0 -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -strictencoding 0 -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar foo -snarf x"
    }
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]







|








|











|







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -strictencoding 0 -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -strictencoding 0 -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar foo -snarf x"
    }
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -strictencoding 0 -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]

Changes to tests/safe.test.

1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
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
} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}








|








|












|








|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
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
} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

Changes to tests/socket.test.

1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
} -result {3 1 0}
test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
    set s [socket -server accept -myaddr $localhost 0]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} -result 14
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    proc accept {s a p} {
	global x







|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
} -result {3 1 0}
test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
    set s [socket -server accept -myaddr $localhost 0]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} -result 16
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    proc accept {s a p} {
	global x

Changes to tests/zlib.test.

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
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    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 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
test zlib-8.7 {transformation and fconfigure} -setup {
    set file [makeFile {} test.gz]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    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 {







|









|







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
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -translation lf}}
test zlib-8.7 {transformation and fconfigure} -setup {
    set file [makeFile {} test.gz]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -strictencoding 0 -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 {