# 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.3 2003/01/21 20:24:50 hunt Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands # 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"] tcltest::cleanupTests return