Tcl Source Code

		RecycleBuffer(statePtr, bufPtr, 0);
		statePtr->inQueueHead = nextPtr;
		if (nextPtr == NULL) {
		    statePtr->inQueueTail = NULL;
		}
	    }

	    /*
	     * If CHANNEL_ENCODING_ERROR and CHANNEL_STICKY_EOF are both set,
	     * then CHANNEL_ENCODING_ERROR was caused by data that occurred
	     * 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)) {
		/* Channel is blocking.  Return an error so that callers
		 * like [read] can return an error.
		*/
		Tcl_SetErrno(EILSEQ);
		goto finish;
	    }
	}

	if (copiedNow < 0) {
	    if (GotFlag(statePtr, CHANNEL_EOF)) {
		break;
	    }
	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)

	    }
	} else {
	    copied += copiedNow;
	    toRead -= copiedNow;
	}
    }

finish:
    /*
     * Failure to fill a channel buffer may have left channel reporting a
     * "blocked" state, but so long as we fulfilled the request here, the
     * caller does not consider us blocked.
     */

    if (toRead == 0) {

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);
    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
	Tcl_SetErrno(EILSEQ);
	copied = -1;
    }
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copied;
}

/*
 *---------------------------------------------------------------------------
 *

    *srcLenPtr = srcLen;

    if (srcStart + srcLen == eof) {
	/*
	 * EOF character was seen in EOL translated range. Leave current file
	 * position pointing at the EOF character, but don't store the EOF
	 * character in the output string.
	 *
	 * If CHANNEL_ENCODING_ERROR is set, it can only be because of data
	 * encountered after the EOF character, so it is nonsense.  Unset it.
	 */

	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
	ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR|CHANNEL_ENCODING_ERROR);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Ungets --

    fconfigure $f -encoding binary
    puts -nonewline $f "A\xC0"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -profile tcl8
} -body {
    set d [read $f]

    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.3
} -result 41c0

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.4]

    fconfigure $f -encoding binary
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
    set d [read $f]

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

test io-75.6 {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 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 {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -returnCodes 1 -result {error reading "*": illegal byte sequence}

test io-75.7 {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 {
    read $f
} -cleanup {
    close $f
    removeFile io-75.7
} -match glob -returnCodes 1 -result {error reading "*": illegal byte sequence}

test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes precedence.
    puts -nonewline $f A\x1A\x81

    fconfigure $f -encoding binary
    puts -nonewline $f A\xC0
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none
} -body {
    set d [read $f]

    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.10
} -result 41c0
# The current result returns the orphan byte as byte.
# This may be expected due to special utf-8 handling.

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
    set fn [makeFile {} io-75.11]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f A\x81\xFFA
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -blocking 0 -eofchar "" -translation lf -profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {set d [read $f]} msg]
    lappend hd $msg
} -cleanup {
    close $f

    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 -blocking 0 -eofchar "" -translation lf -profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {read $f} msg]
    lappend hd $msg
} -cleanup {
    close $f