Tcl Source Code

Check-in [c3a401ee2c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:back-porting other performance test (timer-event.perf.tcl) from event-perf-branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sebres-8-5-timerate
Files: files | file ages | folders
SHA3-256: c3a401ee2c13a601f3fb06f97c5457ba08d87fb7410c5000855bab15ce7d3e53
User & Date: sebres 2019-03-05 12:58:11
Context
2019-03-05
15:46
extended performance test-suite, since max-count is implemented in timerate, usage `::tclTestPerf::_... Closed-Leaf check-in: 1e109808c9 user: sebres tags: sebres-8-5-timerate
12:58
back-porting other performance test (timer-event.perf.tcl) from event-perf-branch check-in: c3a401ee2c user: sebres tags: sebres-8-5-timerate
12:56
back-porting test-performance suite and clock.perf.tcl from clock-speedup branch check-in: 6d517f3acd user: sebres tags: sebres-8-5-timerate
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added tests-perf/timer-event.perf.tcl.

            1  +#!/usr/bin/tclsh
            2  +
            3  +# ------------------------------------------------------------------------
            4  +#
            5  +# timer-event.perf.tcl --
            6  +# 
            7  +#  This file provides performance tests for comparison of tcl-speed
            8  +#  of timer events (event-driven tcl-handling).
            9  +#
           10  +# ------------------------------------------------------------------------
           11  +# 
           12  +# Copyright (c) 2014 Serg G. Brester (aka sebres)
           13  +# 
           14  +# See the file "license.terms" for information on usage and redistribution
           15  +# of this file.
           16  +# 
           17  +
           18  +
           19  +if {![namespace exists ::tclTestPerf]} {
           20  +  source [file join [file dirname [info script]] test-performance.tcl]
           21  +}
           22  +
           23  +
           24  +namespace eval ::tclTestPerf-Timer-Event {
           25  +
           26  +namespace path {::tclTestPerf}
           27  +
           28  +proc test-queue {howmuch} {
           29  +
           30  +  # because of extremely short measurement times by tests below, wait a little bit (warming-up),
           31  +  # to minimize influence of the time-gradation (just for better dispersion resp. result-comparison)
           32  +  timerate {after 0} 156
           33  +
           34  +  puts "*** $howmuch events ***"
           35  +  _test_run 0 [string map [list \$howmuch $howmuch \\# \#] {
           36  +
           37  +    # generate $howmuch idle-events:
           38  +    {time {after idle {set foo bar}} $howmuch; llength [after info]}
           39  +    # update / after idle:
           40  +    {update; \# $howmuch idle-events}
           41  +    
           42  +    # generate $howmuch idle-events:
           43  +    {time {after idle {set foo bar}} $howmuch; llength [after info]}
           44  +    # update idletasks / after idle:
           45  +    {update idletasks; \# $howmuch idle-events}
           46  +
           47  +    # generate $howmuch immediate events:
           48  +    {time {after 0 {set foo bar}} $howmuch; llength [after info]}
           49  +    # update / after 0:
           50  +    {update; \# $howmuch timer-events}
           51  +    
           52  +    # generate $howmuch 1-ms events:
           53  +    {time {after 1 {set foo bar}} $howmuch; llength [after info]}
           54  +    setup {after 1}
           55  +    # update / after 1:
           56  +    {update; \# $howmuch timer-events}
           57  +
           58  +    # generate $howmuch immediate events (+ 1 event of the second generation):
           59  +    {time {after 0 {after 0 {}}} $howmuch; llength [after info]}
           60  +    # update / after 0 (double generation):
           61  +    {while {1} {update; if {![llength [after info]]} break }; \# all generations of events}
           62  +
           63  +    # cancel forwards "after idle" / $howmuch idle-events in queue:
           64  +    setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch}
           65  +    {set i 0; time {after cancel $ev([incr i])} $howmuch}
           66  +    cleanup {update; unset -nocomplain ev}
           67  +    # cancel backwards "after idle" / $howmuch idle-events in queue:
           68  +    setup {set i 0; time {set ev([incr i]) [after idle {set foo bar}]} $howmuch}
           69  +    {incr i; time {after cancel $ev([incr i -1])} $howmuch}
           70  +    cleanup {update; unset -nocomplain ev}
           71  +
           72  +    # cancel forwards "after 0" / $howmuch timer-events in queue:
           73  +    setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch}
           74  +    {set i 0; time {after cancel $ev([incr i])} $howmuch}
           75  +    cleanup {update; unset -nocomplain ev}
           76  +    # cancel backwards "after 0" / $howmuch timer-events in queue:
           77  +    setup {set i 0; time {set ev([incr i]) [after 0 {set foo bar}]} $howmuch}
           78  +    {incr i; time {after cancel $ev([incr i -1])} $howmuch}
           79  +    cleanup {update; unset -nocomplain ev}
           80  +    # end $howmuch events.
           81  +  }]
           82  +}
           83  +
           84  +proc test-access {{reptime 1000}} {
           85  +  foreach count {5000 50000} {
           86  +  _test_run $reptime [string map [list \$count $count] {
           87  +    # event random access: after idle + after info (by $count events)
           88  +    setup {set i -1; time {set ev([incr i]) [after idle {}]} $count; array size ev }
           89  +    {after info $ev([expr {int(rand()*$count)}])}
           90  +    cleanup {update; unset -nocomplain ev}
           91  +    # event random access: after 0 + after info (by $count events)
           92  +    setup {set i -1; time {set ev([incr i]) [after 0 {}]} $count; array size ev}
           93  +    {after info $ev([expr {int(rand()*$count)}])}
           94  +    cleanup {update; unset -nocomplain ev}
           95  +  }]
           96  +  }
           97  +}
           98  +
           99  +proc test-exec {{reptime 1000}} {
          100  +  _test_run $reptime {
          101  +    # after idle + after cancel
          102  +    {after cancel [after idle {set foo bar}]}
          103  +    # after 0 + after cancel
          104  +    {after cancel [after 0 {set foo bar}]}
          105  +    # after idle + update idletasks
          106  +    {after idle {set foo bar}; update idletasks}
          107  +    # after idle + update
          108  +    {after idle {set foo bar}; update}
          109  +    # immediate: after 0 + update
          110  +    {after 0 {set foo bar}; update}
          111  +    # delayed: after 1 + update
          112  +    {after 1 {set foo bar}; update}
          113  +    # empty update:
          114  +    {update}
          115  +    # empty update idle tasks:
          116  +    {update idletasks}
          117  +
          118  +    # simple shortest sleep:
          119  +    {after 0}
          120  +  }
          121  +}
          122  +
          123  +proc test-exec-new {{reptime 1000}} {
          124  +  _test_run $reptime {
          125  +    # conditional update pure idle only (without window):
          126  +    {update -idle}
          127  +    # conditional update without idle events:
          128  +    {update -noidle}
          129  +    # conditional update timers only:
          130  +    {update -timer}
          131  +    # conditional update AIO only:
          132  +    {update -async}
          133  +
          134  +    # conditional vwait with zero timeout: pure idle only (without window):
          135  +    {vwait -idle 0 x}
          136  +    # conditional vwait with zero timeout: without idle events:
          137  +    {vwait -noidle 0 x}
          138  +    # conditional vwait with zero timeout: timers only:
          139  +    {vwait -timer 0 x}
          140  +    # conditional vwait with zero timeout: AIO only:
          141  +    {vwait -async 0 x}
          142  +  }
          143  +}
          144  +
          145  +proc test-nrt-capability {{reptime 1000}} {
          146  +  _test_run $reptime {
          147  +    # comparison values:
          148  +    {after 0 {set a 5}; update}
          149  +    {after 0 {set a 5}; vwait a}
          150  +
          151  +    # conditional vwait with very brief wait-time:
          152  +    {vwait 1 a}
          153  +    {vwait 0.5 a}
          154  +    {vwait 0.2 a}
          155  +    {vwait 0.1 a}
          156  +    {vwait 0.05 a}
          157  +    {vwait 0.02 a}
          158  +    {vwait 0.01 a}
          159  +    {vwait 0.005 a}
          160  +    {vwait 0.001 a}
          161  +
          162  +    # NRT sleep / very brief delays (0.5 - 0.005):
          163  +    {after 0.5}
          164  +    {after 0.05}
          165  +    {after 0.005}
          166  +    # NRT sleep / very brief delays (0.1 - 0.001):
          167  +    {after 0.1}
          168  +    {after 0.01}
          169  +    {after 0.001}
          170  +
          171  +    # comparison of update's executing event:
          172  +    {after idle {set a 5}; update -idle -timer}
          173  +    {after 0 {set a 5}; update -idle -timer}
          174  +    {after idle {set a 5}; update -idle}
          175  +    # comparison of vwait's executing event:
          176  +    {after idle {set a 5}; vwait -idle -timer a}
          177  +    {after 0 {set a 5}; vwait -idle -timer a}
          178  +    {after idle {set a 5}; vwait -idle a}
          179  +  }
          180  +}
          181  +
          182  +proc test-long {{reptime 1000}} {
          183  +  _test_run $reptime {
          184  +    # in-between important event by amount of idle events:
          185  +    {time {after idle {after 30}} 10; after 1 {set important 1}; vwait important;}
          186  +    cleanup {foreach i [after info] {after cancel $i}}
          187  +    # in-between important event (of new generation) by amount of idle events:
          188  +    {time {after idle {after 30}} 10; after 1 {after 0 {set important 1}}; vwait important;} 
          189  +    cleanup {foreach i [after info] {after cancel $i}}
          190  +  }
          191  +}
          192  +
          193  +proc test {{reptime 1000}} {
          194  +  test-exec $reptime
          195  +  test-access $reptime
          196  +  if {![catch {update -noidle}]} {
          197  +    test-exec-new $reptime
          198  +    test-nrt-capability $reptime
          199  +  }
          200  +  test-long $reptime
          201  +
          202  +  puts ""
          203  +  foreach howmuch { 10000 20000 40000 60000 } {
          204  +    test-queue $howmuch
          205  +  }
          206  +
          207  +  puts \n**OK**
          208  +}
          209  +
          210  +}; # end of ::tclTestPerf-Timer-Event
          211  +
          212  +# ------------------------------------------------------------------------
          213  +
          214  +# if calling direct:
          215  +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
          216  +  array set in {-time 500}
          217  +  array set in $argv
          218  +  ::tclTestPerf-Timer-Event::test $in(-time)
          219  +}