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