tests/scheduler.test

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 package require Tcl 8.5
   4
   5 if {[lsearch [namespace children] ::tcltest] == -1} {
   6         package require tcltest 2.2.5
   7         namespace import ::tcltest::*
   8 }
   9
  10 package require TLC-base
  11
  12 test scheduler-1.1 {Construct tlc::Scheduler} -setup { #<<<
  13         set events_ds   [tlc::DSlist ::#auto -headers {id script} -list {}]
  14 } -body {
  15         tlc::Scheduler scheduler -events_ds $events_ds
  16 } -result {scheduler} -cleanup {
  17         if {[itcl::is object scheduler]} {
  18                 delete object scheduler
  19         }
  20         if {[info exists events_ds] && [itcl::is object $events_ds]} {
  21                 delete object $events_ds
  22                 unset events_ds
  23         }
  24 }
  25 #>>>
  26 test scheduler-1.2 {Catch missing -events_ds} -body { #<<<
  27         tlc::Scheduler scheduler
  28 } -returnCodes {
  29         error
  30 } -cleanup {
  31         if {[itcl::is object scheduler]} {
  32                 delete object scheduler
  33         }
  34 } -result {Must set -events_ds}
  35 #>>>
  36 test scheduler-1.3 {Test event scheduling} -setup { #<<<
  37         set events_ds   [tlc::DSlist ::#auto -headers {id script} -list {
  38                 {1      {
  39                         proc get_events {start_s end_s} {
  40                                 set events      {}
  41
  42                                 set s   [expr {(($start_s / 3600) * 3600) + 3600}]
  43                                 while {$s <= $end_s} {
  44                                         lappend events  [list $s [list hourly_event $s]]
  45                                         incr s 3600
  46                                 }
  47                                 return $events
  48                         }
  49                 }}
  50                 {2      {
  51                         proc get_events {start_s end_s} {
  52                                 set events      {}
  53
  54                                 set s   [expr {(($start_s / 86400) * 86400) + 86400}]
  55                                 while {$s <= $end_s} {
  56                                         lappend events  [list $s [list daily_event $s]]
  57                                         incr s 86400
  58                                 }
  59                                 return $events
  60                         }
  61                 }}
  62         }]
  63 } -body {
  64         # Ensure we aren't on the cusp of a point that could break the prediction
  65         if {3600 - ([clock seconds] % 3600) < 3} {
  66                 after 4000
  67         }
  68
  69         # Predict events that will be posted <<<
  70         set start_s             [clock seconds]
  71         set end_s               [expr {$start_s + 7 * 86400}]
  72         set s   [expr {(([clock seconds] / 3600) * 3600) + 3600}]
  73         set predicted   {}
  74         while {$s < $end_s} {
  75                 set thisevent   {}
  76                 if {$s % 3600 == 0} {
  77                         lappend thisevent [list 1 [list hourly_event $s]]
  78                 }
  79                 if {$s % 86400 == 0} {
  80                         lappend thisevent [list 2 [list daily_event $s]]
  81                 }
  82                 if {[llength $thisevent] > 0} {
  83                         lappend predicted       $s $thisevent
  84                 }
  85                 incr s 3600
  86         }
  87         # Predict events that will be posted >>>
  88
  89         tlc::Scheduler scheduler -events_ds $events_ds
  90         set events      [scheduler _test_pending_events]
  91         expr {$events == $predicted && [llength $events] > 0}
  92 } -result {1} -cleanup {
  93         if {[itcl::is object scheduler]} {
  94                 delete object scheduler
  95         }
  96         if {[info exists events_ds] && [itcl::is object $events_ds]} {
  97                 delete object $events_ds
  98                 unset events_ds
  99         }
 100 }
 101 #>>>
 102 test scheduler-1.4 {Catch error with event source script} -setup { #<<<
 103         set events_ds   [tlc::DSlist ::#auto -headers {id script} -list {
 104                 {1      {
 105                         # Doesn't define get_events
 106                 }}
 107         }]
 108 } -body {
 109         tlc::Scheduler scheduler -events_ds $events_ds
 110 } -result {scheduler} -cleanup {
 111         if {[itcl::is object scheduler]} {
 112                 delete object scheduler
 113         }
 114         if {[info exists events_ds] && [itcl::is object $events_ds]} {
 115                 delete object $events_ds
 116                 unset events_ds
 117         }
 118 } -match glob -errorOutput {*Event source 1 does not define get_events proc*}
 119 #>>>
 120 test scheduler-1.5 {Test simple event dispatch} -setup { #<<<
 121         set ::sum       0
 122         proc receive_event {script_id event_data} {
 123                 lassign $event_data name num
 124                 puts stderr "received $name $num"
 125                 incr ::sum      $num
 126         }
 127
 128         set events_ds   [tlc::DSlist ::#auto -headers {id script} -list {
 129                 {1      {
 130                         proc get_events {start_s end_s} {
 131                                 set events      {}
 132
 133                                 for {set s 1} {$s <= 3} {incr s} {
 134                                         lappend events  [list [expr {$start_s + $s}] [list test $s]]
 135                                 }
 136                                 lappend events  [list [expr {$start_s + 20}] [list test 20]]
 137                                 return $events
 138                         }
 139                 }}
 140         }]
 141 } -body {
 142         # Ensure we aren't on the cusp of a point that could break the prediction
 143         set delta       [expr {1000 - ([clock milliseconds] % 1000)}]
 144         after [expr {$delta + 100}]
 145         # We should be around 102ms into this second window
 146
 147         tlc::Scheduler scheduler -events_ds $events_ds
 148         scheduler register_handler event_fired receive_event
 149         after 5000 {set ::flag 1}
 150         vwait ::flag
 151         set ::sum
 152 } -cleanup {
 153         if {[itcl::is object scheduler]} {
 154                 delete object scheduler
 155         }
 156         if {[info exists events_ds] && [itcl::is object $events_ds]} {
 157                 delete object $events_ds
 158                 unset events_ds
 159         }
 160         rename receive_event {}
 161         unset ::sum
 162 } -result {6}
 163 #>>>
 164
 165 ::tcltest::cleanupTests
 166 return
 167