ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.10

Browse Source
This commit is contained in:
Steve Dower
2020-09-24 22:53:56 +01:00
parent 0343d03b22
commit 3bb8e3e086
1005 changed files with 593700 additions and 41637 deletions
Download Patch File Download Diff File Expand all files Collapse all files

97
tests/chanio.test
View File

@@ -13,16 +13,11 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# TODO: This test is likely worthless. Confirm and remove
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testbytestring [llength [info commands testbytestring]]
namespace eval ::tcl::test::io {
namespace import ::tcltest::*
@@ -35,18 +30,20 @@ namespace eval ::tcl::test::io {
variable msg
variable expected
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch {
::tcltest::loadTestedCommands
package require -exact Tcltest [info patchlevel]
set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}
package require tcltests
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
testConstraint fileevent [llength [info commands fileevent]]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
# You need a *very* special environment to do some tests. In particular,
# many file systems do not support large-files...
@@ -130,10 +127,10 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
# Executing this test without the fix for the referenced bug applied to
# tcl will cause tcl, more specifically WriteChars, to go into an infinite
# loop.
set f [open $path(test2) w]
chan configure $f -encoding iso2022-jp
chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
chan close $f
set f [open $path(test2) w]
chan configure $f -encoding iso2022-jp
chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
chan close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
@@ -248,7 +245,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
test chan-io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
chan configure $f -encoding jis0208 -buffersize 16
chan configure $f -encoding jis0208 -buffersize 16
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -259,7 +256,7 @@ test chan-io-3.5 {WriteChars: saved != 0} {
# be moved to beginning of next channel buffer to preserve requested
# buffersize.
set f [open $path(test1) w]
chan configure $f -encoding jis0208 -buffersize 17
chan configure $f -encoding jis0208 -buffersize 17
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -288,7 +285,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# on flush. The truncated bytes are moved to the beginning of the next
# channel buffer.
set f [open $path(test1) w]
chan configure $f -encoding jis0208 -buffersize 17
chan configure $f -encoding jis0208 -buffersize 17
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -353,7 +350,7 @@ test chan-io-4.5 {TranslateOutputEOL: crlf} {
test chan-io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
chan configure $f
chan configure $f
chan puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
chan close $f
@@ -441,7 +438,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
# if (dst >= dstEnd)
# if (dst >= dstEnd)
set f [open $path(test1) w]
chan puts $f $a
chan puts $f hi
@@ -750,7 +747,7 @@ test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body {
chan close $f
} -result [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
# not (*eol == '\n')
# not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -860,7 +857,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
@@ -871,14 +868,14 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
} -constraints {stdio testchannel openpipe fileevent} -body {
# not (*eol == '\n')
# not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "abcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
@@ -957,7 +954,7 @@ test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {test
chan close $f
} -result {123456 0 8 78901}
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
# not (*eol == '\n')
# not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\r78901"
@@ -1183,7 +1180,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st
chan close $f
} -result {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
chan puts -nonewline $f "abcdefghijklmno\r"
@@ -1423,7 +1420,7 @@ test chan-io-13.2 {TranslateInputEOL: crlf mode} -body {
chan close $f
} -result "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\r"
@@ -1435,7 +1432,7 @@ test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
chan close $f
} -result "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\rfgh"
@@ -1447,7 +1444,7 @@ test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
chan close $f
} -result "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\nfgh"
@@ -1515,7 +1512,7 @@ test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body {
chan close $f
} -result "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
# not (*src == '\r')
# not (*src == '\r')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\ndef"
@@ -1884,7 +1881,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
} -constraints {stdio openpipe} -body {
} -constraints {stdio openpipe knownMsvcBug} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -2028,7 +2025,7 @@ test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup {
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
file delete $path(test1)
set l ""
} -constraints {unixOrPc} -body {
} -constraints {unixOrWin} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -buffersize 60 -eofchar {}
lappend l [file size $path(test1)]
@@ -2794,7 +2791,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
chan puts $s $l
}
}
} -constraints {socket tempNotMac fileevent} -body {
} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
proc accept {s a p} {
variable x
chan event $s readable [namespace code [list readit $s]]
@@ -2820,7 +2817,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
chan close $cs
chan close $ss
vwait [namespace which -variable x]
return $c
set c
} -result 2000
test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup {
catch {interp delete x}
@@ -3901,7 +3898,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
}
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf
chan configure $f -translation crlf
while {[chan gets $f line] >= 0} {
append c $line\n
}
@@ -5163,7 +5160,7 @@ test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
chan configure $f -encoding {}
chan puts -nonewline $f \xe7\x89\xa6
chan close $f
set f [open $path(test1) r]
@@ -5308,7 +5305,7 @@ test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
writable so we can't change -eofchar or -translation} -setup {
set l [list]
} -body {
} -body {
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
chan configure $sock -eofchar D -translation lf
lappend l [chan configure $sock -eofchar] \
@@ -5461,7 +5458,7 @@ test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
set x [list [catch {chan gets $f} msg] $msg]
chan close $f
lappend x [viewFile test3]
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
file delete $path(test3)
open $path(test3) RDWR
@@ -5866,6 +5863,8 @@ test chan-io-47.6 {file events on shared files, deleting file events} -setup {
testfevent delete
chan close $f
} -result {{script 1} {}}
unset path(foo)
removeFile foo
set path(bar) [makeFile {} bar]
@@ -5961,6 +5960,9 @@ test chan-io-48.3 {testing readability conditions} -setup {
} -cleanup {
chan close $f
} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
unset path(bar)
removeFile bar
test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
file delete $path(test1)
set c 0
@@ -7031,7 +7033,7 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
vwait ::forever
catch {after cancel $token}
# Report
return $::RES
set ::RES
} -cleanup {
chan close $f
chan close $g
@@ -7231,7 +7233,7 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} {
for {set i 0} {$i < 10} {incr i} {
if {![catch {
set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
}]} then {
}]} {
set done 1
break
}
@@ -7303,7 +7305,7 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup {
chan close $writer
chan close $s
after cancel $after
return $counter
set counter
} -cleanup {
if {$accept ne {}} {chan close $accept}
} -result 1
@@ -7330,7 +7332,7 @@ test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
chan event $f writable [namespace code [list eventScript $f]]
variable x not_done
vwait [namespace which -variable x]
return $x
set x
} -cleanup {
interp bgerror {} $handler
} -result {got_error}
@@ -7375,7 +7377,7 @@ test chan-io-57.1 {buffered data and file events, gets} -setup {
vwait [namespace which -variable result]
lappend result [chan gets $s2]
vwait [namespace which -variable result]
return $result
set result
} -cleanup {
chan close $s
chan close $s2
@@ -7400,14 +7402,14 @@ test chan-io-57.2 {buffered data and file events, read} -setup {
vwait [namespace which -variable result]
lappend result [chan read $s2 9]
vwait [namespace which -variable result]
return $result
set result
} -cleanup {
chan close $s
chan close $s2
chan close $server
} -result {1 readable 234567890 timer}
test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
set out [open $path(script) w]
chan puts $out {
chan puts "normal message from pipe"
@@ -7448,6 +7450,7 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
chan puts $out {
chan puts [testbytestring \xe2]
exit 1