Diff
Not logged in

Differences From Artifact [d5ed1dbc5a]:

To Artifact [7d03fa2af9]:


9946
9947
9948
9949
9950
9951
9952















































































9953
9954
9955
9956
9957
9958
9959
9946
9947
9948
9949
9950
9951
9952
9953
9954
9955
9956
9957
9958
9959
9960
9961
9962
9963
9964
9965
9966
9967
9968
9969
9970
9971
9972
9973
9974
9975
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
9987
9988
9989
9990
9991
9992
9993
9994
9995
9996
9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038







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







    removeFile $scriptFile
} -body {
    set fd [open |[list [info nameofexecutable] $scriptFile r+]]
    fconfigure $fd -encoding utf-8 -profile replace
    read $fd
} -result a\uFFFDb

proc read_blocked {args} {
    global e
    set timer [after 10000 {set ::e timeout}]
    set e ""
    set l 1; if {[llength $args] > 1} {set l [lindex $args 1]}
    try {
	while {[string length $e] < $l} {
	    append e [read {*}$args]
	    after 10; update
	}
	set e
    } finally {
	after cancel $timer
	unset -nocomplain e
    }
}
test io-bug-73bb42fb-1 {
    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
    Verify error at offset 0.
} -setup {
    writeFile $path(test1) binary \xD6[string repeat _ 20]
} -body {
    set fd [open $path(test1)]
    fconfigure $fd -encoding utf-8 -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
    list [catch {read_blocked $fd 1} e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""] [tell $fd]
} -cleanup {
    close $fd
} -match glob -result {1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} 0}

test io-bug-73bb43fb-2 {
    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
    Verify valid data returned before error generated.
} -setup {
    writeFile $path(test1) binary X\xD6[string repeat _ 20]
} -body {
    set fd [open $path(test1)]
    fconfigure $fd -encoding utf-8 -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
    set result {}
    lappend result [read_blocked $fd]
    lappend result [tell $fd]
    lappend result [catch {read_blocked $fd} e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""] [tell $fd]
} -cleanup {
    close $fd
} -match glob -result {X 1 1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} 1}

test io-bug-73bb43fb-3 {
    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
    Modified Sergey's repro script from ticket. Check no crash / error.
} -setup {
    set f ""
} -body {
    set f [open [list | [info nameofexecutable] << {fconfigure stdout -translation binary; puts \xD6[string repeat _ 20]}]]
    fconfigure $f -encoding utf-8 -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
    list [catch { read_blocked $f } e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""]
} -cleanup {
    if {$f ne ""} {close $f}
} -match glob -result {1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}}

test io-bug-73bb43fb-4 {
    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
    (PoC) Delay between bytes of single utf-8 char doesn't cause encoding error with profile strict.
} -setup {
    set f ""
} -body {
    set f [open [list | [info nameofexecutable] << {
      fconfigure stdout -translation binary
      puts -nonewline "START-"; flush stdout
      foreach {ch} [split [encoding convertto utf-8 \u30B3] ""] {; # 3 bytes E3 82 B3
        puts -nonewline $ch; flush stdout; if {$ch ne "\xB3"} {after 100}
      }
      puts -nonewline "-DONE"; flush stdout
    }]]
    fconfigure $f -encoding utf-8 -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
    list [catch { read_blocked $f 12 } e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""]
} -cleanup {
    if {$f ne ""} {close $f}
} -result "0 START-\u30B3-DONE 0 {}"

rename read_blocked {}

# cleanup
foreach file [list fooBar longfile script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests