Tcl Source Code

 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_STRICT   0x02000000
#define TCL_ENCODING_PROFILE_REPLACE  0x03000000

#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_STRICT




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

)
{
    static const char *const options[] = {"-profile", "-failindex", NULL};
    enum convertfromOptions { PROFILE, FAILINDEX } optIndex;
    Tcl_Encoding encoding;
    Tcl_Obj *dataObj;
    Tcl_Obj *failVarObj;
    int profile = TCL_ENCODING_PROFILE_STRICT;

    /*
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) ?options? encoding data			-> objc >= 3
     * It is intentional that specifying option forces encoding to be
     * specified. Less prone to user error. This should have always been

    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_ExternalToUtfDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}

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

	strcpy(tmp, chanName);
    } else {
	tmp = (char *)Tcl_Alloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;
	/* uncomment this to make default encoding error handling strict */
	/*
    statePtr->flags |= CHANNEL_ENCODING_STRICT;
	*/
    statePtr->maxPerms = mask; /* Save max privileges for close callback */

    /*
     * Set the channel to system default encoding.
     *
     * Note the strange bit of protection taking place here. If the system
     * encoding name is reported back as "binary", something weird is
     * happening. Tcl provides no "binary" encoding, so someone else has
     * provided one. We ignore it so as not to interfere with the "magic"
     * interpretation that Tcl_Channels give to the "-encoding binary" option.
     */

    name = Tcl_GetEncodingName(NULL);
    statePtr->encoding = Tcl_GetEncoding(NULL, name);
    statePtr->inputEncodingState  = NULL;
    statePtr->inputEncodingFlags  = TCL_ENCODING_START;
    ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
			     TCL_ENCODING_PROFILE_DEFAULT);
    statePtr->outputEncodingState = NULL;
    statePtr->outputEncodingFlags = TCL_ENCODING_START;
    ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
			     TCL_ENCODING_PROFILE_DEFAULT);

    /*
     * Set the channel up initially in AUTO input translation mode to accept
     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
     * specific default value. The eofChar is set to 0 for both input and
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
     * ^Z) and does not append an EOF indicator to files.

#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	/* TODO: UpdateInterest not needed here? */
	UpdateInterest(chanPtr);

	Tcl_SetErrno(EILSEQ);
	return -1;
    }
    /*
     * Early out when next read will see eofchar.
     *
     * NOTE: See DoRead for argument that it's a bug (one we're keeping) to

	     * after the EOF character was encountered, so it doesn't count as
	     * a real error.
	     */

	    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
		    && !GotFlag(statePtr, CHANNEL_STICKY_EOF)
		    && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
		copied = -1;
		goto finish;
	    }
	}

	if (copiedNow < 0) {
	    if (GotFlag(statePtr, CHANNEL_EOF)) {
		break;

	 * like [read] can also return an error.
	*/
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	Tcl_SetErrno(EILSEQ);
	copied = -1;
    }
    TclChannelRelease((Tcl_Channel)chanPtr);
    if (copied == TCL_INDEX_NONE) {
	ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
    }
    return copied;
}

