summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorculler <culler>2020-08-08 21:27:06 (GMT)
committerculler <culler>2020-08-08 21:27:06 (GMT)
commit4b765a3aff40f73f918d159af41222d1ce972b24 (patch)
tree29b5e59f97d83a4872c8c4a54ae3dab39339aeb8 /tests
parentbb9b5e7606e6deecd6b7bfc7683be22d1c5c90b6 (diff)
downloadtcl-4b765a3aff40f73f918d159af41222d1ce972b24.zip
tcl-4b765a3aff40f73f918d159af41222d1ce972b24.tar.gz
tcl-4b765a3aff40f73f918d159af41222d1ce972b24.tar.bz2
Add and use testservicemode command; replace update by vwait
Diffstat (limited to 'tests')
-rw-r--r--tests/chanio.test42
-rw-r--r--tests/event.test1
-rw-r--r--tests/io.test99
3 files changed, 90 insertions, 52 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index 4f348f8..c48fe63 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6394,14 +6394,16 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
chan close [open $path(test1) w]
set z ""
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
@@ -6411,11 +6413,8 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
- set z ""
+ update
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6427,6 +6426,12 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
testchannelevent $f delete 0
lappend z "delhandler $f $i deleted myself"
}
+ set z ""
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
string equal $z \
[list [list delhandler $f 0 called] \
@@ -6438,6 +6443,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
@@ -6456,15 +6462,14 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
set z
} -cleanup {
chan close $f
+ update
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6480,22 +6485,31 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
} else {
set u recursive
lappend z "del calling recursive"
+ set mode [test servicemode 1]
update
+ test servicemode $mode
lappend z "del after update"
}
}
set z ""
set u toplevel
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testservicemode 1
+ testchannelevent $f add readable [namespace code [list del $f]]
update
set z
} -cleanup {
chan close $f
+ update
} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
proc first {f} {
variable u
@@ -6503,7 +6517,9 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
if {$u eq "toplevel"} {
lappend z "first called"
set u first
+ set mode [testservicemode 1]
update
+ testservicemode $mode
lappend z "first after update"
} else {
lappend z "first called not toplevel"
@@ -6526,13 +6542,11 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
- # This test assume that select will not detect the new open file
- # until the update command runs. This is not guaranteed, but it
- # seems to help if we make sure that the calls to testchannelevent
- # immediately follow the call to open.
+ testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list second $f]]
testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
set z
} -cleanup {
diff --git a/tests/event.test b/tests/event.test
index 336c4e4..b42909c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -33,6 +33,7 @@ test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
+ update idletasks
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
diff --git a/tests/io.test b/tests/io.test
index c9019af..cfa08ed 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6725,18 +6725,22 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
+ set f [open $path(test1) w]
+ close $f
+ update
proc delhandler {f} {
variable z
set z called
testchannelevent $f delete 0
}
- set f [open $path(test1) w]
- close $f
set z not_called
- update
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list delhandler $f]]
- update
+ testservicemode 1
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
@@ -6746,29 +6750,27 @@ test io-50.2 {testing handler deletion with multiple handlers} -constraints test
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
- lappend z "called delhandler $f $i"
+ lappend z "called delhandler $i"
testchannelevent $f delete 0
}
set z ""
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
- string compare [string tolower $z] \
- [list [list called delhandler $f 0] [list called delhandler $f 1]]
+ set z
} -cleanup {
close $f
-} -result 0
+} -result {{called delhandler 0} {called delhandler 1}}
test io-50.3 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- 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} {
variable z
@@ -6777,25 +6779,30 @@ test io-50.3 {testing handler deletion with multiple handlers} -constraints test
proc delhandler {f i} {
variable z
testchannelevent $f delete 1
- lappend z "delhandler $f $i called"
+ lappend z "delhandler $i called"
testchannelevent $f delete 0
- lappend z "delhandler $f $i deleted myself"
+ lappend z "delhandler $i deleted myself"
}
set z ""
- update
- string compare [string tolower $z] \
- [list [list delhandler $f 0 called] \
- [list delhandler $f 0 deleted myself]]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
close $f
-} -result 0
+} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
+ update
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ update
proc delrecursive {f} {
variable z
variable u
@@ -6810,7 +6817,13 @@ test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchan
}
variable u toplevel
variable z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
@@ -6820,9 +6833,6 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6832,40 +6842,48 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan
variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
- testchannelevent $f delete 0
lappend z "del deleted notcalled"
+ testchannelevent $f delete 0
lappend z "del deleted myself"
} else {
set u recursive
lappend z "del calling recursive"
- update
- lappend z "del after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "del after recursive"
}
}
set z ""
set u toplevel
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
+ testservicemode 1
+ set timer [after 50 set z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
} -result [list {del calling recursive} {del deleted notcalled} \
- {del deleted myself} {del after update}]
+ {del deleted myself} {del after recursive}]
test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
variable u
variable z
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
- update
- lappend z "first after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "first after toplevel"
} else {
lappend z "first called not toplevel"
}
@@ -6887,13 +6905,18 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchan
}
set z ""
set u toplevel
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
set z
} -cleanup {
close $f
} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
- {first after update}]
+ {first after toplevel}]
test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0