Attachment "iotest.patch" to
ticket [544546ffff]
added by
dgp
2002-04-16 14:18:46.
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.28
diff -u -r1.28 io.test
--- tests/io.test 4 Mar 2002 22:00:40 -0000 1.28
+++ tests/io.test 16 Apr 2002 07:07:21 -0000
@@ -14,24 +14,26 @@
#
# RCS: @(#) $Id: io.test,v 1.28 2002/03/04 22:00:40 hobbs Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace eval ::tcl::test::io {
+
+ namespace import ::tcltest::cleanupTests
+ namespace import ::tcltest::interpreter
+ namespace import ::tcltest::makeFile
+ namespace import ::tcltest::removeFile
+ namespace import ::tcltest::test
+ namespace import ::tcltest::testConstraint
+ namespace import ::tcltest::viewFile
-tcltest::testConstraint testchannel [string equal testchannel [info commands testchannel]]
+testConstraint testchannel [llength [info commands testchannel]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
-tcltest::testConstraint largefileSupport 0
-
-::tcltest::saveState
+testConstraint largefileSupport 0
removeFile test1
removeFile pipe
-catch {unset u}
-
# set up a long data file for some of the following tests
set f [open longfile w]
@@ -397,7 +399,7 @@
test io-6.7 {Tcl_GetsObj: error in input} {stdio} {
# if (FilterInputBytes(chanPtr, &gs) != 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
puts -nonewline $f "hi\nwould"
flush $f
gets $f
@@ -659,7 +661,7 @@
test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel} {
# (FilterInputBytes() != 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {crlf lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
fconfigure $f -buffersize 16
@@ -798,7 +800,7 @@
test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel} {
# if (chanPtr->flags & INPUT_SAW_CR)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -815,7 +817,7 @@
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel} {
# not (*eol == '\n')
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -832,7 +834,7 @@
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel} {
# Tcl_ExternalToUtf()
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto lf} -buffering none
fconfigure $f -encoding unicode
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
@@ -849,7 +851,7 @@
test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel} {
# memmove()
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -973,21 +975,21 @@
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} {
update
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -buffering none
puts -nonewline $f "foobar"
fconfigure $f -blocking 0
set x {}
- after 500 { lappend x timeout }
- fileevent $f readable { lappend x [gets $f] }
- vwait x
- vwait x
+ after 500 [namespace code { lappend x timeout }]
+ fileevent $f readable [namespace code { lappend x [gets $f] }]
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
fconfigure $f -blocking 1
puts -nonewline $f "baz\n"
- after 500 { lappend x timeout }
+ after 500 [namespace code { lappend x timeout }]
fconfigure $f -blocking 0
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
close $f
set x
} {{} timeout foobarbaz timeout}
@@ -1032,20 +1034,21 @@
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio} {
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
set x {}
proc ready {f} {
- lappend ::x [gets $f line] $line [fblocked $f]
+ variable x
+ lappend x [gets $f line] $line [fblocked $f]
}
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts $f "\x51\x82\x52"
fconfigure $f -encoding shiftjis
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
@@ -1068,26 +1071,27 @@
test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel} {
# not (bufPtr->nextPtr == NULL)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation lf -encoding ascii -buffering none
puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
set x {}
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [gets $f line] $line [testchannel inputbuffered $f]
+ variable x
+ lappend x [gets $f line] $line [testchannel inputbuffered $f]
}
fconfigure $f -encoding unicode -buffersize 16 -blocking 0
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -translation auto -encoding ascii -blocking 1
# here
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 42 15 "123456789012345" 25]
test io-8.3 {PeekAhead: no cached data available} {stdio testchannel} {
# (bytesLeft == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto binary}
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1120,7 +1124,7 @@
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel} {
# (bufPtr->nextAdded < bufPtr->length)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto binary}
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1132,7 +1136,7 @@
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1144,7 +1148,7 @@
test io-8.7 {PeekAhead: cleanup} {stdio testchannel} {
# Make sure bytes are removed from buffer.
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation {auto binary} -buffering none
puts -nonewline $f "abcdefghijklmno\r"
# here
@@ -1310,24 +1314,25 @@
test io-12.4 {ReadChars: split-up char} {stdio testchannel} {
# (srcRead == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -encoding binary -buffering none -buffersize 16
puts -nonewline $f "123456789012345\x96"
fconfigure $f -encoding shiftjis -blocking 0
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [read $f] [testchannel inputbuffered $f]
+ variable x
+ lappend x [read $f] [testchannel inputbuffered $f]
}
set x {}
fconfigure $f -encoding shiftjis
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts -nonewline $f "\x7b"
after 500 ;# Give the cat process time to catch up
fconfigure $f -encoding shiftjis -blocking 0
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
@@ -1338,29 +1343,29 @@
gets stdin; puts -nonewline "\x89"
gets stdin; puts -nonewline "\xa6"
} test1
- set f [open "|[list $::tcltest::tcltest test1]" r+]
- fileevent $f readable {
+ set f [open "|[list [interpreter] test1]" r+]
+ fileevent $f readable [namespace code {
lappend x [read $f]
if {[eof $f]} {
lappend x eof
}
- }
+ }]
puts $f "go1"
flush $f
fconfigure $f -blocking 0 -encoding utf-8
set x {}
- vwait x
- after 500 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
puts $f "go2"
flush $f
- vwait x
- after 500 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
puts $f "go3"
flush $f
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
} "{} timeout {} timeout \u7266 {} eof 0 {}"
@@ -1430,22 +1435,24 @@
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -blocking 0 -buffering none -translation {auto lf}
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [read $f] [testchannel queuedcr $f]
+ variable x
+ lappend x [read $f] [testchannel queuedcr $f]
}
set x {}
+ set y {}
puts -nonewline $f "abcdefghj\r"
- after 500 {set y ok}
- vwait y
+ after 500 [namespace code {set y ok}]
+ vwait [namespace which -variable y]
puts -nonewline $f "\n01234"
- after 500 {set y ok}
- vwait y
+ after 500 [namespace code {set y ok}]
+ vwait [namespace which -variable y]
close $f
set x
@@ -1576,7 +1583,7 @@
close $f3
}
close $f
- set result [exec $::tcltest::tcltest test1]
+ set result [exec [interpreter] test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -1604,7 +1611,7 @@
close $f3
}
close $f
- set result [exec $::tcltest::tcltest test1]
+ set result [exec [interpreter] test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -1659,7 +1666,7 @@
puts [gets $f]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] script]" r]
set c [gets $f]
close $f
set c
@@ -1677,7 +1684,7 @@
puts [gets $f]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] script]" r]
set c [gets $f]
close $f
set c
@@ -1854,7 +1861,7 @@
puts stderr [fconfigure stdout -buffersize]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]"]
+ set f [open "|[list [interpreter] script]"]
catch {close $f} msg
set msg
} {777}
@@ -1921,7 +1928,7 @@
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
- set f [open "|[list $::tcltest::tcltest << exit]"]
+ set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
} {}
@@ -2012,7 +2019,7 @@
}
set f [open output w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" w]
+ set f [open "|[list [interpreter] pipe]" w]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -2088,7 +2095,7 @@
}
set f [open output w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] pipe]" r+]
fconfigure $f -blocking off -eofchar {}
puts -nonewline $f $x
@@ -2126,7 +2133,7 @@
puts [testchannel open]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] script]" r]
set l [gets $f]
close $f
set l
@@ -2269,7 +2276,7 @@
}
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r]
+ set f1 [open "|[list [interpreter] pipe]" r]
set f2 [open longfile r]
set y ok
for {set x 0} {$x < 10} {incr x} {
@@ -2293,7 +2300,7 @@
}
close $f1
set y ok
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
fconfigure $f1 -buffering line
set f2 [open longfile r]
set line [gets $f2]
@@ -2335,7 +2342,7 @@
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
- set fd [open "|[list $::tcltest::tcltest cat longfile]" r]
+ set fd [open "|[list [interpreter] cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
string compare $x \
@@ -2415,7 +2422,7 @@
puts $f1 {set cnt [string length $x]}
puts $f1 {puts "read $cnt characters"}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
@@ -2435,7 +2442,7 @@
flush stdout
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -2455,7 +2462,7 @@
puts bye
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -2482,7 +2489,7 @@
} "{} {Line 1\nLine 2}"
test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
removeFile test3
- set f [open "|[list $::tcltest::tcltest cat | $::tcltest::tcltest cat > test3]" w]
+ set f [open "|[list [interpreter] cat | [interpreter] cat > test3]" w]
puts $f "Line 1"
puts $f "Line 2"
close $f
@@ -2505,7 +2512,7 @@
set f [open pipe w]
puts $f {exit}
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] pipe]" r+]
gets $f
puts $f output
after 50
@@ -2574,7 +2581,7 @@
}
set f [open output w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -2612,7 +2619,7 @@
}
set f [open output w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -2638,7 +2645,7 @@
puts $f strange
}
close $f
- exec $::tcltest::tcltest script
+ exec [interpreter] script
set f [open test1 r]
set r [read $f]
close $f
@@ -2654,13 +2661,14 @@
}
}
proc accept {s a p} {
- global x
- fileevent $s readable [list readit $s]
+ variable x
+ fileevent $s readable [namespace code [list readit $s]]
fconfigure $s -blocking off
set x accepted
}
proc readit {s} {
- global c x
+ variable c
+ variable x
set l [gets $s]
if {[eof $s]} {
@@ -2670,14 +2678,14 @@
incr c
}
}
- set ss [socket -server accept 0]
+ set ss [socket -server [namespace code accept] 0]
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
- vwait x
+ vwait [namespace which -variable x]
fconfigure $cs -blocking off
writelots $cs $l
close $cs
close $ss
- vwait x
+ vwait [namespace which -variable x]
set c
} 2000
test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} {
@@ -2688,7 +2696,7 @@
catch {interp delete y}
interp create x
interp create y
- set s [socket -server accept 0]
+ set s [socket -server [namespace code accept] 0]
proc accept {s a p} {
puts $s hello
close $s
@@ -3839,7 +3847,7 @@
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
flush $f1
set x [read $f1]
@@ -3852,7 +3860,7 @@
puts $f1 {puts [gets stdin]}
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
flush $f1
set x ""
@@ -3961,7 +3969,7 @@
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
@@ -4154,7 +4162,7 @@
list $c1 $r1 $c2
} {44 rstuv 49}
test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
regsub {".*":} $x {"":} x
@@ -4261,13 +4269,13 @@
list $c1 $c2
} {10 20}
test io-34.16 {Tcl_tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
set c
} -1
test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello}
flush $f1
set c [tell $f1]
@@ -4371,7 +4379,7 @@
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -4389,7 +4397,7 @@
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -4424,7 +4432,7 @@
exit
}
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r]
+ set f [open "|[list [interpreter] pipe]" r]
set l ""
lappend l [gets $f]
lappend l [eof $f]
@@ -4609,7 +4617,7 @@
# Test Tcl_InputBlocked
test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
gets $f1
@@ -4628,7 +4636,7 @@
set x
} {{} 1 hello 0 {} 1}
test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
set x ""
@@ -4659,7 +4667,8 @@
} {0 abc 0 defghijklmnop 0 1}
test io-36.4 {Tcl_InputBlocked vs files, event driven read} {
proc in {f} {
- global l x
+ variable l
+ variable x
lappend l [read $f 3]
if {[eof $f]} {lappend l eof; close $f; set x done}
}
@@ -4669,8 +4678,8 @@
close $f
set f [open test1 r]
set l ""
- fileevent $f readable [list in $f]
- vwait x
+ fileevent $f readable [namespace code [list in $f]]
+ vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
} eof}
@@ -4693,7 +4702,8 @@
} {0 abc 0 defghijklmnop 0 1}
test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
proc in {f} {
- global l x
+ variable l
+ variable x
lappend l [read $f 3]
if {[eof $f]} {lappend l eof; close $f; set x done}
}
@@ -4704,8 +4714,8 @@
set f [open test1 r]
fconfigure $f -blocking off
set l ""
- fileevent $f readable [list in $f]
- vwait x
+ fileevent $f readable [namespace code [list in $f]]
+ vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
} eof}
@@ -4899,7 +4909,7 @@
}
close $f1
set x ""
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
fconfigure $f1 -blocking off -buffering line
lappend x [fconfigure $f1 -blocking]
lappend x [gets $f1]
@@ -4980,24 +4990,24 @@
set result
} {1 {unknown encoding "foobar"}}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} {
- set f [open "|[list $::tcltest::tcltest cat]" r+]
+ set f [open "|[list [interpreter] cat]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
set x {}
- fileevent $f readable { lappend x [read $f] }
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ fileevent $f readable [namespace code { lappend x [read $f] }]
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
fconfigure $f -encoding utf-8
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
close $f
set x
} "{} timeout {} timeout \xe7 timeout"
@@ -5005,7 +5015,7 @@
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5018,7 +5028,7 @@
test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5031,7 +5041,7 @@
test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5044,7 +5054,7 @@
test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
- set s1 [socket -server accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5085,7 +5095,7 @@
test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
writeable, it should still have valid -eofchar and -translation options } {
set l [list]
- set sock [socket -server accept 0]
+ set sock [socket -server [namespace code accept] 0]
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
set l
@@ -5093,7 +5103,7 @@
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 accept 0]
+ set sock [socket -server [namespace code accept] 0]
fconfigure $sock -eofchar D -translation lf
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
@@ -5130,7 +5140,7 @@
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
-catch {set ::tcltest::testConstraints(umask2) [expr {[exec umask] == 2}]}
+catch {testConstraint umask2 [expr {[exec umask] == 2}]}
test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
# This test only works if your umask is 2, like ouster's.
@@ -5368,65 +5378,59 @@
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
- fileevent $f2 readable {
+ fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
- }
+ }]
puts $f2 text; flush $f2
set x initial
- vwait x
+ vwait [namespace which -variable x]
set x
} {text}
test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
- proc bgerror args {
- global x
- set x $args
- }
+ proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 readable {error bogus}
puts $f2 text; flush $f2
set x initial
- vwait x
- rename bgerror {}
+ vwait [namespace which -variable x]
+ rename ::bgerror {}
list $x [fileevent $f2 readable]
} {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
- fileevent $f2 writable {
+ fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
if {$count <= 0} {
fileevent $f2 writable {}
}
- }
+ }]
set x initial
set count 3
- vwait x
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
set x
} {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
- proc bgerror args {
- global x
- set x $args
- }
+ proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 writable {error bad-write}
set x initial
- vwait x
- rename bgerror {}
+ vwait [namespace which -variable x]
+ rename ::bgerror {}
list $x [fileevent $f2 writable]
} {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
- set f4 [open "|[list $::tcltest::tcltest cat << foo]" r]
- fileevent $f4 readable {
+ set f4 [open "|[list [interpreter] cat << foo]" r]
+ fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
lappend x eof
fileevent $f4 readable {}
} else {
lappend x $line
}
- }
+ }]
set x initial
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
close $f4
set x
} {initial foo eof}
@@ -5439,30 +5443,30 @@
makeFile "foo bar" foo
test io-45.1 {DeleteFileEvent, cleanup on close} {
set f [open foo r]
- fileevent $f readable {
+ fileevent $f readable [namespace code {
lappend x "binding triggered: \"[gets $f]\""
fileevent $f readable {}
- }
+ }]
close $f
set x initial
- after 100 { set y done }
- vwait y
+ after 100 [namespace code { set y done }]
+ vwait [namespace which -variable y]
set x
} {initial}
test io-45.2 {DeleteFileEvent, cleanup on close} {
set f [open foo r]
set f2 [open foo r]
- fileevent $f readable {
+ fileevent $f readable [namespace code {
lappend x "f triggered: \"[gets $f]\""
fileevent $f readable {}
- }
- fileevent $f2 readable {
+ }]
+ fileevent $f2 readable [namespace code {
lappend x "f2 triggered: \"[gets $f2]\""
fileevent $f2 readable {}
- }
+ }]
close $f
set x initial
- vwait x
+ vwait [namespace which -variable x]
close $f2
set x
} {initial {f2 triggered: "foo bar"}}
@@ -5489,34 +5493,33 @@
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
# Execute these tests only if the "testfevent" command is present.
+testConstraint testfevent [llength [info commands testfevent]]
-if {[info commands testfevent] == "testfevent"} {
-
- test io-46.1 {Tcl event loop vs multiple interpreters} {} {
+test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent} {
testfevent create
testfevent cmd {
set f [open foo r]
set x "no event"
- fileevent $f readable {
+ fileevent $f readable [namespace code {
set x "f triggered: [gets $f]"
fileevent $f readable {}
- }
- }
+ }]
+ }
after 1 ;# We must delay because Windows takes a little time to notice
update
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
-test io-46.2 {Tcl event loop vs multiple interpreters} {
+test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
testfevent create
testfevent cmd {
set x 0
after 100 {set x triggered}
- vwait x
+ vwait [namespace which -variable x]
set x
}
} {triggered}
-test io-46.3 {Tcl event loop vs multiple interpreters} {
+test io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
testfevent create
testfevent cmd {
set x 0
@@ -5530,7 +5533,7 @@
}
} {0 0 {0 timer}}
-test io-47.1 {fileevent vs multiple interpreters} {
+test io-47.1 {fileevent vs multiple interpreters} testfevent {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -5549,7 +5552,7 @@
close $f3
set x
} {{} {script 1} {} {sript 3}}
-test io-47.2 {deleting fileevent on interpreter delete} {
+test io-47.2 {deleting fileevent on interpreter delete} testfevent {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -5570,7 +5573,7 @@
close $f4
set x
} {{script 1} {} {} {script 4}}
-test io-47.3 {deleting fileevent on interpreter delete} {
+test io-47.3 {deleting fileevent on interpreter delete} testfevent {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -5591,7 +5594,7 @@
close $f4
set x
} {{script 1} {script 2} {} {}}
-test io-47.4 {file events on shared files and multiple interpreters} {
+test io-47.4 {file events on shared files and multiple interpreters} testfevent {
set f [open foo r]
set f2 [open foo r]
testfevent create
@@ -5607,7 +5610,7 @@
close $f2
set x
} {{script 3} {script 1} {script 2}}
-test io-47.5 {file events on shared files, deleting file events} {
+test io-47.5 {file events on shared files, deleting file events} testfevent {
set f [open foo r]
testfevent create
testfevent share $f
@@ -5620,7 +5623,7 @@
close $f
set x
} {{} {script 2}}
-test io-47.6 {file events on shared files, deleting file events} {
+test io-47.6 {file events on shared files, deleting file events} testfevent {
set f [open foo r]
testfevent create
testfevent share $f
@@ -5634,10 +5637,6 @@
set x
} {{script 1} {}}
-}
-
-# The above curly closes the test for presence of the "testfevent" command.
-
test io-48.1 {testing readability conditions} {
set f [open bar w]
puts $f abcdefg
@@ -5647,9 +5646,10 @@
puts $f abcdefg
close $f
set f [open bar r]
- fileevent $f readable [list consume $f]
+ fileevent $f readable [namespace code [list consume $f]]
proc consume {f} {
- global x l
+ variable l
+ variable x
lappend l called
if {[eof $f]} {
close $f
@@ -5660,7 +5660,7 @@
}
set l ""
set x not_done
- vwait x
+ vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
test io-48.2 {testing readability conditions} {nonBlockFiles} {
@@ -5672,10 +5672,11 @@
puts $f abcdefg
close $f
set f [open bar r]
- fileevent $f readable [list consume $f]
+ fileevent $f readable [namespace code [list consume $f]]
fconfigure $f -blocking off
proc consume {f} {
- global x l
+ variable x
+ variable l
lappend l called
if {[eof $f]} {
close $f
@@ -5686,7 +5687,7 @@
}
set l ""
set x not_done
- vwait x
+ vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
@@ -5708,12 +5709,13 @@
}
}
close $f
- set f [open "|[list $::tcltest::tcltest]" r+]
- fileevent $f readable [list consume $f]
+ set f [open "|[list [interpreter]]" r+]
+ fileevent $f readable [namespace code [list consume $f]]
fconfigure $f -buffering line
fconfigure $f -blocking off
proc consume {f} {
- global x l
+ variable l
+ variable x
if {[eof $f]} {
set x done
} else {
@@ -5729,7 +5731,7 @@
puts $f {set f [open bar r]}
puts $f {copy_slowly $f}
puts $f {exit}
- vwait x
+ vwait [namespace which -variable x]
close $f
list $x $l
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
@@ -5741,7 +5743,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5754,8 +5758,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
@@ -5766,7 +5770,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5779,8 +5785,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
@@ -5791,7 +5797,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5804,8 +5812,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
@@ -5816,7 +5824,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5829,8 +5839,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
@@ -5841,7 +5851,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5854,8 +5866,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
@@ -5866,7 +5878,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5879,8 +5893,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
@@ -5891,7 +5905,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5904,8 +5920,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation lf
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
@@ -5916,7 +5932,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5929,8 +5947,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation lf -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
@@ -5941,7 +5959,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5954,8 +5974,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation cr
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
@@ -5966,7 +5986,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -5979,8 +6001,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation cr -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
@@ -5991,7 +6013,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -6004,8 +6028,8 @@
set l ""
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation crlf
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
@@ -6016,7 +6040,9 @@
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -6029,8 +6055,8 @@
set l ""
set f [open test1 r]
fconfigure $f -translation crlf -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -6147,14 +6173,15 @@
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannel} {
+testConstraint testchannelevent [llength [info commands testchannelevent]]
+test io-50.1 {testing handler deletion} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list delhandler $f]
+ testchannelevent $f add readable [namespace code [list delhandler $f]]
proc delhandler {f} {
- global z
+ variable z
set z called
testchannelevent $f delete 0
}
@@ -6163,15 +6190,15 @@
close $f
set z
} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannel} {
+test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list delhandler $f 1]
- testchannelevent $f add readable [list delhandler $f 0]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
- global z
+ variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
@@ -6181,20 +6208,20 @@
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} {testchannel} {
+test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list notcalled $f 1]
- testchannelevent $f add readable [list delhandler $f 0]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
set z ""
proc notcalled {f i} {
- global z
+ variable z
lappend z "notcalled was called!! $f $i"
}
proc delhandler {f i} {
- global z
+ variable z
testchannelevent $f delete 1
lappend z "delhandler $f $i called"
testchannelevent $f delete 0
@@ -6207,14 +6234,15 @@
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannel} {
+test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list delrecursive $f]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
proc delrecursive {f} {
- global z u
+ variable z
+ variable u
if {"$u" == "recursive"} {
testchannelevent $f delete 0
lappend z "delrecursive deleting recursive"
@@ -6231,19 +6259,20 @@
string compare [string tolower $z] \
{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannel} {
+test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list notcalled $f]
- testchannelevent $f add readable [list del $f]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
- global z
+ variable z
lappend z "notcalled was called!! $f"
}
proc del {f} {
- global z u
+ variable u
+ variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
testchannelevent $f delete 0
@@ -6264,15 +6293,16 @@
[list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
} 0
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannel} {
+test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
set f [open test1 w]
close $f
set f [open test1 r]
- testchannelevent $f add readable [list second $f]
- testchannelevent $f add readable [list first $f]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
- global u z
+ variable u
+ variable z
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
@@ -6283,7 +6313,8 @@
}
}
proc second {f} {
- global u z
+ variable u
+ variable z
if {"$u" == "first"} {
lappend z "second called, first time"
set u second
@@ -6310,34 +6341,35 @@
set x 0
set result ""
proc accept {s a p} {
- global x wait
+ variable x
+ variable wait
fconfigure $s -blocking off
puts $s "sock[incr x]"
close $s
set wait done
}
- set ss [socket -server accept 0]
+ set ss [socket -server [namespace code accept] 0]
set wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
- vwait wait
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
- vwait wait
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
- vwait wait
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
- vwait wait
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
close $ss
@@ -6460,7 +6492,7 @@
close \$f1
"
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
fconfigure $f1 -translation lf
gets $f1
puts $f1 ready
@@ -6570,9 +6602,9 @@
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
- fcopy $f1 $f2 -command {set s0}
+ fcopy $f1 $f2 -command [namespace code {set s0}]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
- vwait s0
+ vwait [namespace which -variable s0]
close $f1
close $f2
set s1 [file size $thisScript]
@@ -6597,7 +6629,7 @@
close $f
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
set result [gets $f1]
puts $f1 line1
flush $f1
@@ -6630,20 +6662,20 @@
close $f
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] pipe]" r+]
set result [gets $f1]
fconfigure $f1 -blocking 0
puts $f1 $big
flush $f1
after 500
set result ""
- fileevent $f1 read {
+ fileevent $f1 read [namespace code {
append result [read $f1 1024]
if {[string length $result] >= [string length $big]} {
set x done
}
- }
- vwait x
+ }]
+ vwait [namespace which -variable x]
close $f1
set big {}
set x
@@ -6654,7 +6686,7 @@
after 1000 "close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
- global fcopyTestDone
+ variable fcopyTestDone
if {[string length $error]} {
set fcopyTestDone 1
} else {
@@ -6663,14 +6695,14 @@
}
test io-53.5 {CopyData: error during fcopy} {socket} {
- set listen [socket -server FcopyTestAccept 0]
+ set listen [socket -server [namespace code FcopyTestAccept] 0]
set in [open $thisScript] ;# 126 K
set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
close $listen ;# This means the socket open never really succeeds
- fcopy $in $out -command FcopyTestDone
+ fcopy $in $out -command [namespace code FcopyTestDone]
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone ;# The error occurs here in the b.g.
+ vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
close $in
close $out
@@ -6683,11 +6715,12 @@
set f1 [open pipe w]
puts $f1 "exit 1"
close $f1
- set in [open "|[list $::tcltest::tcltest pipe]" r+]
+ set in [open "|[list [interpreter] pipe]" r+]
set out [open test1 w]
- fcopy $in $out -command [list FcopyTestDone]
+ fcopy $in $out -command [namespace code FcopyTestDone]
+ variable fcopyTestDone
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone
+ vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
@@ -6695,7 +6728,8 @@
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
- global fcopyTestDone fcopyTestCount
+ variable fcopyTestDone
+ variable fcopyTestCount
incr fcopyTestCount $bytes
if {[string length $error]} {
set fcopyTestDone 1
@@ -6704,7 +6738,8 @@
} else {
# Delay next fcopy to wait for size>0 input bytes
after 100 [list
- fcopy $in $out -size 1000 -command [list doFcopy $in $out]
+ fcopy $in $out -size 1000 \
+ -command [namespace code [list doFcopy $in $out]]
]
}
}
@@ -6731,11 +6766,11 @@
exit 0
}
close $f1
- set in [open "|[list $::tcltest::tcltest pipe &]" r+]
+ set in [open "|[list [interpreter] pipe &]" r+]
set out [open test1 w]
doFcopy $in $out
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone
+ vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
@@ -6748,22 +6783,23 @@
# event loops when there is buffered data on the channel.
proc accept {s a p} {
- global as
+ variable as
fconfigure $s -translation lf
puts $s "line 1\nline2\nline3"
flush $s
set as $s
}
proc readit {s next} {
- global result x
+ variable x
+ variable result
lappend result $next
if {$next == 1} {
- fileevent $s readable [list readit $s 2]
- vwait x
+ fileevent $s readable [namespace code [list readit $s 2]]
+ vwait [namespace which -variable x]
}
incr x
}
- set ss [socket -server accept 0]
+ set ss [socket -server [namespace code accept] 0]
# We need to delay on some systems until the creation of the
# server socket completes.
@@ -6782,13 +6818,14 @@
}
set result {}
set x 0
- vwait as
+ variable as
+ vwait [namespace which -variable as]
fconfigure $cs -translation lf
lappend result [gets $cs]
fconfigure $cs -blocking off
- fileevent $cs readable [list readit $cs 1]
- set a [after 2000 { set x failure }]
- vwait x
+ fileevent $cs readable [namespace code [list readit $cs 1]]
+ set a [after 2000 [namespace code { set x failure }]]
+ vwait [namespace which -variable x]
after cancel $a
close $as
close $ss
@@ -6798,27 +6835,30 @@
test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set accept {}
set after {}
- set s [socket -server accept 0]
+ set s [socket -server [namespace code accept] 0]
proc accept {s a p} {
- global counter accept
+ variable counter
+ variable accept
set accept $s
set counter 0
fconfigure $s -blocking off -buffering line -translation lf
- fileevent $s readable "doit $s"
+ fileevent $s readable [namespace code "doit $s"]
}
proc doit {s} {
- global counter after
+ variable counter
+ variable after
incr counter
set l [gets $s]
if {"$l" == ""} {
- fileevent $s readable "doit1 $s"
- set after [after 1000 newline]
+ fileevent $s readable [namespace code "doit1 $s"]
+ set after [after 1000 [namespace code newline]]
}
}
proc doit1 {s} {
- global counter accept
+ variable counter
+ variable accept
incr counter
set l [gets $s]
@@ -6826,7 +6866,8 @@
set accept {}
}
proc producer {} {
- global writer s
+ variable s
+ variable writer
set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
fconfigure $writer -buffering line
@@ -6834,14 +6875,15 @@
flush $writer
}
proc newline {} {
- global writer done
+ variable done
+ variable writer
puts $writer hello
flush $writer
set done 1
}
producer
- vwait done
+ vwait [namespace which -variable done]
close $writer
close $s
after cancel $after
@@ -6850,57 +6892,58 @@
} 1
test io-55.1 {ChannelEventScriptInvoker: deletion} {
+ variable x
proc eventScript {fd} {
+ variable x
close $fd
error "planned error"
- set ::x whoops
- }
- proc bgerror {args} {
- set ::x got_error
+ set x whoops
}
+ proc ::bgerror {args} "set [namespace which -variable x] got_error"
set f [open fooBar w]
- fileevent $f writable [list eventScript $f]
+ fileevent $f writable [namespace code [list eventScript $f]]
set x not_done
- vwait x
+ vwait [namespace which -variable x]
set x
} {got_error}
-test io-56.1 {ChannelTimerProc} {testchannel} {
+test io-56.1 {ChannelTimerProc} {testchannelevent} {
set f [open fooBar w]
puts $f "this is a test"
close $f
set f [open fooBar r]
- testchannelevent $f add readable {
+ testchannelevent $f add readable [namespace code {
read $f 1
incr x
- }
+ }]
set x 0
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
set result $x
testchannelevent $f set 0 none
- after idle {set y done}
- vwait y
+ after idle [namespace code {set y done}]
+ vwait [namespace which -variable y]
close $f
lappend result $y
} {2 done}
test io-57.1 {buffered data and file events, gets} {
proc accept {sock args} {
- set ::s2 $sock
+ variable s2
+ set s2 $sock
}
- set server [socket -server accept 0]
+ set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
- vwait s2
+ vwait [namespace which -variable s2]
update
- fileevent $s2 readable {lappend result readable}
+ fileevent $s2 readable [namespace code {lappend result readable}]
puts $s "12\n34567890"
flush $s
set result [gets $s2]
- after 1000 {lappend result timer}
- vwait result
+ after 1000 [namespace code {lappend result timer}]
+ vwait [namespace which -variable result]
lappend result [gets $s2]
- vwait result
+ vwait [namespace which -variable result]
close $s
close $s2
close $server
@@ -6908,20 +6951,21 @@
} {12 readable 34567890 timer}
test io-57.2 {buffered data and file events, read} {
proc accept {sock args} {
- set ::s2 $sock
+ variable s2
+ set s2 $sock
}
- set server [socket -server accept 0]
+ set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
- vwait s2
+ vwait [namespace which -variable s2]
update
- fileevent $s2 readable {lappend result readable}
+ fileevent $s2 readable [namespace code {lappend result readable}]
puts -nonewline $s "1234567890"
flush $s
set result [read $s2 1]
- after 1000 {lappend result timer}
- vwait result
+ after 1000 [namespace code {lappend result timer}]
+ vwait [namespace which -variable result]
lappend result [read $s2 9]
- vwait result
+ vwait [namespace which -variable result]
close $s
close $s2
close $server
@@ -6936,7 +6980,8 @@
exit 1
}
proc readit {pipe} {
- global x result
+ variable x
+ variable result
if {[eof $pipe]} {
set x [catch {close $pipe} line]
lappend result catch $line
@@ -6946,16 +6991,17 @@
}
}
close $out
- set pipe [open "|[list $::tcltest::tcltest] script" r]
- fileevent $pipe readable [list readit $pipe]
+ set pipe [open "|[list [interpreter]] script" r]
+ fileevent $pipe readable [namespace code [list readit $pipe]]
set x ""
set result ""
- vwait x
+ vwait [namespace which -variable x]
list $x $result
} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
-test io-59.1 {Thread reference of channels} {
+testConstraint testmainthread [llength [info commands testmainthread]]
+test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
# TIP #10
# More complicated tests (like that the reference changes as a
# channel is moved from thread to thread) can be done only in the
@@ -6972,8 +7018,9 @@
# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script foo \
bar test2 test3 cat stdout] {
- ::tcltest::removeFile $file
+ removeFile $file
+}
+cleanupTests
}
-::tcltest::restoreState
-::tcltest::cleanupTests
+namespace delete ::tcl::test::io
return
