diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/embed.test | 51 | ||||
-rw-r--r-- | tests/wm.test | 10 |
2 files changed, 58 insertions, 3 deletions
diff --git a/tests/embed.test b/tests/embed.test new file mode 100644 index 0000000..f19583a --- /dev/null +++ b/tests/embed.test @@ -0,0 +1,51 @@ +# This file is a Tcl script to test out embedded Windows. +# +# Copyright (c) 1996-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: embed.test,v 1.1 2002/05/27 17:33:26 mdejong Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +proc deleteWindows {} { + foreach i [winfo children .] { + destroy $i + } +} + +test embed-1.1 {TkpUseWindow procedure, bad window identifier} { + deleteWindows + list [catch {toplevel .t -use xyz} msg] $msg +} {1 {expected integer but got "xyz"}} + +test embed-1.2 {CreateFrame procedure, bad window identifier} { + deleteWindows + list [catch {toplevel .t -container xyz} msg] $msg +} {1 {expected boolean value but got "xyz"}} + +test embed-1.3 {CreateFrame procedure, both -use and + -container is invalid } { + deleteWindows + toplevel .container -container 1 + list [catch {toplevel .t -use [winfo id .container] \ + -container 1} msg] $msg +} {1 {A window cannot have both the -use and the -container option set.}} + +test embed-1.4 {TkpUseWindow procedure, -container must be set} { + deleteWindows + toplevel .container + list [catch {toplevel .embd -use [winfo id .container]} err] $err +} {1 {window ".container" doesn't have -container option set}} + +test embed-1.5 {TkpUseWindow procedure, -container must be set} { + deleteWindows + frame .container + list [catch {toplevel .embd -use [winfo id .container]} err] $err +} {1 {window ".container" doesn't have -container option set}} + + +# FIXME: test cases common to unixEmbed.test and macEmbed.test should +# be moved here. diff --git a/tests/wm.test b/tests/wm.test index 0665bcc..2dea668 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: wm.test,v 1.5 2002/05/24 09:50:11 mdejong Exp $ +# RCS: @(#) $Id: wm.test,v 1.6 2002/05/27 17:33:26 mdejong Exp $ # This file tests window manager interactions that work across # platforms. Window manager tests that only work on a specific @@ -20,13 +20,14 @@ if {[lsearch [namespace children] ::tcltest] == -1} { proc deleteWindows {} { foreach i [winfo children .] { - catch [destroy $i] + destroy $i } } deleteWindows +wm deicon . test wm-stackorder-1.1 {usage} { list [catch {wm stackorder} err] $err @@ -296,7 +297,7 @@ test wm-stackorder-5.3 {An overrideredirect window test wm-stackorder-6.1 {An embedded toplevel does not appear in the stacking order} { deleteWindows - toplevel .real + toplevel .real -container 1 toplevel .embd -bg blue -use [winfo id .real] update wm stackorder . @@ -351,6 +352,9 @@ test wm-transient-1.6 {usage} { # if the window was raised after a button click for example. # This sort of testing may not be possible. + +deleteWindows + return |