1# -*- tcl -*- 2# 3# notify.test -- 4# 5# This file tests several functions in the file, 'generic/tclNotify.c'. 6# 7# This file contains a collection of tests for one or more of the Tcl 8# built-in commands. Sourcing this file into Tcl runs the tests and 9# generates output for errors. No output means no errors were found. 10# 11# Copyright © 2003 Kevin B. Kenny. All rights reserved. 12# 13# See the file "license.terms" for information on usage and redistribution 14# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 16if {"::tcltest" ni [namespace children]} { 17 package require tcltest 2.5 18 namespace import -force ::tcltest::* 19} 20 21::tcltest::loadTestedCommands 22catch [list package require -exact tcl::test [info patchlevel]] 23 24testConstraint testevent [llength [info commands testevent]] 25 26test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ 27 -constraints {testevent} \ 28 -body { 29 set delivered {} 30 after 10 set done 1 31 testevent queue one tail {lappend delivered one; expr 1} 32 vwait done 33 set delivered 34 } \ 35 -result {one} 36 37test notify-1.2 {Tcl_QueueEvent and delivery of events in order} \ 38 -constraints {testevent} \ 39 -body { 40 set delivered {} 41 after 10 set done 1 42 testevent queue one tail {lappend delivered one; expr 1} 43 testevent queue two tail {lappend delivered two; expr 1} 44 testevent queue three tail {lappend delivered three; expr 1} 45 vwait done 46 set delivered 47 } \ 48 -result {one two three} 49 50test notify-1.3 {Tcl_QueueEvent at head} \ 51 -constraints {testevent} \ 52 -body { 53 set delivered {} 54 after 10 set done 1 55 testevent queue one head {lappend delivered one; expr 1} 56 vwait done 57 set delivered 58 } \ 59 -result one 60 61test notify-1.4 {Tcl_QueueEvent multiple events at head} \ 62 -constraints {testevent} \ 63 -body { 64 set delivered {} 65 after 10 set done 1 66 testevent queue one head {lappend delivered one; expr 1} 67 testevent queue two head {lappend delivered two; expr 1} 68 testevent queue three head {lappend delivered three; expr 1} 69 vwait done 70 set delivered 71 } \ 72 -result {three two one} 73 74test notify-1.5 {Tcl_QueueEvent marker event into an empty queue} \ 75 -constraints {testevent} \ 76 -body { 77 set delivered {} 78 after 10 set done 1 79 testevent queue one mark {lappend delivered one; expr 1} 80 vwait done 81 set delivered 82 } \ 83 -result one 84 85test notify-1.6 {Tcl_QueueEvent first marker event in a nonempty queue} \ 86 -constraints {testevent} \ 87 -body { 88 set delivered {} 89 after 10 set done 1 90 testevent queue one tail {lappend delivered one; expr 1} 91 testevent queue two mark {lappend delivered two; expr 1} 92 testevent queue three head {lappend delivered three; expr 1} 93 vwait done 94 set delivered 95 } \ 96 -result {three two one} 97 98test notify-1.7 {Tcl_QueueEvent second marker event} \ 99 -constraints {testevent} \ 100 -body { 101 set delivered {} 102 after 10 set done 1 103 testevent queue one mark {lappend delivered one; expr 1} 104 testevent queue two mark {lappend delivered two; expr 1} 105 vwait done 106 set delivered 107 } \ 108 -result {one two} 109 110test notify-1.8 {Tcl_QueueEvent preexisting event following second marker} \ 111 -constraints {testevent} \ 112 -body { 113 set delivered {} 114 after 10 set done 1 115 testevent queue one mark {lappend delivered one; expr 1} 116 testevent queue two tail {lappend delivered two; expr 1} 117 testevent queue three mark {lappend delivered three; expr 1} 118 vwait done 119 set delivered 120 } \ 121 -result {one three two} 122 123test notify-2.1 {remove sole element, don't replace } \ 124 -constraints {testevent} \ 125 -body { 126 set delivered {} 127 after 10 set done 1 128 testevent queue one tail {lappend delivered one; expr 1} 129 testevent delete one 130 vwait done 131 set delivered 132 } \ 133 -result {} 134 135test notify-2.2 {remove and replace sole element} \ 136 -constraints {testevent} \ 137 -body { 138 set delivered {} 139 after 10 set done 1 140 testevent queue one tail {lappend delivered one; expr 1} 141 testevent delete one 142 testevent queue two tail {lappend delivered two; expr 1} 143 vwait done 144 set delivered 145 } \ 146 -result two 147 148test notify-2.3 {remove first element} \ 149 -constraints {testevent} \ 150 -body { 151 set delivered {} 152 after 10 set done 1 153 testevent queue one tail {lappend delivered one; expr 1} 154 testevent queue two tail {lappend delivered two; expr 1} 155 testevent delete one 156 vwait done 157 set delivered 158 } \ 159 -result {two} 160 161test notify-2.4 {remove and replace first element} \ 162 -constraints {testevent} \ 163 -body { 164 set delivered {} 165 after 10 set done 1 166 testevent queue one tail {lappend delivered one; expr 1} 167 testevent queue two tail {lappend delivered two; expr 1} 168 testevent delete one 169 testevent queue three head {lappend delivered three; expr 1}; 170 vwait done 171 set delivered 172 } \ 173 -result {three two} 174 175test notify-2.5 {remove last element} \ 176 -constraints {testevent} \ 177 -body { 178 set delivered {} 179 after 10 set done 1 180 testevent queue one tail {lappend delivered one; expr 1} 181 testevent queue two tail {lappend delivered two; expr 1} 182 testevent delete two 183 vwait done 184 set delivered 185 } \ 186 -result {one} 187 188 189test notify-2.6 {remove and replace last element} \ 190 -constraints {testevent} \ 191 -body { 192 set delivered {} 193 after 10 set done 1 194 testevent queue one tail {lappend delivered one; expr 1} 195 testevent queue two tail {lappend delivered two; expr 1} 196 testevent delete two 197 testevent queue three tail {lappend delivered three; expr 1}; 198 vwait done 199 set delivered 200 } \ 201 -result {one three} 202 203test notify-2.7 {remove a middle element} \ 204 -constraints {testevent} \ 205 -body { 206 set delivered {} 207 after 10 set done 1 208 testevent queue one tail {lappend delivered one; expr 1} 209 testevent queue two tail {lappend delivered two; expr 1} 210 testevent queue three tail {lappend delivered three; expr 1} 211 testevent delete two 212 vwait done 213 set delivered 214 } \ 215 -result {one three} 216 217test notify-2.8 {remove a marker event that's the sole event in the queue} \ 218 -constraints {testevent} \ 219 -body { 220 set delivered {} 221 after 10 set done 1 222 testevent queue one mark {lappend delivered one; expr 1} 223 testevent delete one 224 vwait done 225 set delivered 226 } \ 227 -result {} 228 229test notify-2.9 {remove and replace a marker event that's the sole event} \ 230 -constraints {testevent} \ 231 -body { 232 set delivered {} 233 after 10 set done 1 234 testevent queue one mark {lappend delivered one; expr 1} 235 testevent delete one 236 testevent queue two mark {lappend delivered two; expr 1} 237 vwait done 238 set delivered 239 } \ 240 -result two 241 242test notify-2.10 {remove marker event from head} \ 243 -constraints {testevent} \ 244 -body { 245 set delivered {} 246 after 10 set done 1 247 testevent queue one mark {lappend delivered one; expr 1} 248 testevent queue two mark {lappend delivered two; expr 1} 249 testevent delete one 250 vwait done 251 set delivered 252 } \ 253 -result two 254 255test notify-2.11 {remove and replace marker event at head} \ 256 -constraints {testevent} \ 257 -body { 258 set delivered {} 259 after 10 set done 1 260 testevent queue one mark {lappend delivered one; expr 1} 261 testevent queue two tail {lappend delivered two; expr 1} 262 testevent delete one 263 testevent queue three mark {lappend delivered three; expr 1} 264 vwait done 265 set delivered 266 } \ 267 -result {three two} 268 269test notify-2.12 {remove marker event at tail} \ 270 -constraints {testevent} \ 271 -body { 272 set delivered {} 273 after 10 set done 1 274 testevent queue one mark {lappend delivered one; expr 1} 275 testevent queue two mark {lappend delivered two; expr 1} 276 testevent delete two 277 vwait done 278 set delivered 279 } \ 280 -result {one} 281 282test notify-2.13 {remove and replace marker event at tail} \ 283 -constraints {testevent} \ 284 -body { 285 set delivered {} 286 after 10 set done 1 287 testevent queue one mark {lappend delivered one; expr 1} 288 testevent queue two mark {lappend delivered two; expr 1} 289 testevent delete two 290 testevent queue three mark {lappend delivered three; expr 1} 291 vwait done 292 set delivered 293 } \ 294 -result {one three} 295 296test notify-2.14 {remove marker event from middle} \ 297 -constraints {testevent} \ 298 -body { 299 set delivered {} 300 after 10 set done 1 301 testevent queue one mark {lappend delivered one; expr 1} 302 testevent queue two mark {lappend delivered two; expr 1} 303 testevent queue three mark {lappend delivered three; expr 1} 304 testevent delete two 305 vwait done 306 set delivered 307 } \ 308 -result {one three} 309 310test notify-2.15 {remove and replace marker event at middle} \ 311 -constraints {testevent} \ 312 -body { 313 set delivered {} 314 after 10 set done 1 315 testevent queue one mark {lappend delivered one; expr 1} 316 testevent queue two mark {lappend delivered two; expr 1} 317 testevent queue three tail {lappend delivered three; expr 1} 318 testevent delete two 319 testevent queue four mark {lappend delivered four; expr 1}; 320 vwait done 321 set delivered 322 } \ 323 -result {one four three} 324 325# cleanup 326::tcltest::cleanupTests 327return 328