summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/io.test84
-rwxr-xr-xtests/tcltest.test89
2 files changed, 102 insertions, 71 deletions
diff --git a/tests/io.test b/tests/io.test
index c2eae3d..067db18 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: io.test,v 1.30 2002/05/31 23:16:17 dgp Exp $
+# RCS: @(#) $Id: io.test,v 1.31 2002/06/06 18:44:43 dgp Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -982,7 +982,7 @@ test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio}
fconfigure $f -buffering none
puts -nonewline $f "foobar"
fconfigure $f -blocking 0
- set x {}
+ variable x {}
after 500 [namespace code { lappend x timeout }]
fileevent $f readable [namespace code { lappend x [gets $f] }]
vwait [namespace which -variable x]
@@ -1042,7 +1042,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio} {
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
fileevent $f read [namespace code "ready $f"]
- set x {}
+ variable x {}
proc ready {f} {
variable x
lappend x [gets $f line] $line [fblocked $f]
@@ -1077,7 +1077,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha
set f [open "|[list [interpreter] cat]" w+]
fconfigure $f -translation lf -encoding ascii -buffering none
puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
- set x {}
+ variable x {}
fileevent $f read [namespace code "ready $f"]
proc ready {f} {
variable x
@@ -1327,7 +1327,7 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel} {
variable x
lappend x [read $f] [testchannel inputbuffered $f]
}
- set x {}
+ variable x {}
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
@@ -1356,7 +1356,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio} {
puts $f "go1"
flush $f
fconfigure $f -blocking 0 -encoding utf-8
- set x {}
+ variable x {}
vwait [namespace which -variable x]
after 500 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
@@ -1446,8 +1446,8 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testc
variable x
lappend x [read $f] [testchannel queuedcr $f]
}
- set x {}
- set y {}
+ variable x {}
+ variable y {}
puts -nonewline $f "abcdefghj\r"
after 500 [namespace code {set y ok}]
@@ -2656,7 +2656,7 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} {
} "hello\nbye\nstrange\n"
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
set c 0
- set x running
+ variable x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
proc writelots {s l} {
for {set i 0} {$i < 2000} {incr i} {
@@ -4682,6 +4682,7 @@ test io-36.4 {Tcl_InputBlocked vs files, event driven read} {
set f [open test1 r]
set l ""
fileevent $f readable [namespace code [list in $f]]
+ variable x
vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
@@ -4718,6 +4719,7 @@ test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
fconfigure $f -blocking off
set l ""
fileevent $f readable [namespace code [list in $f]]
+ variable x
vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
@@ -4998,7 +5000,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA}
puts -nonewline $f "\xe7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
- set x {}
+ variable x {}
fileevent $f readable [namespace code { lappend x [read $f] }]
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
@@ -5385,7 +5387,7 @@ test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
set x [gets $f2]; fileevent $f2 readable {}
}]
puts $f2 text; flush $f2
- set x initial
+ variable x initial
vwait [namespace which -variable x]
set x
} {text}
@@ -5393,7 +5395,7 @@ test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 readable {error bogus}
puts $f2 text; flush $f2
- set x initial
+ variable x initial
vwait [namespace which -variable x]
rename ::bgerror {}
list $x [fileevent $f2 readable]
@@ -5406,7 +5408,7 @@ test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
fileevent $f2 writable {}
}
}]
- set x initial
+ variable x initial
set count 3
vwait [namespace which -variable x]
vwait [namespace which -variable x]
@@ -5416,7 +5418,7 @@ test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 writable {error bad-write}
- set x initial
+ variable x initial
vwait [namespace which -variable x]
rename ::bgerror {}
list $x [fileevent $f2 writable]
@@ -5431,7 +5433,7 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
lappend x $line
}
}]
- set x initial
+ variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
close $f4
@@ -5453,6 +5455,7 @@ test io-45.1 {DeleteFileEvent, cleanup on close} {
close $f
set x initial
after 100 [namespace code { set y done }]
+ variable y
vwait [namespace which -variable y]
set x
} {initial}
@@ -5468,7 +5471,7 @@ test io-45.2 {DeleteFileEvent, cleanup on close} {
fileevent $f2 readable {}
}]
close $f
- set x initial
+ variable x initial
vwait [namespace which -variable x]
close $f2
set x
@@ -5516,7 +5519,7 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent} {
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
testfevent create
testfevent cmd {
- set x 0
+ variable x 0
after 100 {set x triggered}
vwait [namespace which -variable x]
set x
@@ -5662,7 +5665,7 @@ test io-48.1 {testing readability conditions} {
}
}
set l ""
- set x not_done
+ variable x not_done
vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
@@ -5689,7 +5692,7 @@ test io-48.2 {testing readability conditions} {nonBlockFiles} {
}
}
set l ""
- set x not_done
+ variable x not_done
vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
@@ -5729,7 +5732,7 @@ test io-48.3 {testing readability conditions} {stdio unixOnly nonBlockFiles} {
}
}
set l ""
- set x not_done
+ variable x not_done
puts $f {source my_script}
puts $f {set f [open bar r]}
puts $f {copy_slowly $f}
@@ -5762,6 +5765,7 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5789,6 +5793,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5816,6 +5821,7 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5843,6 +5849,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5870,6 +5877,7 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
set f [open test1 r]
fconfigure $f -translation auto -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5897,6 +5905,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation auto
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5924,6 +5933,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation lf
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5951,6 +5961,7 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
set f [open test1 r]
fconfigure $f -translation lf -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -5978,6 +5989,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation cr
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -6005,6 +6017,7 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
set f [open test1 r]
fconfigure $f -translation cr -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -6032,6 +6045,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
set f [open test1 r]
fconfigure $f -eofchar \x1a -translation crlf
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -6059,6 +6073,7 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
set f [open test1 r]
fconfigure $f -translation crlf -eofchar \x1a
fileevent $f readable [namespace code [list consume $f]]
+ variable x
vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
@@ -6352,7 +6367,7 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set wait done
}
set ss [socket -server [namespace code accept] 0]
- set wait ""
+ variable wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable wait]
lappend result [gets $cs]
@@ -6607,6 +6622,7 @@ test io-53.2 {CopyData} {
fconfigure $f2 -translation cr -blocking 0
fcopy $f1 $f2 -command [namespace code {set s0}]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+ variable s0
vwait [namespace which -variable s0]
close $f1
close $f2
@@ -6649,6 +6665,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unixOnly} {
} "ready line1 line2 {done\n}"
test io-53.4 {CopyData: background write overflow} {stdio unixOnly} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
+ variable x
for {set x 0} {$x < 12} {incr x} {
append big $big
}
@@ -6698,12 +6715,14 @@ proc FcopyTestDone {bytes {error {}}} {
}
test io-53.5 {CopyData: error during fcopy} {socket} {
+ variable fcopyTestDone
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 [namespace code FcopyTestDone]
+ variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
@@ -6712,6 +6731,7 @@ test io-53.5 {CopyData: error during fcopy} {socket} {
set fcopyTestDone ;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio} {
+ variable fcopyTestDone
removeFile pipe
removeFile test1
catch {unset fcopyTestDone}
@@ -6748,6 +6768,7 @@ proc doFcopy {in out {bytes 0} {error {}}} {
}
test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio} {
+ variable fcopyTestDone
removeFile pipe
removeFile test1
catch {unset fcopyTestDone}
@@ -6772,6 +6793,7 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio} {
set in [open "|[list [interpreter] pipe &]" r+]
set out [open test1 w]
doFcopy $in $out
+ variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone]
}
@@ -6819,8 +6841,8 @@ test io-54.1 {Recursive channel events} {socket} {
close $ss
error "failed to connect to server"
}
- set result {}
- set x 0
+ variable result {}
+ variable x 0
variable as
vwait [namespace which -variable as]
fconfigure $cs -translation lf
@@ -6838,7 +6860,7 @@ test io-54.1 {Recursive channel events} {socket} {
test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set accept {}
set after {}
- set s [socket -server [namespace code accept] 0]
+ variable s [socket -server [namespace code accept] 0]
proc accept {s a p} {
variable counter
variable accept
@@ -6886,6 +6908,7 @@ test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set done 1
}
producer
+ variable done
vwait [namespace which -variable done]
close $writer
close $s
@@ -6905,7 +6928,7 @@ test io-55.1 {ChannelEventScriptInvoker: deletion} {
proc ::bgerror {args} "set [namespace which -variable x] got_error"
set f [open fooBar w]
fileevent $f writable [namespace code [list eventScript $f]]
- set x not_done
+ variable x not_done
vwait [namespace which -variable x]
set x
} {got_error}
@@ -6919,12 +6942,13 @@ test io-56.1 {ChannelTimerProc} {testchannelevent} {
read $f 1
incr x
}]
- set x 0
+ variable x 0
vwait [namespace which -variable x]
vwait [namespace which -variable x]
set result $x
testchannelevent $f set 0 none
after idle [namespace code {set y done}]
+ variable y
vwait [namespace which -variable y]
close $f
lappend result $y
@@ -6937,12 +6961,13 @@ test io-57.1 {buffered data and file events, gets} {
}
set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
+ variable s2
vwait [namespace which -variable s2]
update
fileevent $s2 readable [namespace code {lappend result readable}]
puts $s "12\n34567890"
flush $s
- set result [gets $s2]
+ variable result [gets $s2]
after 1000 [namespace code {lappend result timer}]
vwait [namespace which -variable result]
lappend result [gets $s2]
@@ -6959,12 +6984,13 @@ test io-57.2 {buffered data and file events, read} {
}
set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
+ variable s2
vwait [namespace which -variable s2]
update
fileevent $s2 readable [namespace code {lappend result readable}]
puts -nonewline $s "1234567890"
flush $s
- set result [read $s2 1]
+ variable result [read $s2 1]
after 1000 [namespace code {lappend result timer}]
vwait [namespace which -variable result]
lappend result [read $s2 9]
@@ -6996,7 +7022,7 @@ test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc} {
close $out
set pipe [open "|[list [interpreter]] script" r]
fileevent $pipe readable [namespace code [list readit $pipe]]
- set x ""
+ variable x ""
set result ""
vwait [namespace which -variable x]
list $x $result
diff --git a/tests/tcltest.test b/tests/tcltest.test
index b876367..3bb2d36 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -6,7 +6,7 @@
# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.test,v 1.23 2002/06/05 01:12:38 dgp Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.24 2002/06/06 18:44:44 dgp Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -213,7 +213,7 @@ test tcltest-4.6 {tcltest::skip} {
}
# -constraints, -limitconstraints, [testConstraint],
-# [constraintsSpecified], [constraintList], [limitConstraints]
+# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
set result [catch {exec [interpreter] test.tcl -constraints knownBug -verbose 'ps'} msg]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
@@ -236,29 +236,31 @@ test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} {
-cleanup {unset ::tcltest::testConstraints(tcltestFakeConstraint)}
}
-test tcltest-5.4 {tcltest::constraintsSpecified} {
- -setup {
- set constraintlist $::tcltest::constraintsSpecified
- set ::tcltest::constraintsSpecified {}
- }
- -body {
- set r1 $::tcltest::constraintsSpecified
- testConstraint tcltestFakeConstraint1 1
- set r2 $::tcltest::constraintsSpecified
- testConstraint tcltestFakeConstraint2 1
- set r3 $::tcltest::constraintsSpecified
- list $r1 $r2 $r3
- }
- -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
- -cleanup {
- set ::tcltest::constraintsSpecified $constraintlist
- unset ::tcltest::testConstraints(tcltestFakeConstraint1)
- unset ::tcltest::testConstraints(tcltestFakeConstraint2)
- }
-}
-
-test tcltest-5.5 {tcltest::constraintList} \
- -constraints {!$::tcltest::testConstraints(singleTestInterp)} \
+# Removed this test of internals of tcltest. Those internals have changed.
+#test tcltest-5.4 {tcltest::constraintsSpecified} {
+# -setup {
+# set constraintlist $::tcltest::constraintsSpecified
+# set ::tcltest::constraintsSpecified {}
+# }
+# -body {
+# set r1 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint1 1
+# set r2 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint2 1
+# set r3 $::tcltest::constraintsSpecified
+# list $r1 $r2 $r3
+# }
+# -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
+# -cleanup {
+# set ::tcltest::constraintsSpecified $constraintlist
+# unset ::tcltest::testConstraints(tcltestFakeConstraint1)
+# unset ::tcltest::testConstraints(tcltestFakeConstraint2)
+# }
+#}
+
+test tcltest-5.5 {InitConstraints: list of built-in constraints} \
+ -constraints {!singleTestInterp} \
+ -setup {tcltest::InitConstraints} \
-body { lsort [array names ::tcltest::testConstraints] } \
-result [lsort {
95 98 asyncPipeClose eformat emptyTest hasIsoLocale interactive knownBug
@@ -268,23 +270,26 @@ test tcltest-5.5 {tcltest::constraintList} \
unixOrWin userInteraction win winCrash winOnly
}]
-test tcltest-5.6 {tcltest::limitConstraints} {
- -setup {
- set keeplc $::tcltest::limitConstraints
- set keepkb [testConstraint knownBug]
- }
- -body {
- set r1 [limitConstraints]
- set r2 [limitConstraints knownBug]
- set r3 [limitConstraints]
- list $r1 $r2 $r3
- }
- -cleanup {
- limitConstraints $keeplc
- testConstraint knownBug $keepkb
- }
- -result {false knownBug knownBug}
-}
+# Removed this broken test. Its usage of [limitConstraints] was not
+# in agreement with the documentation. [limitConstraints] is supposed
+# to take an optional boolean argument, and "knownBug" ain't no boolean!
+#test tcltest-5.6 {tcltest::limitConstraints} {
+# -setup {
+# set keeplc $::tcltest::limitConstraints
+# set keepkb [testConstraint knownBug]
+# }
+# -body {
+# set r1 [limitConstraints]
+# set r2 [limitConstraints knownBug]
+# set r3 [limitConstraints]
+# list $r1 $r2 $r3
+# }
+# -cleanup {
+# limitConstraints $keeplc
+# testConstraint knownBug $keepkb
+# }
+# -result {false knownBug knownBug}
+#}
# -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
set printerror [makeFile {