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 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525
|
# Tests for the cron module
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2016 by Sean Woods
# (Insert BSDish style "use at your own risk" license text)
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
package require tcltest
testsNeedTcl 8.6
testsNeedTcltest 1.0
support {
use dicttool/dicttool.tcl dicttool
}
testing {
useLocal cron.tcl cron
}
###
# For the first part of our testing, control the clock
# via the test harness
###
set ::cron::trace 0
set ::cron::time [expr {[clock scan {2016-01-01}]*1000}]
foreach {val testval} {
1000 1000
11235 11000
1241241 1241000
} {
test cron-step-$val [list test clock_step function for $val] {
::cron::clock_step $val
} $testval
}
proc test_elapsed_time {start target} {
set now [::cron::current_time]
set value [expr {$now-$start}]
if {$value < ($target-5)} {
puts "ELAPSED TIME WAS SHORT: $value / $target"
return 1
}
if {$value > ($target+250)} {
puts "ELAPSED TIME WAS LONG: $value / $target"
return 1
}
return 0
}
set start [::cron::current_time]
::cron::sleep 250
test cron-sleep-1 {Ensure sleep is in a plausible range} {
test_elapsed_time $start 250
} 0
# Sleep until the top of the second
::cron::clock_sleep 1
set start [::cron::current_time]
::cron::clock_sleep 0 750
test cron-sleep-2 {Ensure sleep is in a plausible range} {
test_elapsed_time $start 750
} 0
::cron::clock_sleep 1 0
test cron-sleep-3 {Ensure sleep is in a plausible range} {
test_elapsed_time $start 1000
} 0
::cron::clock_sleep 1 0
###
# Object interaction tests
###
oo::class create CronTest {
method coro_name {} {
return [info object namespace [self]]::idle
}
method idle {} {
set coro [my coro_name]
::cron::object_coroutine [self] $coro
::coroutine $coro {*}[namespace code {my IdleTask}]
}
}
###
# This test is a mockup of typical Tk widget
# which has some portion of its startup that has to
# process after an idle loop has completed
###
oo::class create CronTest_3Pings {
superclass CronTest
constructor {} {
set ::TESTOBJ([self]) 0
my idle
}
method IdleTask {} {
incr ::TESTOBJ([self])
yield
incr ::TESTOBJ([self])
yield
incr ::TESTOBJ([self])
}
}
CronTest_3Pings create FOO
set coro [FOO coro_name]
###
# The coroutine for the object exist on startup
test cron-objects-1-1 {cron::every} {
info commands $coro
} $coro
# And CRON knows about it
test cron-objects-1-2 {cron::every} {
::cron::task exists $coro
} 1
# The counter should be initialized to the value
# before the first yield
test cron-objects-1-3 {cron::every} {
set ::TESTOBJ(::FOO)
} 1
::cron::clock_sleep 1
###
# The coroutine should have completed, and now ceases to exist
###
test cron-objects-1-4 {cron::every} {
::cron::task exists $coro
} 0
# The counter should be 3
test cron-objects-1-5 {cron::every} {
set ::TESTOBJ(::FOO)
} 3
###
# Test that cron cleans up after a destroyed object
###
CronTest_3Pings create FOOBAR
set coro [FOOBAR coro_name]
###
# The coroutine for the object exist on startup
test cron-objects-2-1 {cron::every} {
info commands $coro
} $coro
# However CRON knows about it
test cron-objects-2-2 {cron::every} {
::cron::task exists $coro
} 1
FOOBAR destroy
# The idle routine did parse up to the first yield
test cron-objects-2-3 {cron::every} {
set ::TESTOBJ(::FOOBAR)
} 1
###
# The coroutine for the object exist on startup
test cron-objects-2-4 {cron::every} {
info commands $coro
} {}
# However CRON knows about it
test cron-objects-2-5 {cron::every} {
::cron::task exists $coro
} 1
# Trigger the idle loop
::cron::do_one_event TEST
# The idle routine did parse up to the first yield
test cron-objects-2-6 {cron::every} {
set ::TESTOBJ(::FOOBAR)
} 1
# The coroutine is still gone
test cron-objects-2-7 {cron::every} {
info commands $coro
} {}
# And now cron has forgotten about the object
test cron-objects-2-8 {cron::every} {
::cron::task exists $coro
} 0
::cron::do_one_event TEST
test cron-objects-2-9 {cron::every} {
info commands $coro
} {}
# However cron has forgotten about the object
test cron-objects-2-10 {cron::every} {
::cron::task exists $coro
} 0
oo::class create CronTest_Persistant_Coro {
superclass CronTest
constructor {} {
set nspace [info object namespace [self]]
set coro_do [my coro_name DoLoop]
set ::TESTOBJ([self]) -1
set now [::cron::current_time]
set frequency 1000
set scheduled [::cron::clock_step [expr {$now+$frequency}]]
::cron::object_coroutine [self] $coro_do [list frequency $frequency scheduled $scheduled command [namespace code {my DoLoop}]]
}
method coro_name {which} {
return [info object namespace [self]]::${which}
}
method exit_loop {} {
my variable doloop
set doloop 0
if {$::cron::trace} {
puts [list [self] SIGNAL TO EXIT]
}
}
method DoLoop {} {
if {$::cron::trace} {
puts "[self] CORO START"
}
my variable doloop
set doloop 1
set ::TESTOBJ([self]) 0
yield
while {$doloop} {
if {$::cron::trace} {
puts [list [self] LOOP $doloop]
}
incr ::TESTOBJ([self])
yield
}
if {$::cron::trace} {
puts "[self] CORO EXIT"
}
}
}
###
# This series of tests is built around a more complex case:
# an object wants a method invoked periodically. CRON
# will create a coroutine (based on the name given by the object)
# and invoke that coroutine at the frequency requested
#
# If the coroutine exits (or throws an error) It will be restarted
###
set ::cron::trace 0
::cron::clock_sleep 1
CronTest_Persistant_Coro create IRONBAR
set coro [IRONBAR coro_name DoLoop]
test cron-objects-3-1 {
The actual coroutine should not exist yet
} {
info commands $coro
} {}
# And CRON knows about it
test cron-objects-3-2 {
CRON should be aware of the task
} {
::cron::task exists $coro
} 1
test cron-objects-3-3 {
The counter should be initialized to the value
before the first yield
} {
set ::TESTOBJ(::IRONBAR)
} -1
set start [::cron::current_time]
::cron::clock_sleep 1
test cron-objects-3-4 {The coroutine for the object exists} {
info commands $coro
} $coro
test cron-objects-3-5 {Cron should know about the task} {
::cron::task exists $coro
} 1
test cron-objects-3-6 {The counter should have incremented} {
set ::TESTOBJ(::IRONBAR)
} 1
::cron::clock_sleep 0 500
test cron-objects-3-7 {The counter should have incremented} {
set ::TESTOBJ(::IRONBAR)
} 1
::cron::clock_sleep 1
# Test a graceful exit of the coroutine
::IRONBAR exit_loop
::cron::clock_sleep 1
set coro [IRONBAR coro_name DoLoop]
test cron-objects-3-8 {
The actual coroutine should now exit
} {
info commands $coro
} {}
test cron-objects-3-9 {
CRON should still be aware of the tast
} {
::cron::task exists $coro
} 1
test cron-objects-3-10 {The counter hasn't reset} {
set ::TESTOBJ(::IRONBAR)
} 2
::cron::clock_sleep 1
test cron-objects-3-11 {The should have reset when the coroutine restarted} {
set ::TESTOBJ(::IRONBAR)
} 1
#::cron::object_destroy ::IRONBAR
::IRONBAR destroy
set ::cron::trace 0
proc my_coro {} {
if {$::cron::trace} {
puts "START MY CORO"
}
set ::my_coro_progress 0
set ::my_coro_start [::cron::current_time]
if {$::cron::trace} {
puts "SLEEP MY CORO"
}
::cron::sleep 1250
if {$::cron::trace} {
puts "/SLEEP MY CORO"
}
set ::my_coro_end [::cron::current_time]
set ::my_coro_progress 1
if {$::cron::trace} {
puts "END MY CORO"
}
}
###
# Test that an otherwise inprepared coroutine
# which invokes "::cron::sleep" partipates in
# the ::cron event system
###
if {$::cron::trace} {
puts "PRE-MY CORO"
}
coroutine ::TESTCORO my_coro
if {$::cron::trace} {
puts "POST-MY CORO"
}
test cron-naive-corotine-1 {cron::coroutine sleep} {
set ::my_coro_progress
} 0
::cron::clock_sleep 3
set ::cron::trace 0
test cron-naive-corotine-2 {cron::coroutine sleep} {
set ::my_coro_progress
} 1
test cron-naive-corotine-3 {cron::coroutine sleep} {
set delay [expr {($::my_coro_end - $::my_coro_start)}]
if {$delay < 1000 || $delay > 2000} {
puts "TIME DELAY OUT OF RANGE: $delay"
return 1
} else {
return 0
}
} 0
###
# Tests after this point test interactions with the Tcl event loop
# We need to be slaved to the real time clock to work properly
###
set ::cron::trace 0
set ::cron::time -1
###
# Test the clock sleep offset feature
###
# Reset to the top of a clock step
::cron::clock_sleep 1
set ::cron::trace 0
set start [::cron::current_time]
set ::FLAG -1
set time_0 [::cron::clock_delay 1000]
set time_1 [::cron::clock_delay 2000]
after $time_0 {set ::FLAG 0}
after $time_1 {set ::FLAG 1}
test cron-delay-1 {Prior to the first event the value should not have changed} {
set ::FLAG
} -1
vwait ::FLAG
test cron-delay-3 {At the top of the second, we should have a new value for flag} {
set ::FLAG
} 0
vwait ::FLAG
test cron-delay-5 {At the top of the second second, we should have a new value for flag} {
set ::FLAG
} 1
set ::cron::trace 0
proc elapsed_time_coro {} {
set ::start [::cron::current_time]
while 1 {
set now [::cron::current_time]
set ::elapsed_time [expr {($now-$::start)/1000}]
yield
}
}
::cron::task set ::ELAPSED_TIME \
coroutine ::ELAPSED_TIME \
command elapsed_time_coro \
frequency 1000
set timecounter 0
::cron::every timecounter 1 {incr timecounter}
set now [clock seconds]
# Test at
set timerevent 0
::cron::at timeevent1 [expr {$now + 5}] {set ::timerevent 1}
::cron::at timeevent2 [expr {$now + 6}] {set ::eventpause 0}
::cron::at timeevent3 [expr {$now + 10}] {set ::timerevent 2}
::cron::at timeevent4 [expr {$now + 11}] {set ::pause 0}
test cron-1.1 {cron::every} {
set ::timecounter
} 0
test cron-1.2 {cron::at1} {
set ::timerevent
} 0
vwait eventpause
test cron-1.3 {cron::at1} {
set ::timerevent
} 1
###
# At this point 6 seconds should have passed
###
#test cron-1.elapsed-1 {Elapsed time} {
# set ::elapsed_time
#} 5
# - Test removed - Was too unstable on a busy computer
vwait pause
###
# At this point 11 seconds should have passed
###
#test cron-1.elapsed-2 {Elapsed time} {
# set ::elapsed_time
#} 10
# - Test removed - Was too unstable on a busy computer
# Test that in X seconds our timer
# was incremented X times
#test cron-1.4 {cron::every} {
# set ::timecounter
#} $::elapsed_time
#
# - Test removed - Was too unstable on a busy computer
test cron-1.5 {cron::at2} {
set ::timerevent
} 2
###
# Confirm cancel works
::cron::cancel timecounter
set timecounterfinal $::timecounter
::cron::clock_sleep 2
test cron-1.6 {cron::cancel} {
set ::timecounter
} $::timecounterfinal
###
# Test the new IN command
###
set ::inevent 0
cron::in 5 {set ::inevent 1}
test cron-1.7 {cron::in} {
set ::inevent
} 0
::cron::clock_sleep 6
test cron-1.8 {cron::in} {
set ::inevent
} 1
set FAILED 0
after 10000 {set ::cron::forever 0 ; set FAILED 1}
::cron::in 5 {
set ::cron::forever 0
test cron-1.12 {cron::main} {
set ::cron::forever
} 0
}
::cron::wake TEST
###
# At this point 22 seconds should have passed
###
#test cron-1.elapsed-3 {Elapsed time} {
# set ::elapsed_time
#} 21
#
# Test removed - it was too unstable on a real working computer
::cron::main
# If we get to this test, mission successful
test cron-1.13 {cron::main} {
return 1
} 1
test cron-1.14 {cron::main} {
set FAILED
} 0
testsuiteCleanup
return
|