summaryrefslogtreecommitdiffstats
path: root/tests/event.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/event.test')
-rw-r--r--tests/event.test209
1 files changed, 131 insertions, 78 deletions
diff --git a/tests/event.test b/tests/event.test
index 95be5f4..756dbe5 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -6,9 +6,10 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-package require tcltest 2.1
+package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
+namespace import -force tcltest::test
# XXX This test file is woefully incomplete. Right now it only tests
# a few of the procedures in tkEvent.c. Please add more tests whenever
@@ -183,37 +184,49 @@ proc _get_selection {widget} {
# Begining of the actual tests
-test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
+test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup {
+ deleteWindows
+ set x {}
+} -body {
button .b -text Test
pack .b
bindtags .b .b
update
bind .b <Destroy> {
- lappend x destroy
- event generate .b <1>
- event generate .b <ButtonRelease-1>
+ lappend x destroy
+ event generate .b <1>
+ event generate .b <ButtonRelease-1>
}
bind .b <1> {
- lappend x button
+ lappend x button
}
- set x {}
+
destroy .b
- set x
-} {destroy}
-test event-1.2 {event generate <Alt-z>} {
- catch {destroy .e}
- catch {unset ::event12result}
+ return $x
+} -cleanup {
+ deleteWindows
+} -result {destroy}
+test event-1.2 {event generate <Alt-z>} -setup {
+ deleteWindows
+ catch {unset ::event12result}
+} -body {
set ::event12result 0
pack [entry .e]
update
bind .e <Alt-z> {set ::event12result "1"}
- focus -force .e ; event generate .e <Alt-z>
+
+ focus -force .e
+ event generate .e <Alt-z>
destroy .e
set ::event12result
-} 1
+} -cleanup {
+ deleteWindows
+} -result 1
+
-test event-2.1(keypress) {type into entry widget and hit Return} {
- destroy .t
+test event-2.1(keypress) {type into entry widget and hit Return} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -222,9 +235,12 @@ test event-2.1(keypress) {type into entry widget and hit Return} {
tkwait visibility $e
_keypress_string $e HELLO\n
list [$e get] $return_binding
-} {HELLO 1}
-test event-2.2(keypress) {type into entry widget and then delete some text} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {HELLO 1}
+test event-2.2(keypress) {type into entry widget and then delete some text} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -233,10 +249,13 @@ test event-2.2(keypress) {type into entry widget and then delete some text} {
_keypress $e BackSpace
_keypress $e BackSpace
$e get
-} MEL
-test event-2.3(keypress) {type into entry widget, triple click,\
- hit Delete key, and then type some more} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {MEL}
+test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
+ and then type some more} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -256,9 +275,12 @@ test event-2.3(keypress) {type into entry widget, triple click,\
_keypress $e Delete
_keypress_string $e UP
lappend result [$e get]
-} {JUMP UP}
-test event-1.4(keypress) {type into text widget and hit Return} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {JUMP UP}
+test event-2.4(keypress) {type into text widget and hit Return} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -267,9 +289,12 @@ test event-1.4(keypress) {type into text widget and hit Return} {
tkwait visibility $e
_keypress_string $e HELLO\n
list [$e get 1.0 end] $return_binding
-} [list "HELLO\n\n" 1]
-test event-2.5(keypress) {type into text widget and then delete some text} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result [list "HELLO\n\n" 1]
+test event-2.5(keypress) {type into text widget and then delete some text} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -278,10 +303,13 @@ test event-2.5(keypress) {type into text widget and then delete some text} {
_keypress $e BackSpace
_keypress $e BackSpace
$e get 1.0 1.end
-} MEL
-test event-2.6(keypress) {type into text widget, triple click,\
- hit Delete key, and then type some more} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {MEL}
+test event-2.6(keypress) {type into text widget, triple click,
+ hit Delete key, and then type some more} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -301,11 +329,14 @@ test event-2.6(keypress) {type into text widget, triple click,\
_keypress $e Delete
_keypress_string $e UP
lappend result [$e get 1.0 1.end]
-} {JUMP UP}
-
-test event-3.1(click-drag) {click and drag in a text widget, this tests\
- tkTextSelectTo in text.tcl} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {JUMP UP}
+
+test event-3.1(click-drag) {click and drag in a text widget, this tests
+ tkTextSelectTo in text.tcl} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -366,10 +397,13 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests\
# Save the highlighted text
lappend result [_get_selection $e]
-} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
-test event-3.2(click-drag) {click and drag in an entry widget, this\
- tests tkEntryMouseSelect in entry.tcl} {
- destroy .t
+} -cleanup {
+ deleteWindows
+} -result {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
+ test event-3.2(click-drag) {click and drag in an entry widget, this
+ tests tkEntryMouseSelect in entry.tcl} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -430,11 +464,15 @@ test event-3.2(click-drag) {click and drag in an entry widget, this\
# Save the highlighted text
lappend result [_get_selection $e]
-} {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}
+} -cleanup {
+ deleteWindows
+} -result {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}
-test event-4.1(double-click-drag) {click down, click up, click down again,\
- then drag in a text widget} {
- destroy .t
+
+test event-4.1(double-click-drag) {click down, click up, click down again,
+ then drag in a text widget} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -497,11 +535,14 @@ test event-4.1(double-click-drag) {click down, click up, click down again,\
# Insert cursor should be before the r in "Word"
lappend result [$e index insert]
- set result
-} {select 1.5 1.7 select 1.4 { select} {Word select} 1.2}
-test event-4.2(double-click-drag) {click down, click up, click down again,\
- then drag in an entry widget} {
- destroy .t
+ return $result
+} -cleanup {
+ deleteWindows
+} -result {select 1.5 1.7 select 1.4 { select} {Word select} 1.2}
+test event-4.2(double-click-drag) {click down, click up, click down again,
+ then drag in an entry widget} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -564,12 +605,15 @@ test event-4.2(double-click-drag) {click down, click up, click down again,\
# Insert cursor should be before the r in "Word"
lappend result [$e index insert]
- set result
-} {select 11 7 select 4 { select} {Word select} 2}
+ return $result
+} -cleanup {
+ deleteWindows
+} -result {select 11 7 select 4 { select} {Word select} 2}
-test event-5.1(triple-click-drag) {Triple click and drag across lines in\
- a text widget, this should extend the selection to the new line} {
- destroy .t
+test event-5.1(triple-click-drag) {Triple click and drag across lines in a
+ text widget, this should extend the selection to the new line} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -620,16 +664,18 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in\
lappend result [_get_selection $e]
- set result
-
-} [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
+ return $result
+} -cleanup {
+ deleteWindows
+} -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
"LINE ONE\nLINE TWO\nLINE THREE\n"]
-test event-6.1(button-state) {button press in a window that is then\
- destroyed, when the mouse is moved into another window it\
- should not generate a <B1-motion> event since the mouse\
- was not pressed down in that window} {
- destroy .t
+test event-6.1(button-state) {button press in a window that is then
+ destroyed, when the mouse is moved into another window it
+ should not generate a <B1-motion> event since the mouse
+ was not pressed down in that window} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
event generate $t <ButtonPress-1>
@@ -638,12 +684,15 @@ test event-6.1(button-state) {button press in a window that is then\
set motion nomotion
bind $t <B1-Motion> {set motion inmotion}
event generate $t <Motion>
- set motion
-} nomotion
+ return $motion
+} -cleanup {
+ deleteWindows
+} -result {nomotion}
test event-7.1(double-click) {A double click on a lone character
- in a text widget should select that character} {
- destroy .t
+ in a text widget should select that character} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [text $t.e]
pack $e
@@ -702,11 +751,14 @@ test event-7.1(double-click) {A double click on a lone character
lappend result [$e index insert]
lappend result [_get_selection $e]
- set result
-} {1.3 A 1.3 A}
-test event-7.2(double-click) {A double click on a lone character\
- in an entry widget should select that character} {
- destroy .t
+ return $result
+} -cleanup {
+ deleteWindows
+} -result {1.3 A 1.3 A}
+test event-7.2(double-click) {A double click on a lone character
+ in an entry widget should select that character} -setup {
+ deleteWindows
+} -body {
set t [toplevel .t]
set e [entry $t.e]
pack $e
@@ -765,13 +817,12 @@ test event-7.2(double-click) {A double click on a lone character\
lappend result [$e index insert]
lappend result [_get_selection $e]
- set result
-} {4 A 4 A}
+ return $result
+} -cleanup {
+ deleteWindows
+} -result {4 A 4 A}
# cleanup
-
-destroy .t
-
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
rename _keypress_lookup {}
@@ -782,3 +833,5 @@ rename _get_selection {}
cleanupTests
return
+
+