diff options
author | sebres <sebres@users.sourceforge.net> | 2019-11-06 23:08:53 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-11-06 23:08:53 (GMT) |
commit | bdf8f9cc31ac1d71dbb46090b4f5d1c69c3cd4bd (patch) | |
tree | 8d93e2f937885f946521a1b98e09c72f95595406 /tests | |
parent | 92be9569b81be3e3c9c99455ad609fe5f8e2e76e (diff) | |
parent | 41cd7b2754b0d81fb8fc35f0a3abaace7249471c (diff) | |
download | tcl-bdf8f9cc31ac1d71dbb46090b4f5d1c69c3cd4bd.zip tcl-bdf8f9cc31ac1d71dbb46090b4f5d1c69c3cd4bd.tar.gz tcl-bdf8f9cc31ac1d71dbb46090b4f5d1c69c3cd4bd.tar.bz2 |
merge 8.5
Diffstat (limited to 'tests')
-rw-r--r-- | tests/cmdMZ.test | 31 |
1 files changed, 17 insertions, 14 deletions
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index ab0887a..e661433 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -29,8 +29,6 @@ namespace eval ::tcl::test::cmdMZ { namespace import ::tcl::unsupported::timerate } - testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] - proc ListGlobMatch {expected actual} { if {[llength $expected] != [llength $actual]} { return 0 @@ -328,8 +326,12 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] set stime [clock microseconds] - while {abs([clock microseconds] - $stime) < $usec} {after 0} + 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 + } } +_nrt_sleep 0; # warm up (clock, compile, etc) test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body { time @@ -346,8 +348,8 @@ test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} 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} knownMsvcBug { - expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { + expr {[lindex [time {_nrt_sleep 0.01}] 0] < [lindex [time {_nrt_sleep 10.0}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo @@ -399,19 +401,20 @@ test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 -test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} knownMsvcBug { - set m1 [timerate {_nrt_sleep 0} 20] - set m2 [timerate {_nrt_sleep 0.2} 20] +test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { + lassign [timerate {_nrt_sleep 0} 50] ovh + set m1 [timerate -overhead $ovh {_nrt_sleep 0.01} 50] + set m2 [timerate -overhead $ovh {_nrt_sleep 1.00} 50] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ - [expr {[lindex $m1 2] > 1000}] \ - [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}] + [expr {[lindex $m1 2] > 500}] \ + [expr {[lindex $m2 2] < 500}] \ + [expr {[lindex $m1 4] > 10000}] \ + [expr {[lindex $m2 4] < 10000}] \ + [expr {[lindex $m1 6] > 5 && [lindex $m1 6] < 100}] \ + [expr {[lindex $m2 6] > 5 && [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 |