URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [window.test] - Rev 578
Go to most recent revision | Compare with Previous | Blame | View Log
# This file is a Tcl script to test the procedures in the file
# tkWindow.c. It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: window.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
if {[info procs test] != "test"} {
source defs
}
foreach i [winfo children .] {
destroy $i
}
wm geometry . {}
raise .
update
# XXX This file is woefully incomplete. Right now it only tests
# a few parts of a few procedures in tkWindow.c
test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} {
proc bgerror msg {
global x errorInfo
set x [list $msg $errorInfo]
}
set x unchanged
catch {destroy .t}
frame .t -width 100 -height 50
place .t -x 10 -y 10
bind .t <Destroy> {button .t.b -text hello; pack .t.b}
update
destroy .t
update
rename bgerror {}
set x
} {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed
while executing
"button .t.b -text hello"
(command bound to event)}}
# Most of the tests below don't produce meaningful results; they
# will simply dump core if there are bugs.
test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
toplevel .t -width 300 -height 200
wm geometry .t +0+0
frame .t.f -width 200 -height 200 -relief raised -bd 2
place .t.f -x 0 -y 0
frame .t.f.f -width 100 -height 100 -relief raised -bd 2
place .t.f.f -relx 1 -rely 1 -anchor se
bind .t.f <Destroy> {destroy .t}
update
destroy .t.f
} {}
test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
toplevel .t -width 300 -height 200
wm geometry .t +0+0
frame .t.f -width 200 -height 200 -relief raised -bd 2
place .t.f -x 0 -y 0
frame .t.f.f -width 100 -height 100 -relief raised -bd 2
place .t.f.f -relx 1 -rely 1 -anchor se
bind .t.f.f <Destroy> {destroy .t}
update
destroy .t.f
} {}
test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
frame .f -width 80 -height 120 -relief raised -bd 2
place .f -relx 0.5 -rely 0.5 -anchor center
toplevel .f.t -width 300 -height 200
wm geometry .f.t +0+0
frame .f.t.f -width 200 -height 200 -relief raised -bd 2
place .f.t.f -x 0 -y 0
frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2
place .f.t.f.f -relx 1 -rely 1 -anchor se
update
destroy .f
} {}
if {[string compare testmenubar [info commands testmenubar]] != 0} {
puts "This application hasn't been compiled with the testmenubar command,"
puts "therefore I am skipping all of these tests."
return
}
test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
catch {destroy .t}
toplevel .t -width 300 -height 200
wm geometry .t +0+0
pack [entry .t.e]
frame .t.f -bd 2 -relief raised
testmenubar window .t .t.f
update
# If stacking order isn't handle properly, generates an X error.
} {}
test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
catch {destroy .t}
toplevel .t -width 300 -height 200
wm geometry .t +0+0
pack [entry .t.e]
pack [entry .t.e2]
update
frame .t.f -bd 2 -relief raised
raise .t.f .t.e
testmenubar window .t .t.f
update
# If stacking order isn't handled properly, generates an X error.
} {}
test window-4.1 {Tk_NameToWindow procedure} {
catch {destroy .t}
list [catch {winfo geometry .t} msg] $msg
} {1 {bad window path name ".t"}}
test window-4.2 {Tk_NameToWindow procedure} {
catch {destroy .t}
frame .t -width 100 -height 50
place .t -x 10 -y 10
update
list [catch {winfo geometry .t} msg] $msg
} {0 100x50+10+10}
test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
catch {destroy .t}
toplevel .t -width 300 -height 200
wm geometry .t +0+0
pack [entry .t.e]
pack [entry .t.e2]
frame .t.f -bd 2 -relief raised
testmenubar window .t .t.f
update
lower .t.e2 .t.f
update
# If stacking order isn't handled properly, generates an X error.
} {}
Go to most recent revision | Compare with Previous | Blame | View Log