diff options
author | sebres <sebres@users.sourceforge.net> | 2019-04-11 09:52:20 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-04-11 09:52:20 (GMT) |
commit | 9f9c9efac0ac28445c688e275e02f54cd9a19574 (patch) | |
tree | 90e371cd6ca971c015fa3eef6b3cd06d2d59cc3d /tests/cmdMZ.test | |
parent | 869730bf85067c15e36cab14904da2bda45cb84a (diff) | |
parent | 417474f1fd64cb819d61f662390ad20a4ad66706 (diff) | |
download | tcl-9f9c9efac0ac28445c688e275e02f54cd9a19574.zip tcl-9f9c9efac0ac28445c688e275e02f54cd9a19574.tar.gz tcl-9f9c9efac0ac28445c688e275e02f54cd9a19574.tar.bz2 |
merge 8.6 (conflicts resolved, changes on tests/cmdMZ.test in [4cb9044dfa] reverted - timerate is supported in 8.7)
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 5589e21..1ad45e7 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -316,6 +316,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} -body { time } -returnCodes error -result {wrong # args: should be "time command ?count?"} @@ -332,7 +340,7 @@ test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} 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 @@ -367,18 +375,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 @@ -397,11 +405,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}] \ |