diff options
author | culler <culler> | 2020-08-08 21:27:06 (GMT) |
---|---|---|
committer | culler <culler> | 2020-08-08 21:27:06 (GMT) |
commit | 4b765a3aff40f73f918d159af41222d1ce972b24 (patch) | |
tree | 29b5e59f97d83a4872c8c4a54ae3dab39339aeb8 /tests | |
parent | bb9b5e7606e6deecd6b7bfc7683be22d1c5c90b6 (diff) | |
download | tcl-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.test | 42 | ||||
-rw-r--r-- | tests/event.test | 1 | ||||
-rw-r--r-- | tests/io.test | 99 |
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 |