tests/signalsource.test

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 if {[lsearch [namespace children] ::tcltest] == -1} {
   4         package require tcltest 2.2.5
   5         namespace import ::tcltest::*
   6 }
   7
   8 package require TLC-base
   9
  10 test signalsource-1.1 {Create a Signalsource} -body { #<<<
  11         set obj [tlc::Signalsource #auto]
  12         $obj isa tlc::Signalsource
  13 } -cleanup {
  14         if {[info exists obj] && [itcl::is object $obj]} {
  15                 delete object $obj
  16                 unset obj
  17         }
  18 } -result {1}
  19 #>>>
  20 test signalsource-1.2 {Host some signals} -body { #<<<
  21         class Foo {
  22                 inherit tlc::Signalsource
  23
  24                 constructor {} {
  25                         tlc::Signal testsig1 signals(test1) -name "$this test1"
  26                         tlc::Signal testsig2 signals(test2) -name "$this test2"
  27                 }
  28         }
  29
  30         Foo foo
  31
  32         set available   {}
  33         array set a     [foo signals_available]
  34         foreach name [lsort [array names a]] {
  35                 lappend available       $name $a($name)
  36         }
  37
  38         set available
  39 } -cleanup {
  40         if {[itcl::is object foo]} {delete object foo}
  41         if {[itcl::is class Foo]} {delete class Foo}
  42
  43         foreach var {available a} {
  44                 if {[info exists $var]} {
  45                         unset $var
  46                 }
  47         }
  48 } -result {test1 ::Foo::testsig1 test2 ::Foo::testsig2}
  49 #>>>
  50 test signalsource-1.3 {signal_ref method, valid signal} -body { #<<<
  51         class Foo {
  52                 inherit tlc::Signalsource
  53
  54                 constructor {} {
  55                         tlc::Signal testsig1 signals(test1) -name "$this test1"
  56                         tlc::Signal testsig2 signals(test2) -name "$this test2"
  57
  58                         $signals(test1) set_state 1
  59                 }
  60         }
  61
  62         Foo foo
  63
  64         list [[foo signal_ref test1] state] [[foo signal_ref test2] state]
  65 } -cleanup {
  66         if {[itcl::is object foo]} {delete object foo}
  67         if {[itcl::is class Foo]} {delete class Foo}
  68 } -result {1 0}
  69 #>>>
  70 test signalsource-1.4 {signal_ref method, invalid signal} -body { #<<<
  71         class Foo {
  72                 inherit tlc::Signalsource
  73
  74                 constructor {} {
  75                         tlc::Signal testsig1 signals(test1) -name "$this test1"
  76                         tlc::Signal testsig2 signals(test2) -name "$this test2"
  77
  78                         $signals(test1) set_state 1
  79                 }
  80         }
  81
  82         Foo foo
  83
  84         catch {
  85                 foo signal_ref test3
  86         } errmsg options
  87         set options     [dict merge {-errorcode ""} $options]
  88
  89         list $errmsg [dict get $options -errorcode]
  90 } -cleanup {
  91         if {[itcl::is object foo]} {delete object foo}
  92         if {[itcl::is class Foo]} {delete class Foo}
  93 } -result {{Invalid signal (test3)} {invalid_signal test3}}
  94 #>>>
  95 test signalsource-1.5 {signal_state method, valid signal} -body { #<<<
  96         class Foo {
  97                 inherit tlc::Signalsource
  98
  99                 constructor {} {
 100                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 101                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 102
 103                         $signals(test1) set_state 1
 104                 }
 105         }
 106
 107         Foo foo
 108
 109         list [foo signal_state test1] [foo signal_state test2]
 110 } -cleanup {
 111         if {[itcl::is object foo]} {delete object foo}
 112         if {[itcl::is class Foo]} {delete class Foo}
 113 } -result {1 0}
 114 #>>>
 115 test signalsource-1.6 {signal_state method, invalid signal} -body { #<<<
 116         class Foo {
 117                 inherit tlc::Signalsource
 118
 119                 constructor {} {
 120                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 121                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 122
 123                         $signals(test1) set_state 1
 124                 }
 125         }
 126
 127         Foo foo
 128
 129         catch {
 130                 foo signal_state test3
 131         } errmsg options
 132         set options     [dict merge {-errorcode ""} $options]
 133
 134         list $errmsg [dict get $options -errorcode]
 135 } -cleanup {
 136         if {[itcl::is object foo]} {delete object foo}
 137         if {[itcl::is class Foo]} {delete class Foo}
 138 } -result {{Invalid signal (test3)} {invalid_signal test3}}
 139 #>>>
 140 test signalsource-1.7 {Signal lifespan management} -body { #<<<
 141         class Foo {
 142                 inherit tlc::Signalsource
 143
 144                 constructor {} {
 145                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 146                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 147                 }
 148         }
 149
 150         Foo foo
 151
 152         set signal      [foo signal_ref test1]
 153         set before      [itcl::is object $signal]
 154
 155         delete object foo
 156
 157         set after       [itcl::is object $signal]
 158
 159         list $before $after
 160 } -cleanup {
 161         if {[itcl::is object foo]} {delete object foo}
 162         if {[itcl::is class Foo]} {delete class Foo}
 163
 164         foreach var {available a} {
 165                 if {[info exists $var]} {
 166                         unset $var
 167                 }
 168         }
 169 } -result {1 0}
 170 #>>>
 171 test signalsource-1.8 {waitfor method, invalid signal} -body { #<<<
 172         class Foo {
 173                 inherit tlc::Signalsource
 174
 175                 constructor {} {
 176                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 177                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 178
 179                         $signals(test1) set_state 1
 180                 }
 181         }
 182
 183         Foo foo
 184
 185         catch {
 186                 foo waitfor test3
 187         } errmsg options
 188         set options     [dict merge {-errorcode ""} $options]
 189
 190         list $errmsg [dict get $options -errorcode]
 191 } -cleanup {
 192         if {[itcl::is object foo]} {delete object foo}
 193         if {[itcl::is class Foo]} {delete class Foo}
 194 } -result {{Invalid signal (test3)} {invalid_signal test3}}
 195 #>>>
 196 test signalsource-1.9 {waitfor method, already true} -body { #<<<
 197         class Foo {
 198                 inherit tlc::Signalsource
 199
 200                 constructor {} {
 201                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 202                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 203
 204                         $signals(test1) set_state 1
 205                 }
 206         }
 207
 208         Foo foo
 209
 210         foo waitfor test1
 211
 212         foo signal_state test1
 213 } -cleanup {
 214         if {[itcl::is object foo]} {delete object foo}
 215         if {[itcl::is class Foo]} {delete class Foo}
 216 } -result {1}
 217 #>>>
 218 test signalsource-1.10 {waitfor method with timeout, already true} -body { #<<<
 219         class Foo {
 220                 inherit tlc::Signalsource
 221
 222                 constructor {} {
 223                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 224                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 225
 226                         $signals(test1) set_state 1
 227                 }
 228         }
 229
 230         Foo foo
 231
 232         foo waitfor test1 1000
 233
 234         foo signal_state test1
 235 } -cleanup {
 236         if {[itcl::is object foo]} {delete object foo}
 237         if {[itcl::is class Foo]} {delete class Foo}
 238 } -result {1}
 239 #>>>
 240 test signalsource-1.11 {waitfor method with timeout, timeout reached} -body { #<<<
 241         class Foo {
 242                 inherit tlc::Signalsource
 243
 244                 constructor {} {
 245                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 246                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 247
 248                         $signals(test1) set_state 1
 249                 }
 250         }
 251
 252         Foo foo
 253
 254         set before      [clock milliseconds]
 255         catch {
 256                 foo waitfor test2 100
 257         } errmsg options
 258         set after       [clock milliseconds]
 259
 260         set options     [dict merge {-errorcode ""} $options]
 261
 262         list [expr {$after - $before >= 100}] $errmsg [dict get $options -errorcode]
 263 } -cleanup {
 264         if {[itcl::is object foo]} {delete object foo}
 265         if {[itcl::is class Foo]} {delete class Foo}
 266
 267         foreach var {before after} {
 268                 if {[info exists $var]} {
 269                         unset $var
 270                 }
 271         }
 272 } -result {1 {Timeout waiting for signal "::foo test2"} {timeout {::foo test2}}}
 273 #>>>
 274 test signalsource-1.12 {waitfor method with timeout, timeout not reached} -body { #<<<
 275         class Foo {
 276                 inherit tlc::Signalsource
 277
 278                 constructor {} {
 279                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 280                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 281
 282                         $signals(test1) set_state 1
 283                 }
 284         }
 285
 286         Foo foo
 287
 288         set afterid     [after 50 [list apply {
 289                 {obj} {
 290                         $obj set_state 1
 291                 }
 292         } [foo signal_ref test2]]]
 293
 294         set before      [clock milliseconds]
 295         foo waitfor test2 100
 296         set after       [clock milliseconds]
 297
 298         list [expr {$after - $before < 80}] [foo signal_state test2]
 299 } -cleanup {
 300         if {[info exists afterid]} {
 301                 after cancel $afterid
 302                 unset afterid
 303         }
 304
 305         if {[itcl::is object foo]} {delete object foo}
 306         if {[itcl::is class Foo]} {delete class Foo}
 307
 308         foreach var {before after} {
 309                 if {[info exists $var]} {
 310                         unset $var
 311                 }
 312         }
 313 } -result {1 1}
 314 #>>>
 315 test signalsource-1.13 {waitfor method with timeout, waited signal dies} -body { #<<<
 316         class Foo {
 317                 inherit tlc::Signalsource
 318
 319                 constructor {} {
 320                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 321                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 322
 323                         $signals(test1) set_state 1
 324                 }
 325         }
 326
 327         Foo foo
 328
 329         set afterid     [after 50 [list apply {
 330                 {obj} {
 331                         delete object $obj
 332                 }
 333         } [foo signal_ref test2]]]
 334
 335         catch {
 336                 foo waitfor test2 100
 337         } errmsg options
 338         set options     [dict merge {-errorcode ""} $options]
 339
 340         list $errmsg [dict get $options -errorcode]
 341 } -cleanup {
 342         if {[info exists afterid]} {
 343                 after cancel $afterid
 344                 unset afterid
 345         }
 346
 347         if {[itcl::is object foo]} {delete object foo}
 348         if {[itcl::is class Foo]} {delete class Foo}
 349 } -result {{Source died while waiting for signal "::foo test2"} {source_died {::foo test2}}}
 350 #>>>
 351 test signalsource-1.14 {waitfor method with timeout, Signalsource dies} -body { #<<<
 352         class Foo {
 353                 inherit tlc::Signalsource
 354
 355                 constructor {} {
 356                         tlc::Signal testsig1 signals(test1) -name "$this test1"
 357                         tlc::Signal testsig2 signals(test2) -name "$this test2"
 358
 359                         $signals(test1) set_state 1
 360                 }
 361         }
 362
 363         Foo foo
 364
 365         set afterid     [after 50 {apply {
 366                 {} {
 367                         delete object foo
 368                 }
 369         }}]
 370
 371         catch {
 372                 foo waitfor test2 1000
 373         } errmsg options
 374         set options     [dict merge {-errorcode ""} $options]
 375
 376         list $errmsg [dict get $options -errorcode]
 377 } -cleanup {
 378         if {[info exists afterid]} {
 379                 after cancel $afterid
 380                 unset afterid
 381         }
 382
 383         if {[itcl::is object foo]} {delete object foo}
 384         if {[itcl::is class Foo]} {delete class Foo}
 385 } -result {{Source died while waiting for signal "::foo test2"} {source_died {::foo test2}}}
 386 #>>>
 387
 388 ::tcltest::cleanupTests
 389 return
 390
 391