summaryrefslogtreecommitdiffstats
path: root/tests/cmdMZ.test
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-04-09 10:31:36 (GMT)
committersebres <sebres@users.sourceforge.net>2019-04-09 10:31:36 (GMT)
commitf2c8c6c408d10fd1049ebab13794e83731d7bd90 (patch)
tree848370efc94399858b367c84eadc2223c508b94b /tests/cmdMZ.test
parent1749b4cc870fc9ff5bdb398dca162d97eed9f28c (diff)
downloadtcl-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.test30
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}] \