summaryrefslogtreecommitdiffstats
path: root/tests/cmdMZ.test
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-04-11 09:52:20 (GMT)
committersebres <sebres@users.sourceforge.net>2019-04-11 09:52:20 (GMT)
commit9f9c9efac0ac28445c688e275e02f54cd9a19574 (patch)
tree90e371cd6ca971c015fa3eef6b3cd06d2d59cc3d /tests/cmdMZ.test
parent869730bf85067c15e36cab14904da2bda45cb84a (diff)
parent417474f1fd64cb819d61f662390ad20a4ad66706 (diff)
downloadtcl-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.test30
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}] \