diff options
author | sebres <sebres@users.sourceforge.net> | 2019-04-09 10:31:36 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-04-09 10:31:36 (GMT) |
commit | f2c8c6c408d10fd1049ebab13794e83731d7bd90 (patch) | |
tree | 848370efc94399858b367c84eadc2223c508b94b /tests/cmdMZ.test | |
parent | 1749b4cc870fc9ff5bdb398dca162d97eed9f28c (diff) | |
download | tcl-f2c8c6c408d10fd1049ebab13794e83731d7bd90.zip tcl-f2c8c6c408d10fd1049ebab13794e83731d7bd90.tar.gz tcl-f2c8c6c408d10fd1049ebab13794e83731d7bd90.tar.bz2 |
closes [1e5e25cf2b] - tests/cmdMZ.test: fixed NRT-related sleeps (and time-related corner cases and test expectations);
todo: rewrite several tests if monotonic clock is provided resp. command "after" gets microsecond accuracy (RFE [fdfbd5e10] gets merged)
Diffstat (limited to 'tests/cmdMZ.test')
-rw-r--r-- | tests/cmdMZ.test | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index d1f0a44..2ac74cd 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -321,6 +321,14 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test +# todo: rewrite this if monotonic clock is provided resp. command "after" +# gets microsecond accuracy (RFE [fdfbd5e10] gets merged): +proc _nrt_sleep {msec} { + set usec [expr {$msec * 1000}] + set stime [clock microseconds] + while {abs([clock microseconds] - $stime) < $usec} {after 0} +} + test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} { list [catch {time} msg] $msg } {1 {wrong # args: should be "time command ?count?"}} @@ -337,7 +345,7 @@ test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} { regexp {^\d+ microseconds per iteration} [time {format 1}] } 1 test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { - expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]} + expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo @@ -372,18 +380,18 @@ test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { - set m1 [timerate {after 0} 20] - set m2 [timerate {after 1} 20] + set m1 [timerate {_nrt_sleep 0} 20] + set m2 [timerate {_nrt_sleep 0.2} 20] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ - [expr {[lindex $m2 0] >= 500}] \ + [expr {[lindex $m2 0] > 100}] \ [expr {[lindex $m1 2] > 1000}] \ - [expr {[lindex $m2 2] <= 50}] \ - [expr {[lindex $m1 4] > 10000}] \ - [expr {[lindex $m2 4] < 10000}] \ - [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \ - [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}] + [expr {[lindex $m2 2] < 1000}] \ + [expr {[lindex $m1 4] > 50000}] \ + [expr {[lindex $m2 4] < 50000}] \ + [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \ + [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}] } [lrepeat 9 1] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo @@ -402,11 +410,11 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins - set m2 [timerate {after 20} 1 5]; # max-time wins + set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { - set m1 [timerate -overhead 1e6 {after 10} 100 1] + set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ |