summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorericm <ericm>2000-08-04 00:46:32 (GMT)
committerericm <ericm>2000-08-04 00:46:32 (GMT)
commite362ccb25a38008c0f631717e1cc8c73b7987b84 (patch)
treefde6063717a4670883cc80b3f9ffd34b2c3d3cbb /tests
parentdf81a224e1174214893a5a153dbafccc832ad1c3 (diff)
downloadtk-e362ccb25a38008c0f631717e1cc8c73b7987b84.zip
tk-e362ccb25a38008c0f631717e1cc8c73b7987b84.tar.gz
tk-e362ccb25a38008c0f631717e1cc8c73b7987b84.tar.bz2
* generic/tkWindow.c: Updated "grab" command entry to use
Tcl_Obj'ified command. * generic/tkInt.h: Replaced Tk_GrabCmd prototype with Tk_GrabObjCmd prototype. * tests/grab.test: Initial suite of tests for [grab] command. * generic/tkGrab.c (Tk_GrabObjCmd): Tcl_Obj'ified [grab] command. * generic/tkCmds.c: Fixed casting problem in Tk_BindtagsObjCmd.
Diffstat (limited to 'tests')
-rw-r--r--tests/grab.test179
1 files changed, 179 insertions, 0 deletions
diff --git a/tests/grab.test b/tests/grab.test
new file mode 100644
index 0000000..b1fd106
--- /dev/null
+++ b/tests/grab.test
@@ -0,0 +1,179 @@
+# Tests for the grab command.
+#
+# This file contains a collection of tests for one or more of the Tk
+# built-in commands. Sourcing this file runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id: grab.test,v 1.1 2000/08/04 00:46:33 ericm Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# There's currently no way to test the actual grab effect, per se,
+# in an automated test. Therefore, this test suite only covers the
+# interface to the grab command (ie, error messages, etc.)
+
+test grab-1.1 {Tk_GrabObjCmd} {
+ list [catch {grab} msg] $msg
+} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""]
+test grab-1.2 {Tk_GrabObjCmd} {
+ rename grab grabTest1.2
+ set res [list [catch {grabTest1.2} msg] $msg]
+ rename grabTest1.2 grab
+ set res
+} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""]
+
+test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ list [catch {grab .foo bar baz} msg] $msg
+} [list 1 "wrong # args: should be \"grab ?-global? window\""]
+test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ list [catch {grab -foo bar} msg] $msg
+} [list 1 "bad option \"-foo\": must be -global"]
+test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab -global .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.7 {Tk_GrabObjCmd} {
+ list [catch {grab foo} msg] $msg
+} [list 1 "bad option \"foo\": must be current, release, set, or status"]
+
+test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} {
+ list [catch {grab current foo bar} msg] $msg
+} [list 1 "wrong # args: should be \"grab current ?window?\""]
+test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} {
+ catch {destroy .foo}
+ list [catch {grab current .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.10 {Tk_GrabObjCmd, "grab release window"} {
+ list [catch {grab release} msg] $msg
+} [list 1 "wrong # args: should be \"grab release window\""]
+test grab-1.11 {Tk_GrabObjCmd, "grab release window"} {
+ catch {destroy .foo}
+ list [catch {grab release .foo} msg] $msg
+} [list 0 ""]
+test grab-1.12 {Tk_GrabObjCmd, "grab release window"} {
+ list [catch {grab release foo} msg] $msg
+} [list 0 ""]
+
+test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set} msg] $msg
+} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
+test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set foo bar baz} msg] $msg
+} [list 1 "wrong # args: should be \"grab set ?-global? window\""]
+test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab set .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ list [catch {grab set -foo bar} msg] $msg
+} [list 1 "bad option \"-foo\": must be -global"]
+test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} {
+ catch {destroy .foo}
+ list [catch {grab set -global .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-1.18 {Tk_GrabObjCmd, "grab status window"} {
+ list [catch {grab status} msg] $msg
+} [list 1 "wrong # args: should be \"grab status window\""]
+test grab-1.19 {Tk_GrabObjCmd, "grab status window"} {
+ list [catch {grab status foo bar} msg] $msg
+} [list 1 "wrong # args: should be \"grab status window\""]
+test grab-1.20 {Tk_GrabObjCmd, "grab status window"} {
+ catch {destroy .foo}
+ list [catch {grab status .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+
+test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ set result [grab status .]
+ grab release .
+ set result
+} "none"
+test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set result [grab status .]
+ grab release .
+ set result
+} "local"
+test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab -global .
+ set result [grab status .]
+ grab release .
+ set result
+} "global"
+
+test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ set curr
+} ""
+test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set curr [grab current]
+ grab release .
+ set curr
+} "."
+
+test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab .
+ set result [grab status .]
+ grab release .
+ lappend result [grab status .]
+ grab -global .
+ lappend result [grab status .]
+ grab release .
+ lappend result [grab status .]
+} [list "local" "none" "global" "none"]
+
+test grab-5.1 {Tk_GrabObjCmd, grab set} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab set .
+ set result [list [grab current .] [grab status .]]
+ grab release .
+ set result
+} [list "." "local"]
+test grab-5.2 {Tk_GrabObjCmd, grab set} {
+ set curr [grab current .]
+ if { [string length $curr] > 0 } {
+ grab release $curr
+ }
+ grab set -global .
+ set result [list [grab current .] [grab status .]]
+ grab release .
+ set result
+} [list "." "global"]