/*
 *---------------------------------------------------------------------------
 *
 * ReadBytes --

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    Tcl_Size lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr, *resultDictPtr, *returnOptsPtr;
    int code = TCL_OK;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];

    }

    TclChannelPreserve(chan);
    TclNewObj(linePtr);
    lineLen = Tcl_GetsObj(chan, linePtr);
    if (lineLen == TCL_IO_FAILURE) {
	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {


	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */

	    if (!TclChanCaughtErrorBypass(interp, chan)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading \"%s\": %s",
			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	    }
	    resultDictPtr = Tcl_NewDictObj();
	    Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
	    , linePtr);
	    returnOptsPtr = Tcl_NewDictObj();
	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
	    , resultDictPtr);
	    code = TCL_ERROR;
	    Tcl_SetReturnOptions(interp, returnOptsPtr);
	    goto done;
	}
	lineLen = TCL_IO_FAILURE;
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {

    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    Tcl_WideInt toRead;			/* How many bytes to read? */
    Tcl_Size charactersRead;		/* How many characters were read? */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;

    if ((objc != 2) && (objc != 3)) {
	Interp *iPtr;

    argerror:
	iPtr = (Interp *) interp;
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");

	}
    }

    TclNewObj(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead == TCL_IO_FAILURE) {

	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	resultDictPtr = Tcl_NewDictObj();
	Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
	    , resultPtr);
	returnOptsPtr = Tcl_NewDictObj();
	Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
	    , resultDictPtr);
	TclChannelRelease(chan);
	Tcl_SetReturnOptions(interp, returnOptsPtr);
	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if (encodingName == NULL) {
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp,chan,0);
	return result;
    }
    if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
	    != TCL_OK) {
	Tcl_CloseEx(interp,chan,0);
	return result;
    }

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);

    /*
     * Read first character of stream to check for utf-8 BOM

	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)



	    ##Log socket opened, DONE fconfigure - token $token
        }

        Log "Using $sock for $state(socketinfo) - token $token" \
	    [expr {$state(-keepalive)?"keepalive":""}]

        # Code above has set state(sock) $sock

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)




    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {

    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)



    Log ^D$tk begin receiving response - token $token

    coroutine ${token}--EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
        fileevent $sock readable [list http::EventGateway $sock $token]
    } else {
        fileevent $sock readable ${token}--EventCoroutine

	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {



		set state(body) [encoding convertfrom $enc $state(body)]

	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
	if {[info exists state(-guesstype)] && $state(-guesstype)} {
	    GuessType $token

            set res $value
        }
    }
    set enc [CharsetToEncoding $res]
    if {$enc eq "binary"} {
        return 0
    }



    set state(body) [encoding convertfrom $enc $state(body)]

    set state(body) [string map {\r\n \n \r \n} $state(body)]
    set state(type) application/xml
    set state(binary) 0
    set state(charset) $res
    return 1
}

    variable http
    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
    # a pre-computed map and [string map] to do the conversion (much faster
    # than [regsub]/[subst]). [Bug 1020491]




    set string [encoding convertto $http(-urlencoding) $string]

    return [string map $formMap $string]
}

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:

	    stderr -
	    stdout {
		set outputChannel $filename
	    }
	    default {
		set outputChannel [open $filename a]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $outputChannel -encoding utf-8
		}
		set ChannelsWeOpened($outputChannel) 1

		# If we created the file in [temporaryDirectory], then
		# [cleanupTests] will delete it, unless we claim it was
		# already there.
		set outdir [normalizePath [file dirname \

	    stderr -
	    stdout {
		set errorChannel $filename
	    }
	    default {
		set errorChannel [open $filename a]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $errorChannel -encoding utf-8
		}
		set ChannelsWeOpened($errorChannel) 1

		# If we created the file in [temporaryDirectory], then
		# [cleanupTests] will delete it, unless we claim it was
		# already there.
		set outdir [normalizePath [file dirname \

	return [AcceptReadable $file]
    }
    proc ReadLoadScript {args} {
	variable Option
	if {$Option(-loadfile) eq {}} {return}
	set tmp [open $Option(-loadfile) r]
	if {[package vsatisfies [package provide Tcl] 8.7-]} {
	    fconfigure $tmp -encoding utf-8
	}
	loadScript [read $tmp]
	close $tmp
    }
    Option -loadfile {} {
	Read the script to load the tested commands from the specified file.
    } AcceptLoadFile loadFile

    if {$n2 eq {}} {return}
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}


# tcltest::Asciify --
#
#       Transforms the passed string to contain only printable ascii characters.
#       Useful for printing to terminals. Non-printables are mapped to
#       \x, \u or \U sequences.
#

	set code
    }

    ConstraintInitializer stdio {
	set code 0
	if {![catch {set f [open "|[list [interpreter]]" w]}]} {
	    if {[package vsatisfies [package provide Tcl] 8.7-]} {
		fconfigure $f -encoding utf-8
	    }
	    if {![catch {puts $f exit}]} {
		if {![catch {close $f}]} {
		    set code 1
		}
	    }
	}

	    set testFile [dict get $testFrame file]
	    set testLine [dict get $testFrame line]
	} else {
	    set testFile [file normalize [uplevel 1 {info script}]]
	    if {[file readable $testFile]} {
		set testFd [open $testFile r]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $testFd -encoding utf-8
		}
		set testLine [expr {[lsearch -regexp \
			[split [read $testFd] "\n"] \
			"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
		close $testFd
	    }
	}

	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {

	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"



	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n[Asciify $result]"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"

		lappend childargv $opt $value
	    }
	    set cmd [linsert $childargv 0 | $shell $file]
	    if {[catch {
		incr numTestFiles
		set pipeFd [open $cmd "r"]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $pipeFd -encoding utf-8
		}
		while {[gets $pipeFd line] >= 0} {
		    if {[regexp [join {
			    {^([^:]+):\t}
			    {Total\t([0-9]+)\t}
			    {Passed\t([0-9]+)\t}
			    {Skipped\t([0-9]+)\t}

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    fconfigure $fd -translation lf
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $fd -encoding utf-8
    }
    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd

    FillFilesExisted
    if {[llength [info level 0]] == 2} {
	set directory [temporaryDirectory]
    }
    set fullName [file join $directory $name]
    set f [open $fullName]
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $f -encoding utf-8
    }
    set data [read -nonewline $f]
    close $f
    return $data
}

# tcltest::bytestring --

    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

#
# encoding convertfrom 4.3.*

# Odd number of args is always invalid since last two args
# are ENCODING DATA and all options take a value
badnumargs cmdAH-4.3.1 {encoding convertfrom} {}
badnumargs cmdAH-4.3.2 {encoding convertfrom} {-failindex VAR ABC}

    fconfigure $f -encoding iso2022-jp
    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]

test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
    string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC1\xBF"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {

} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.13 {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xC1\xBF"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.14 {Parse valid utf-8} {
    expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"}
} 1
test encoding-24.15.default {Parse invalid utf-8, default} -body {
    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80"
} -result Z\xE0\u20AC
test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\u4343\x80"]
} -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)}
test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80"]
} -result "Z\xC3\xA0\xE2\x82\xAC"
test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"]
} -result "Z\xC3\xA0\xE2\x82\xACxxxxxx"
test encoding-24.19.1 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile tcl8 utf-8 "ZX\uD800"
} -result ZX\xED\xA0\x80
test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile strict utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.19.3 {Parse valid or invalid utf-8} -body {
    encoding convertto utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body {
    encoding convertfrom -profile tcl8 "\x20"
} -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error
test encoding-24.21 {Parse with -profile tcl8 but without providing encoding} -body {
    string length [encoding convertto -profile tcl8 "\x20"]
} -result {wrong # args: should be "::tcl::encoding::convertto ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertto data"} -returnCodes error

} -result \uFFFF
test encoding-24.30 {Parse noncharacter with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.33 {Try to generate invalid utf-8} -body {
    encoding convertto utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.33 {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body {
    encoding convertto -profile tcl8 utf-8 \uFFFF

# This file contains test vectors for verifying various encodings. They are
# stored in a common file so that they can be sourced into the various test
# modules that are dependent on encodings. This file contains statically defined
# test vectors. In addition, it sources the ICU-generated test vectors from
# icuUcmTests.tcl.
#
# Note that sourcing the file will reinitialize any existing encoding test
# vectors.
#

# List of defined encoding profiles
set encProfiles {tcl8 strict replace}
set encDefaultProfile strict; # Should reflect the default from implementation

# encValidStrings - Table of valid strings.
#
# Each row is <ENCODING STR BYTES CTRL COMMENT>
# The pair <ENCODING,STR> should be unique for generated test ids to be unique.
# STR is a string that can be encoded in the encoding ENCODING resulting
# in the byte sequence BYTES. The CTRL field is a list that controls test

    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} 160


apply [list {} {
    set template {
	test {io-12.9 @variant@} {ReadChars: multibyte chars split, default (strict)} -body {
	    set res {}
	    set f [open $path(test1) w]
	    fconfigure $f -translation binary
	    puts -nonewline $f [string repeat a 9]\xC2
	    close $f
	    set f [open $path(test1)]
	    fconfigure $f -encoding utf-8 @strict@ -buffersize 10
	    set status [catch {read $f} cres copts]
	    set in [dict get $copts -result]
	    lappend res $in
	    lappend res $status $cres
	    set status [catch {read $f} cres copts]
	    set in [dict get $copts -result]
	    lappend res $in
	    lappend res $status $cres
	    set res
	} -cleanup {
	    catch {close $f}
	} -match glob -result {{read aaaaaaaaa} 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}\
		{read {}} 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}}
    }

	# if default encoding is not currently to strict
    # foreach variant {default encodingstrict} strict {{} {-encodingstrict 1}} 
    foreach variant {{profile strict}} strict {{-profile strict}} {
	set script [string map [
	    list @variant@ $variant @strict@ $strict] $template] 
	uplevel 1 $script
    }
} [namespace current]]



test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10
    set in [read $f]
    read $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194

test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile strict -buffersize 10

    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
	writable so we can't change -eofchar or -translation } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    fconfigure $sock -eofchar D -translation lf
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}

    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.5
} -result 4181

test io-75.6.read {invalid utf-8 encoding, read is not ignored (-encodingstrict 1)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf \
	-profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd $status $cres
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -result {41 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character}}


test io-75.6.gets {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is an incomplete byte sequence in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
	    -translation lf -profile strict
} -body {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.7.gets {
    invalid utf-8 encoding gets is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
	    -profile strict
} -body {
    list [catch {read $f} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.7
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\xA1\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd [eof $f]
    lappend hd $status
    lappend hd $cres
    fconfigure $f -encoding iso8859-1
    lappend hd [read $f];# We changed encoding, so now we can read the \xA1
    close $f
    set hd
} -cleanup {
    removeFile io-75.7
} -match glob -result {41 0 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} ¡}

test io-75.8.incomplete {
    incomplete uft-8 char after eof char is not an error (-profile strict)
} -setup {
    set hd {}
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -encoding binary
	# \x81 is invalid in utf-8, but since the eof character \x1A comes first,
	# -eofchar takes precedence.
    puts -nonewline $f A\x1A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [eof $f]
    # there should be no error on additional reads
    lappend hd [read $f]
    close $f
    set hd
} -cleanup {
    removeFile io-75.8
} -result {41 1 {}}


test {io-75.8 {invalid after eof}} {
	invalid utf-8 after eof char is not an error (-profile strict)
} -setup {
    set res {}
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \xc0\x80 is invalid utf-8 data, but because the eof character \x1A
    # appears first, it's not an error.
    puts -nonewline $f A\x1a\xc0\x80
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set d [read $f]
    foreach char [split $d {}] {
	lappend res [format %x [scan $char %c]]
    }
    lappend res [eof $f]
    # there should be no error on additional reads
    lappend res [read $f]
    close $f
    set res
} -cleanup {
    removeFile io-75.8
} -result {41 1 {}}


test {io-75.8 {invalid before eof}} {
	invalid utf-8 encoding eof handling (-profile strict)
} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    # This also configures the channel encoding profile as strict.
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\x81\x81\x1A
    flush $f

} -body {
    list [catch {read $chan 1} cres] $cres
} -cleanup {
    close $chan
    unset res
} -match glob -result {1 {error reading "*":\
    invalid or incomplete multibyte or wide character}}


test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
    set fn [makeFile {} io-75.9]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1 -profile strict
} -body {
    catch {puts -nonewline $f "A\u2022"} msg
    flush $f
    seek $f 0
    list [read $f] $msg
} -cleanup {
    close $f
    removeFile io-75.9
} -match glob -result [list {A} {error writing "*":\
    invalid or incomplete multibyte or wide character}]

apply [list {} {
    set template {
	test {io-75.10 ${mode}} {
	    incomplete multibyte encoding read is an error
	} -setup {
	    set res {}
	    set fn [makeFile {} io-75.10]
	    set f [open $fn w+]
	    fconfigure $f -encoding binary
	    puts -nonewline $f A\xC0
	    flush $f
	    seek $f 0
	    fconfigure $f -encoding utf-8 -buffering none {*}${option}
	} -body {
	    set status [catch {read $f} cres copts]
	    set d [dict get $copts -result read]
	    close $f
	    binary scan $d H* hd
	    lappend res $hd
	    lappend res $status
	    lappend res $cres
	    return $res
	} -cleanup {
	    removeFile io-75.10
	} -match glob -result {41 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}}
    }
	# the default encoding mode is not currently strict
    #foreach mode {default strict} option {{} {-encodingstrict 1}} 
    foreach mode {{profile strict}} option {{-profile strict}} {
	set test [string map [
	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
	uplevel $test
    }
} [namespace current]]
test {io-75.10 {profile tcl8}} {
    incomplete multibyte encoding read is not ignored because "binary" sets
    profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.10]
    set f [open $fn w+]
    fconfigure $f -encoding binary

    lappend hd [catch {set d [read $f]} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.11
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}


apply [list {} {
    set template {
	test {io-75.12 ${mode}} {invalid utf-8 encoding read returns an error} -setup {
	    set res {}
	    set fn [makeFile {} io-75.12]
	    set f [open $fn w+]
	    fconfigure $f -encoding binary
	    puts -nonewline $f A\x81
	    flush $f
	    seek $f 0
	    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
		    -translation lf {*}${option}
	} -body {
	    set status [catch {read $f} cres copts]
	    set d [dict get $copts -result read]
	    close $f
	    binary scan $d H* hd
	    lappend res $hd $status $cres
	    return $res
	} -cleanup {
	    removeFile io-75.12
	} -match glob -result {41 1 {error reading "file*":\
		invalid or incomplete multibyte or wide character}}
    }

    # the default encoding mod is not currently strict
    #foreach mode {default strict} option {{} {-encodingstrict 1}}
    foreach mode {{profile strict}} option {{-profile strict}} {
	set test [string map [
	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
	uplevel $test
    }
} [namespace current]]


test {io-75.12 {profile tcl8}} {
    invalid utf-8 encoding read, is not ignored because setting the encoding to
    "binary" also sets the profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.12]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
	-translation lf
} -body {
    catch {read $f} errmsg
    lappend res $errmsg
    chan configure $f -profile tcl8
    seek $f 0
    set d [read $f]
    binary scan $d H* hd
    lappend res $hd
    return $res
} -cleanup {
    close $f
    removeFile io-75.12
    unset res
} -match glob -result {{error reading "file*":\
    invalid or incomplete multibyte or wide character} 4181}
test io-75.13 {
    In blocking mode [read] produces an error and leaves the data succesfully
    read so far in the return options dictionary.
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -eofchar "" -translation lf -profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd $status
    lappend hd $cres
} -cleanup {
    close $f
    removeFile io-75.13
} -match glob -result {41 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character}}
test io-75.13.nonblocking {
    In nonblocking mode when there is an encoding error the data that has been
    successfully read so far is returned first and then the error is returned
    on the next call to [read].
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -encoding binary

	lappend res [gets $chan]
	lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
    1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}

test io-75.14 {invalid utf-8 encoding [gets] coninues in non-strict mode after error} -setup {
    set res {}
    set fn [makeFile {} io-75.14]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \xc0 is invalid in utf-8
    puts -nonewline $f a\nb\xc0\nc\n
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf -profile strict
} -body {
    lappend res [gets $f]
    set status [catch {gets $f} cres copts]
    lappend res $status $cres
    chan configure $f -profile tcl8 
    lappend res [gets $f]
    lappend res [gets $f]
    close $f
    return $res
} -cleanup {
    removeFile io-75.14
} -match glob -result {a 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} bÀ c}


test io-75.15 {invalid utf-8 encoding strict gets should not hang} -setup {
    set res {}
    set fn [makeFile {} io-75.15]
    set chan [open $fn w+]
    fconfigure $chan -encoding binary
    # This is not valid UTF-8
    puts $chan hello\nAB\xc0\x40CD\nEFG
    close $chan
} -body {
    #Now try to read it with [gets]
    set chan [open $fn]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
    set status [catch {gets $chan} cres copts]
    lappend res $status $cres
	lappend res [dict get $copts -result]
	chan configure $chan -encoding binary
	foreach char [split [read $chan 2] {}] {
	    lappend res [format %x [scan $char %c]]
	}
    return $res
} -cleanup {
    close $chan
    removeFile io-75.15
} -match glob -result {hello 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} {read AB} 41 42}

# ### ### ### ######### ######### #########



test io-76.0 {channel modes} -setup {
    set datafile [makeFile {some characters} dummy]

    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -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 {} -profile * -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {