71 lines
2.1 KiB
Plaintext
71 lines
2.1 KiB
Plaintext
# 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.
|
|
|
|
package require tcltest 2.1
|
|
eval tcltest::configure $argv
|
|
tcltest::loadTestedCommands
|
|
|
|
global tcl_platform
|
|
|
|
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.}}
|
|
|
|
if {$tcl_platform(platform) == "windows"} {
|
|
|
|
# testing window embedding for Windows platform
|
|
|
|
test embed-1.4.win {TkpUseWindow procedure, -container must be set} {
|
|
deleteWindows
|
|
toplevel .container
|
|
list [catch {toplevel .embd -use [winfo id .container]} err] $err
|
|
} {1 {the window to use is not a Tk container}}
|
|
|
|
test embed-1.5.win {TkpUseWindow procedure, -container must be set} {
|
|
deleteWindows
|
|
frame .container
|
|
list [catch {toplevel .embd -use [winfo id .container]} err] $err
|
|
} {1 {the window to use is not a Tk container}}
|
|
|
|
} else {
|
|
|
|
# testing window embedding for other platforms
|
|
|
|
test embed-1.4.nonwin {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.nonwin {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.
|
|
|
|
cleanupTests
|
|
return
|
|
|