blob: 12b3320a4242f0f5c3afb4dafe565d098db74515 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
#!/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 \\# \#] {
# update / after idle:
setup {puts [time {after idle {set foo bar}} $howmuch]}
{update; \# $howmuch idle-events}
# update idletasks / after idle:
setup {puts [time {after idle {set foo bar}} $howmuch]}
{update idletasks; \# $howmuch idle-events}
# update / after 0:
setup {puts [time {after 0 {set foo bar}} $howmuch]}
{update; \# $howmuch timer-events}
# update / after 1:
setup {puts [time {after 1 {set foo bar}} $howmuch]; after 1}
{update; \# $howmuch timer-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}
# 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}
# 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}
# 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}
# end $howmuch events.
}]
}
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}
}
}
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}
# 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
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)
}
|
