1# Tests for the grab command. 2# 3# This file contains a collection of tests for one or more of the Tk 4# built-in commands. Sourcing this file runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1998-2000 by Ajuba Solutions. 8# All rights reserved. 9# 10# RCS: @(#) $Id: grab.test,v 1.2 2002/07/13 21:52:34 dgp Exp $ 11 12package require tcltest 2.1 13namespace import -force tcltest::configure 14namespace import -force tcltest::testsDirectory 15configure -testdir [file join [pwd] [file dirname [info script]]] 16configure -loadfile [file join [testsDirectory] constraints.tcl] 17tcltest::loadTestedCommands 18 19# There's currently no way to test the actual grab effect, per se, 20# in an automated test. Therefore, this test suite only covers the 21# interface to the grab command (ie, error messages, etc.) 22 23test grab-1.1 {Tk_GrabObjCmd} { 24 list [catch {grab} msg] $msg 25} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""] 26test grab-1.2 {Tk_GrabObjCmd} { 27 rename grab grabTest1.2 28 set res [list [catch {grabTest1.2} msg] $msg] 29 rename grabTest1.2 grab 30 set res 31} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""] 32 33test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} { 34 list [catch {grab .foo bar baz} msg] $msg 35} [list 1 "wrong # args: should be \"grab ?-global? window\""] 36test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} { 37 catch {destroy .foo} 38 list [catch {grab .foo} msg] $msg 39} [list 1 "bad window path name \".foo\""] 40test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} { 41 list [catch {grab -foo bar} msg] $msg 42} [list 1 "bad option \"-foo\": must be -global"] 43test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} { 44 catch {destroy .foo} 45 list [catch {grab -global .foo} msg] $msg 46} [list 1 "bad window path name \".foo\""] 47 48test grab-1.7 {Tk_GrabObjCmd} { 49 list [catch {grab foo} msg] $msg 50} [list 1 "bad option \"foo\": must be current, release, set, or status"] 51 52test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} { 53 list [catch {grab current foo bar} msg] $msg 54} [list 1 "wrong # args: should be \"grab current ?window?\""] 55test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} { 56 catch {destroy .foo} 57 list [catch {grab current .foo} msg] $msg 58} [list 1 "bad window path name \".foo\""] 59 60test grab-1.10 {Tk_GrabObjCmd, "grab release window"} { 61 list [catch {grab release} msg] $msg 62} [list 1 "wrong # args: should be \"grab release window\""] 63test grab-1.11 {Tk_GrabObjCmd, "grab release window"} { 64 catch {destroy .foo} 65 list [catch {grab release .foo} msg] $msg 66} [list 0 ""] 67test grab-1.12 {Tk_GrabObjCmd, "grab release window"} { 68 list [catch {grab release foo} msg] $msg 69} [list 0 ""] 70 71test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} { 72 list [catch {grab set} msg] $msg 73} [list 1 "wrong # args: should be \"grab set ?-global? window\""] 74test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} { 75 list [catch {grab set foo bar baz} msg] $msg 76} [list 1 "wrong # args: should be \"grab set ?-global? window\""] 77test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} { 78 catch {destroy .foo} 79 list [catch {grab set .foo} msg] $msg 80} [list 1 "bad window path name \".foo\""] 81test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} { 82 list [catch {grab set -foo bar} msg] $msg 83} [list 1 "bad option \"-foo\": must be -global"] 84test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} { 85 catch {destroy .foo} 86 list [catch {grab set -global .foo} msg] $msg 87} [list 1 "bad window path name \".foo\""] 88 89test grab-1.18 {Tk_GrabObjCmd, "grab status window"} { 90 list [catch {grab status} msg] $msg 91} [list 1 "wrong # args: should be \"grab status window\""] 92test grab-1.19 {Tk_GrabObjCmd, "grab status window"} { 93 list [catch {grab status foo bar} msg] $msg 94} [list 1 "wrong # args: should be \"grab status window\""] 95test grab-1.20 {Tk_GrabObjCmd, "grab status window"} { 96 catch {destroy .foo} 97 list [catch {grab status .foo} msg] $msg 98} [list 1 "bad window path name \".foo\""] 99 100test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} { 101 set curr [grab current .] 102 if { [string length $curr] > 0 } { 103 grab release $curr 104 } 105 set result [grab status .] 106 grab release . 107 set result 108} "none" 109test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} { 110 set curr [grab current .] 111 if { [string length $curr] > 0 } { 112 grab release $curr 113 } 114 grab . 115 set result [grab status .] 116 grab release . 117 set result 118} "local" 119test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} { 120 set curr [grab current .] 121 if { [string length $curr] > 0 } { 122 grab release $curr 123 } 124 grab -global . 125 set result [grab status .] 126 grab release . 127 set result 128} "global" 129 130test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { 131 set curr [grab current .] 132 if { [string length $curr] > 0 } { 133 grab release $curr 134 } 135 set curr 136} "" 137test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} { 138 set curr [grab current .] 139 if { [string length $curr] > 0 } { 140 grab release $curr 141 } 142 grab . 143 set curr [grab current] 144 grab release . 145 set curr 146} "." 147 148test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { 149 set curr [grab current .] 150 if { [string length $curr] > 0 } { 151 grab release $curr 152 } 153 grab . 154 set result [grab status .] 155 grab release . 156 lappend result [grab status .] 157 grab -global . 158 lappend result [grab status .] 159 grab release . 160 lappend result [grab status .] 161} [list "local" "none" "global" "none"] 162 163test grab-5.1 {Tk_GrabObjCmd, grab set} { 164 set curr [grab current .] 165 if { [string length $curr] > 0 } { 166 grab release $curr 167 } 168 grab set . 169 set result [list [grab current .] [grab status .]] 170 grab release . 171 set result 172} [list "." "local"] 173test grab-5.2 {Tk_GrabObjCmd, grab set} { 174 set curr [grab current .] 175 if { [string length $curr] > 0 } { 176 grab release $curr 177 } 178 grab set -global . 179 set result [list [grab current .] [grab status .]] 180 grab release . 181 set result 182} [list "." "global"] 183 184tcltest::cleanupTests 185return 186