blob: 8256a0ece63c0997bfe0028f4ce9a768df0e251a (
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
179
180
181
182
|
#!/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 -encoding utf-8 [file join [file dirname [info script]] test-performance.tcl]
}
namespace eval ::tclTestPerf-Timer-Event {
namespace path {::tclTestPerf}
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 "*** 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; if {![llength [after info]]} break}
# generate up to $howmuch idle-events:
{after idle {set foo bar}}
# update idletasks / after idle:
{update idletasks; if {![llength [after info]]} break}
# generate up to $howmuch immediate events:
{after 0 {set foo bar}}
# update / after 0:
{update; if {![llength [after info]]} break}
# generate up to $howmuch 1-ms events:
{after 1 {set foo bar}}
setup {after 1}
# update / after 1:
{update; if {![llength [after info]]} break}
# generate up to $howmuch immediate events (+ 1 event of the second generation):
{after 0 {after 0 {}}}
# update / after 0 (double generation):
{update; if {![llength [after info]]} break}
# cancel forwards "after idle" / $howmuch idle-events in queue:
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; 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; 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 >= $le} break}
cleanup {update; unset -nocomplain ev}
# cancel backwards "after 0" / $howmuch timer-events in queue:
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 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 $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}} {
_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-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:
{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]"}}
}
}
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
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 [list $reptime $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)
}
|
