extended performance test-suite, since max-count is implemented in timerate, usage `::tclTestPerf::_test_run ?-no-result? reptime lst ?outcmd?`;

update timer-event.perf.tcl for better readability (covering execution in multiple iterations now regarding max-count, so provides more precise result now);
removed unused test-cases here (new cases of event-perf-branch only).

2 files changed, 81 insertions, 95 deletions

diff --git a/tests-perf/test-performance.tcl b/tests-perf/test-performance.tcl
index b0cbb17..4629cd4 100644
--- a/tests-perf/test-performance.tcl
+++ b/tests-perf/test-performance.tcl
@@ -75,7 +75,7 @@ proc _test_out_total {} {
   puts "Total $s:"
   lset _(m) 0 [format %.6f $wtm]
   lset _(m) 2 $wcnt
-  lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * $_(reptime))) / 1000.0)}]]
+  lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]]
   if {[llength $_(m)] > 6} {
     lset _(m) 6 [format %.3f $nett]
   }
@@ -96,10 +96,29 @@ proc _test_out_total {} {
   puts ""
 }
 
-proc _test_run {reptime lst {outcmd {puts $_(r)}}} {
+proc _test_run {args} {
   upvar _ _
+  # parse args:
+  set _(out-result) 1
+  if {[lindex $args 0] eq "-no-result"} {
+    set _(out-result) 0
+    set args [lrange $args 1 end]
+  }
+  if {[llength $args] < 2 || [llength $args] > 3} {
+    return -code error "wrong # args: should be \"[lindex [info level [info level]] 0] ?-no-result? reptime lst ?outcmd?\""
+  }
+  set outcmd {puts $_(r)}
+  set args [lassign $args reptime lst]
+  if {[llength $args]} {
+    set outcmd [lindex $args 0]
+  }
+  # avoid output if only once:
+  if {[lindex $reptime 0] <= 1 || ([llength $reptime] > 1 && [lindex $reptime 1] == 1)} {
+    set _(out-result) 0
+  }
   array set _ [list itm {} reptime $reptime starttime [clock milliseconds]]
 
+  # process measurement:
   foreach _(c) [_test_get_commands $lst] {
     puts "% [regsub -all {\n[ \t]*} $_(c) {; }]"
     if {[regexp {^\s*\#} $_(c)]} continue
@@ -107,11 +126,15 @@ proc _test_run {reptime lst {outcmd {puts $_(r)}}} {
       puts [if 1 [lindex $_(c) 1]]
       continue
     }
-    if {$reptime > 1} {; #if not once:
+    # if output result (and not once):
+    if {$_(out-result)} {
       set _(r) [if 1 $_(c)]
       if {$outcmd ne {}} $outcmd
+      if {[llength $_(reptime)] > 1} { # decrement max-count
+        lset _(reptime) 1 [expr {[lindex $_(reptime) 1] - 1}]
+      }
     }
-    puts [set _(m) [timerate $_(c) $reptime]]
+    puts [set _(m) [timerate $_(c) {*}$_(reptime)]]
     lappend _(itm) $_(m)
     puts ""
   }
diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl
index 6732a81..805f0f8 100644
--- a/tests-perf/timer-event.perf.tcl
+++ b/tests-perf/timer-event.perf.tcl
@@ -25,75 +25,86 @@ namespace eval ::tclTestPerf-Timer-Event {
 
 namespace path {::tclTestPerf}
 
-proc test-queue {howmuch} {
+proc test-queue {{reptime {1000 10000}}} {
+
+  set howmuch [lindex $reptime 1]
 
   # because of extremely short measurement times by tests below, wait a little bit (warming-up),
   # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison)
   timerate {after 0} 156
 
-  puts "*** $howmuch events ***"
-  _test_run 0 [string map [list \$howmuch $howmuch \\# \#] {
-
-    # generate $howmuch idle-events:
-    {time {after idle {set foo bar}} $howmuch; llength [after info]}
+  puts "*** up to $howmuch events ***"
+  # single iteration by update, so using -no-result (measure only):
+  _test_run -no-result $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch \\# \#] {
+    # generate up to $howmuch idle-events:
+    {after idle {set foo bar}}
     # update / after idle:
-    {update; \# $howmuch idle-events}
+    {update; if {![llength [after info]]} break}
     
-    # generate $howmuch idle-events:
-    {time {after idle {set foo bar}} $howmuch; llength [after info]}
+    # generate up to $howmuch idle-events:
+    {after idle {set foo bar}}
     # update idletasks / after idle:
-    {update idletasks; \# $howmuch idle-events}
+    {update idletasks; if {![llength [after info]]} break}
 
-    # generate $howmuch immediate events:
-    {time {after 0 {set foo bar}} $howmuch; llength [after info]}
+    # generate up to $howmuch immediate events:
+    {after 0 {set foo bar}}
     # update / after 0:
-    {update; \# $howmuch timer-events}
+    {update; if {![llength [after info]]} break}
     
-    # generate $howmuch 1-ms events:
-    {time {after 1 {set foo bar}} $howmuch; llength [after info]}
+    # generate up to $howmuch 1-ms events:
+    {after 1 {set foo bar}}
     setup {after 1}
     # update / after 1:
-    {update; \# $howmuch timer-events}
+    {update; if {![llength [after info]]} break}
 
-    # generate $howmuch immediate events (+ 1 event of the second generation):
-    {time {after 0 {after 0 {}}} $howmuch; llength [after info]}
+    # generate up to $howmuch immediate events (+ 1 event of the second generation):
+    {after 0 {after 0 {}}}
     # update / after 0 (double generation):
-    {while {1} {update; if {![llength [after info]]} break }; \# all generations of events}
+    {update; if {![llength [after info]]} break}
 
     # cancel forwards "after idle" / $howmuch idle-events in queue:
-    setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch}
-    {set i 0; time {after cancel $ev([incr i])} $howmuch}
+    setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime}
+    setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
+    {after cancel $ev([incr i]); if {$i >= $le} break}
     cleanup {update; unset -nocomplain ev}
     # cancel backwards "after idle" / $howmuch idle-events in queue:
-    setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch}
-    {incr i; time {after cancel $ev([incr i -1])} $howmuch}
+    setup {set i 0; timerate {set ev([incr i]) [after idle {set foo bar}]} {*}$reptime}
+    setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
+    {after cancel $ev([incr i -1]); if {$i <= 1} break}
     cleanup {update; unset -nocomplain ev}
 
     # cancel forwards "after 0" / $howmuch timer-events in queue:
-    setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch}
-    {set i 0; time {after cancel $ev([incr i])} $howmuch}
+    setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
+    setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
+    {after cancel $ev([incr i]); if {$i >= $howmuch} break}
     cleanup {update; unset -nocomplain ev}
     # cancel backwards "after 0" / $howmuch timer-events in queue:
-    setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch}
-    {incr i; time {after cancel $ev([incr i -1])} $howmuch}
+    setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
+    setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
+    {after cancel $ev([incr i -1]); if {$i <= 1} break}
     cleanup {update; unset -nocomplain ev}
+    
     # end $howmuch events.
+    cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}}
   }]
 }
 
-proc test-access {{reptime 1000}} {
-  foreach count {5000 50000} {
-  _test_run $reptime [string map [list \$count $count] {
-    # event random access: after idle + after info (by $count events)
-    setup {set i -1; time {set ev([incr i]) [after idle {}]} $count; array size ev }
-    {after info $ev([expr {int(rand()*$count)}])}
+proc test-access {{reptime {1000 5000}}} {
+  set howmuch [lindex $reptime 1]
+
+  _test_run $reptime [string map [list \{*\}\$reptime $reptime \$howmuch $howmuch] {
+    # event random access: after idle + after info (by $howmuch events)
+    setup {set i -1; timerate {set ev([incr i]) [after idle {}]} {*}$reptime}
+    {after info $ev([expr {int(rand()*$i)}])}
     cleanup {update; unset -nocomplain ev}
-    # event random access: after 0 + after info (by $count events)
-    setup {set i -1; time {set ev([incr i]) [after 0 {}]} $count; array size ev}
-    {after info $ev([expr {int(rand()*$count)}])}
+    # event random access: after 0 + after info (by $howmuch events)
+    setup {set i -1; timerate {set ev([incr i]) [after 0 {}]} {*}$reptime}
+    {after info $ev([expr {int(rand()*$i)}])}
     cleanup {update; unset -nocomplain ev}
+
+    # end $howmuch events.
+    cleanup {if [llength [after info]] {error "unexpected: [llength [after info]] events are still there."}}
   }]
-  }
 }
 
 proc test-exec {{reptime 1000}} {
@@ -120,28 +131,6 @@ proc test-exec {{reptime 1000}} {
   }
 }
 
-proc test-exec-new {{reptime 1000}} {
-  _test_run $reptime {
-    # conditional update pure idle only (without window):
-    {update -idle}
-    # conditional update without idle events:
-    {update -noidle}
-    # conditional update timers only:
-    {update -timer}
-    # conditional update AIO only:
-    {update -async}
-
-    # conditional vwait with zero timeout: pure idle only (without window):
-    {vwait -idle 0 x}
-    # conditional vwait with zero timeout: without idle events:
-    {vwait -noidle 0 x}
-    # conditional vwait with zero timeout: timers only:
-    {vwait -timer 0 x}
-    # conditional vwait with zero timeout: AIO only:
-    {vwait -async 0 x}
-  }
-}
-
 proc test-nrt-capability {{reptime 1000}} {
   _test_run $reptime {
     # comparison values:
@@ -149,33 +138,8 @@ proc test-nrt-capability {{reptime 1000}} {
     {after 0 {set a 5}; vwait a}
 
     # conditional vwait with very brief wait-time:
-    {vwait 1 a}
-    {vwait 0.5 a}
-    {vwait 0.2 a}
-    {vwait 0.1 a}
-    {vwait 0.05 a}
-    {vwait 0.02 a}
-    {vwait 0.01 a}
-    {vwait 0.005 a}
-    {vwait 0.001 a}
-
-    # NRT sleep / very brief delays (0.5 - 0.005):
-    {after 0.5}
-    {after 0.05}
-    {after 0.005}
-    # NRT sleep / very brief delays (0.1 - 0.001):
-    {after 0.1}
-    {after 0.01}
-    {after 0.001}
-
-    # comparison of update's executing event:
-    {after idle {set a 5}; update -idle -timer}
-    {after 0 {set a 5}; update -idle -timer}
-    {after idle {set a 5}; update -idle}
-    # comparison of vwait's executing event:
-    {after idle {set a 5}; vwait -idle -timer a}
-    {after 0 {set a 5}; vwait -idle -timer a}
-    {after idle {set a 5}; vwait -idle a}
+    {after 1 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}}
+    {after 0 {set a timeout}; vwait a; expr {$::a ne "timeout" ? 1 : "0[unset ::a]"}}
   }
 }
 
@@ -192,16 +156,15 @@ proc test-long {{reptime 1000}} {
 
 proc test {{reptime 1000}} {
   test-exec $reptime
-  test-access $reptime
-  if {![catch {update -noidle}]} {
-    test-exec-new $reptime
-    test-nrt-capability $reptime
+  foreach howmuch {5000 50000} {
+    test-access [list $reptime $howmuch]
   }
+  test-nrt-capability $reptime
   test-long $reptime
 
   puts ""
   foreach howmuch { 10000 20000 40000 60000 } {
-    test-queue $howmuch
+    test-queue [list $reptime $howmuch]
   }
 
   puts \n**OK**