merge 8.6 (TIP#527, New measurement facilities in TCL: New command timerate, performance test suite)

1 files changed, 64 insertions, 0 deletions

diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index a5f3009..45231c8 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -342,6 +342,70 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
     invoked from within
 "time {error foo}"}}
 
+test cmdMZ-6.1 {Tcl_TimeRateObjCmd: basic format of command} {
+    list [catch {timerate} msg] $msg
+} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}}
+test cmdMZ-6.2.1 {Tcl_TimeRateObjCmd: basic format of command} {
+    list [catch {timerate a b c d} msg] $msg
+} {1 {wrong # args: should be "timerate ?-direct? ?-calibrate? ?-overhead double? command ?time ?max-count??"}}
+test cmdMZ-6.2.2 {Tcl_TimeRateObjCmd: basic format of command} {
+    list [catch {timerate a b c} msg] $msg
+} {1 {expected integer but got "b"}}
+test cmdMZ-6.2.3 {Tcl_TimeRateObjCmd: basic format of command} {
+    list [catch {timerate a b} msg] $msg
+} {1 {expected integer but got "b"}}
+test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
+    list [catch {timerate -overhead b {} a b} msg] $msg
+} {1 {expected floating-point number but got "b"}}
+test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
+    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
+} {1 {missing close-brace}}
+test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {
+    regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 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]
+    list \
+	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
+	[expr {[lindex $m1 0] < 100}] \
+	[expr {[lindex $m2 0] >= 500}] \
+	[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}]
+} [lrepeat 9 1]
+test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
+    list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
+} {1 foo {foo
+    while executing
+"error foo"
+    invoked from within
+"timerate {error foo} 1"}}
+test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
+    set m1 [timerate {break}]
+    list \
+	[expr {[lindex $m1 0] < 1000}] \
+	[expr {[lindex $m1 2] == 1}] \
+	[expr {[lindex $m1 4] > 1000}] \
+	[expr {[lindex $m1 6] < 10}]
+} {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
+    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]
+    list \
+	[expr {[lindex $m1 0] == 0.0}] \
+	[expr {[lindex $m1 2] == 1}] \
+	[expr {[lindex $m1 4] == 1000000}] \
+	[expr {[lindex $m1 6] <= 0.001}]
+} {1 1 1 1}
+
 # The tests for Tcl_WhileObjCmd are in while.test
 
 # cleanup