181 lines
5.9 KiB
Plaintext
181 lines
5.9 KiB
Plaintext
# 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.
|
|
|
|
package require tcltest 2.1
|
|
eval tcltest::configure $argv
|
|
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"]
|
|
|
|
cleanupTests
|
|
return
|