summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2024-05-28 13:03:33 (GMT)
committersebres <sebres@users.sourceforge.net>2024-05-28 13:03:33 (GMT)
commit01ba0865d8ceaa19c915e6c65d14928d67e0e32d (patch)
treef32d962f5a8b8cde401d74771724b9af2df5a236 /tests
parent561857f79ddc37df783119ffaa0beb5354379f3b (diff)
downloadtcl-01ba0865d8ceaa19c915e6c65d14928d67e0e32d.zip
tcl-01ba0865d8ceaa19c915e6c65d14928d67e0e32d.tar.gz
tcl-01ba0865d8ceaa19c915e6c65d14928d67e0e32d.tar.bz2
cmdMZ.test: more precise and fast _nrt_sleep, no failures with valgrind
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdMZ.test15
1 files changed, 11 insertions, 4 deletions
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index ff6efaa..cf63b9f 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -324,11 +324,15 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# 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} {
- # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise):
- # after 0
+ set usec [expr {$msec * 1000}]
+ set etime [expr {$stime + $usec}]
+ while {[set tm [clock microseconds]] < $etime} {
+ # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise):
+ # after 0
+ if {$tm < $stime} { # avoid too long delays by backwards time jumps, simply skip test
+ tcltest::Skip "time-jump?"
+ }
}
}
_nrt_sleep 0; # warm up (clock, compile, etc)
@@ -408,6 +412,9 @@ test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measurement} -body {
set m1 [timerate {_nrt_sleep 0.01} 50]
set m2 [timerate {_nrt_sleep 1.00} 50]
+ if {[testConstraint valgrind] && ([lindex $m1 0] >= 100 || [lindex $m1 2] <= 500)} {
+ tcltest::Skip "too-slow-by-valgrind"
+ }
list [list \
[expr {[lindex $m1 0] < [lindex $m2 0]}] \
[expr {[lindex $m1 0] < 100}] \