sl@0: # -*- tcl -*- sl@0: # sl@0: # notify.test -- sl@0: # sl@0: # This file tests several functions in the file, 'generic/tclNotify.c'. sl@0: # sl@0: # This file contains a collection of tests for one or more of the Tcl sl@0: # built-in commands. Sourcing this file into Tcl runs the tests and sl@0: # generates output for errors. No output means no errors were found. sl@0: # sl@0: # Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. sl@0: # sl@0: # See the file "license.terms" for information on usage and redistribution sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: # sl@0: # RCS: @(#) $Id: notify.test,v 1.2.2.1 2003/10/06 13:55:38 dgp Exp $ sl@0: sl@0: if {[lsearch [namespace children] ::tcltest] == -1} { sl@0: package require tcltest 2 sl@0: namespace import -force ::tcltest::* sl@0: } sl@0: sl@0: testConstraint testevent [llength [info commands testevent]] sl@0: sl@0: test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one} sl@0: sl@0: test notify-1.2 {Tcl_QueueEvent and delivery of events in order} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent queue three tail {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one two three} sl@0: sl@0: test notify-1.3 {Tcl_QueueEvent at head} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one head {lappend delivered one; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result one sl@0: sl@0: test notify-1.4 {Tcl_QueueEvent multiple events at head} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one head {lappend delivered one; expr 1} sl@0: testevent queue two head {lappend delivered two; expr 1} sl@0: testevent queue three head {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {three two one} sl@0: sl@0: test notify-1.5 {Tcl_QueueEvent marker event into an empty queue} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result one sl@0: sl@0: test notify-1.6 {Tcl_QueueEvent first marker event in a nonempty queue} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent queue three head {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {three two one} sl@0: sl@0: test notify-1.7 {Tcl_QueueEvent second marker event} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one two} sl@0: sl@0: test notify-1.8 {Tcl_QueueEvent preexisting event following second marker} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent queue three mark {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one three two} sl@0: sl@0: test notify-2.1 {remove sole element, don't replace } \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent delete one sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {} sl@0: sl@0: test notify-2.2 {remove and replace sole element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent delete one sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result two sl@0: sl@0: test notify-2.3 {remove first element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent delete one sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {two} sl@0: sl@0: test notify-2.4 {remove and replace first element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent delete one sl@0: testevent queue three head {lappend delivered three; expr 1}; sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {three two} sl@0: sl@0: test notify-2.5 {remove last element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent delete two sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one} sl@0: sl@0: sl@0: test notify-2.6 {remove and replace last element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent delete two sl@0: testevent queue three tail {lappend delivered three; expr 1}; sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one three} sl@0: sl@0: test notify-2.7 {remove a middle element} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one tail {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent queue three tail {lappend delivered three; expr 1} sl@0: testevent delete two sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one three} sl@0: sl@0: test notify-2.8 {remove a marker event that's the sole event in the queue} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent delete one sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {} sl@0: sl@0: test notify-2.9 {remove and replace a marker event that's the sole event} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent delete one sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result two sl@0: sl@0: test notify-2.10 {remove marker event from head} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent delete one sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result two sl@0: sl@0: test notify-2.11 {remove and replace marker event at head} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two tail {lappend delivered two; expr 1} sl@0: testevent delete one sl@0: testevent queue three mark {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {three two} sl@0: sl@0: test notify-2.12 {remove marker event at tail} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent delete two sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one} sl@0: sl@0: test notify-2.13 {remove and replace marker event at tail} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent delete two sl@0: testevent queue three mark {lappend delivered three; expr 1} sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one three} sl@0: sl@0: test notify-2.14 {remove marker event from middle} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent queue three mark {lappend delivered three; expr 1} sl@0: testevent delete two sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one three} sl@0: sl@0: test notify-2.15 {remove and replace marker event at middle} \ sl@0: -constraints {testevent} \ sl@0: -body { sl@0: set delivered {} sl@0: after 10 set done 1 sl@0: testevent queue one mark {lappend delivered one; expr 1} sl@0: testevent queue two mark {lappend delivered two; expr 1} sl@0: testevent queue three tail {lappend delivered three; expr 1} sl@0: testevent delete two sl@0: testevent queue four mark {lappend delivered four; expr 1}; sl@0: vwait done sl@0: set delivered sl@0: } \ sl@0: -result {one four three} sl@0: sl@0: # cleanup sl@0: ::tcltest::cleanupTests sl@0: return