diff options
author | sebres <sebres@users.sourceforge.net> | 2019-03-05 12:58:11 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2019-03-05 12:58:11 (GMT) |
commit | 1568393cf3615816e44c90bc533a69e60c6b7ede (patch) | |
tree | 8d2876945b15df8bcf9b8f0776b9112eb62850d4 /tests-perf | |
parent | 6d9266494b57aade906d8ed8a62c7648dcb26bb7 (diff) | |
download | tcl-1568393cf3615816e44c90bc533a69e60c6b7ede.zip tcl-1568393cf3615816e44c90bc533a69e60c6b7ede.tar.gz tcl-1568393cf3615816e44c90bc533a69e60c6b7ede.tar.bz2 |
back-porting other performance test (timer-event.perf.tcl) from event-perf-branch
Diffstat (limited to 'tests-perf')
-rw-r--r-- | tests-perf/timer-event.perf.tcl | 219 |
1 files changed, 219 insertions, 0 deletions
diff --git a/tests-perf/timer-event.perf.tcl b/tests-perf/timer-event.perf.tcl new file mode 100644 index 0000000..6732a81 --- /dev/null +++ b/tests-perf/timer-event.perf.tcl @@ -0,0 +1,219 @@ +#!/usr/bin/tclsh + +# ------------------------------------------------------------------------ +# +# timer-event.perf.tcl -- +# +# This file provides performance tests for comparison of tcl-speed +# of timer events (event-driven tcl-handling). +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2014 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + + +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + + +namespace eval ::tclTestPerf-Timer-Event { + +namespace path {::tclTestPerf} + +proc test-queue {howmuch} { + + # 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]} + # update / after idle: + {update; \# $howmuch idle-events} + + # generate $howmuch idle-events: + {time {after idle {set foo bar}} $howmuch; llength [after info]} + # update idletasks / after idle: + {update idletasks; \# $howmuch idle-events} + + # generate $howmuch immediate events: + {time {after 0 {set foo bar}} $howmuch; llength [after info]} + # update / after 0: + {update; \# $howmuch timer-events} + + # generate $howmuch 1-ms events: + {time {after 1 {set foo bar}} $howmuch; llength [after info]} + setup {after 1} + # update / after 1: + {update; \# $howmuch timer-events} + + # generate $howmuch immediate events (+ 1 event of the second generation): + {time {after 0 {after 0 {}}} $howmuch; llength [after info]} + # update / after 0 (double generation): + {while {1} {update; if {![llength [after info]]} break }; \# all generations of events} + + # 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} + 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} + 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} + 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} + cleanup {update; unset -nocomplain ev} + # end $howmuch events. + }] +} + +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)}])} + 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)}])} + cleanup {update; unset -nocomplain ev} + }] + } +} + +proc test-exec {{reptime 1000}} { + _test_run $reptime { + # after idle + after cancel + {after cancel [after idle {set foo bar}]} + # after 0 + after cancel + {after cancel [after 0 {set foo bar}]} + # after idle + update idletasks + {after idle {set foo bar}; update idletasks} + # after idle + update + {after idle {set foo bar}; update} + # immediate: after 0 + update + {after 0 {set foo bar}; update} + # delayed: after 1 + update + {after 1 {set foo bar}; update} + # empty update: + {update} + # empty update idle tasks: + {update idletasks} + + # simple shortest sleep: + {after 0} + } +} + +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: + {after 0 {set a 5}; update} + {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} + } +} + +proc test-long {{reptime 1000}} { + _test_run $reptime { + # in-between important event by amount of idle events: + {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;} + cleanup {foreach i [after info] {after cancel $i}} + # in-between important event (of new generation) by amount of idle events: + {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} + cleanup {foreach i [after info] {after cancel $i}} + } +} + +proc test {{reptime 1000}} { + test-exec $reptime + test-access $reptime + if {![catch {update -noidle}]} { + test-exec-new $reptime + test-nrt-capability $reptime + } + test-long $reptime + + puts "" + foreach howmuch { 10000 20000 40000 60000 } { + test-queue $howmuch + } + + puts \n**OK** +} + +}; # end of ::tclTestPerf-Timer-Event + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in {-time 500} + array set in $argv + ::tclTestPerf-Timer-Event::test $in(-time) +} |