File: cron.test

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (525 lines) | stat: -rw-r--r-- 11,628 bytes parent folder | download | duplicates (5)
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