summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-08-03 15:46:27 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-08-03 15:46:27 (GMT)
commit0f06b1b667747553dfcac3b037cd6d5fe2cf262d (patch)
tree56abd292390e485e4fe3a5cce515b842d9ff646b /tests
parentc1c4367262900750366b547390eeccc185677242 (diff)
parentca51d20173c55f80a6d14a618d3d95880fb0e4f7 (diff)
downloadtcl-0f06b1b667747553dfcac3b037cd6d5fe2cf262d.zip
tcl-0f06b1b667747553dfcac3b037cd6d5fe2cf262d.tar.gz
tcl-0f06b1b667747553dfcac3b037cd6d5fe2cf262d.tar.bz2
Merge 8.6
Diffstat (limited to 'tests')
-rw-r--r--tests/chanio.test17
-rw-r--r--tests/io.test135
2 files changed, 85 insertions, 67 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index 67e0f24..07a0d8d 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5642,7 +5642,9 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
catch {chan close $f2}
catch {chan close $f3}
} -result {bad-write {}}
-test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs openpipe fileevent
+} -body {
set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
if {[chan gets $f4 line] < 0} {
@@ -5655,9 +5657,10 @@ test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- chan close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ chan close $f4
+} -result {initial foo eof}
chan close $f
makeFile "foo bar" foo
@@ -6382,7 +6385,7 @@ test chan-io-50.1 {testing handler deletion} -setup {
}]
variable z not_called
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result called
@@ -6450,7 +6453,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
variable u toplevel
variable z ""
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
@@ -6484,7 +6487,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {del calling recursive} {del deleted notcalled} \
@@ -6527,7 +6530,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {first called} {first called not toplevel} \
diff --git a/tests/io.test b/tests/io.test
index 7072b63..e2b1a89 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -123,10 +123,10 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
# applied to tcl will cause tcl, more specifically WriteChars, to
# go into an infinite loop.
- set f [open $path(test2) w]
- fconfigure $f -encoding iso2022-jp
- puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
- close $f
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp
+ puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
@@ -192,7 +192,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} {
test io-2.1 {WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -214,7 +214,7 @@ test io-2.3 {WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -234,7 +234,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} {
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -256,7 +256,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -268,7 +268,7 @@ test 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]
- fconfigure $f -encoding jis0208 -buffersize 16
+ fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -280,7 +280,7 @@ test io-3.5 {WriteChars: saved != 0} {
# requested buffersize.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -311,7 +311,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# of the next channel buffer.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -381,7 +381,7 @@ test io-4.5 {TranslateOutputEOL: crlf} {
test io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
- fconfigure $f
+ fconfigure $f
puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
close $f
@@ -470,7 +470,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
- # if (dst >= dstEnd)
+ # if (dst >= dstEnd)
set f [open $path(test1) w]
puts $f $a
@@ -769,7 +769,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel}
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
# eol still equals dstEnd
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -781,8 +781,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -889,7 +889,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "\nabcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -898,7 +898,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
@@ -906,7 +906,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "abcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -959,10 +959,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
-} [list "123456789012345" 15]
+} [list "123456789012345" 15]
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
# PeekAhead() did not get any, so (eol >= dstEnd)
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -975,7 +975,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
@@ -986,8 +986,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
@@ -999,7 +999,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
@@ -1092,7 +1092,7 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
@@ -1201,7 +1201,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x [gets $f]
close $f
- set x
+ set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
@@ -1217,7 +1217,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
- # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
@@ -1574,7 +1574,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} {
set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1587,7 +1587,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1600,7 +1600,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1715,7 +1715,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
- # not (*src == '\r')
+ # not (*src == '\r')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -2064,7 +2064,7 @@ test io-20.1 {Tcl_CreateChannel: initial settings} {
encoding system $old
close $a
set x
-} {ascii}
+} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
@@ -2159,7 +2159,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
-} {}
+} {}
# Test flushing. The functions tested here are FlushChannel.
@@ -3057,7 +3057,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
fconfigure $f -translation crlf
set x [read $f]
close $f
- set x
+ set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
file delete $path(test1)
@@ -3985,7 +3985,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
}
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf
+ fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
@@ -5474,7 +5474,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -encoding {}
+ fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
set f [open $path(test1) r]
@@ -5946,7 +5946,9 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {close $f2}
catch {close $f3}
} -result {bad-write {}}
-test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs openpipe fileevent
+} -body {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
@@ -5959,9 +5961,10 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ close $f4
+} -result {initial foo eof}
close $f
makeFile "foo bar" foo
@@ -6719,8 +6722,9 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
+test io-50.1 {testing handler deletion} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6732,11 +6736,13 @@ test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
}
set z not_called
update
- close $f
set z
-} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result called
+test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6749,12 +6755,14 @@ test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6774,13 +6782,15 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
-} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6800,11 +6810,13 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent non
variable u toplevel
variable z ""
update
- close $f
set z
-} {{delrecursive calling recursive} {delrecursive deleting recursive}}
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6832,12 +6844,14 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent non
set z ""
set u toplevel
update
+ set z
+} -cleanup {
close $f
- set z
-} [list {del calling recursive} {del deleted notcalled} \
+} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6873,9 +6887,10 @@ test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent non
set z ""
set u toplevel
update
- close $f
set z
-} [list {first called} {first called not toplevel} \
+} -cleanup {
+ close $f
+} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
{first after update}]
@@ -8648,11 +8663,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
interp create slave
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
- read [teststringobj get 1]
+ read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
catch {read [teststringobj get 1]}
- read [teststringobj get 2]
+ read [teststringobj get 2]
} -cleanup {
interp delete slave
testobj freeallvars