# wtree.test --
#
# Part of: wtree
# Contents: tests for the wtree package
# Date: Sun Sep 21, 2003
#
# Abstract
#
#
#
# Copyright (c) 2003 Marco Maggi
#
# The author hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose,
# provided that existing copyright notices are retained in all copies
# and that this notice is included verbatim in any distributions. No
# written agreement, license, or royalty fee is required for any of the
# authorized uses. Modifications to this software may be copyrighted by
# their authors and need not follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS,
# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# $Id: 9989,v 1.2 2003-09-27 08:00:35 jcw Exp $
package require Tcl 8.4
package require tcltest 2.2
::tcltest::configure -verbose "pass error" \
-testdir [file dirname [file normalize [info script]]]
eval ::tcltest::configure $argv
source [file join [file dirname [info script]] wtree.tcl]
namespace eval ::test {
variable delay 200
tk::wm withdraw .
proc wait {} {
update
update idletasks
after 200
}
proc data_window { window parent } {
make_toplevel $window $parent
tk::wm title $window "Data Window ($window)"
wtree::register $window $parent
wtree::set_focus_mode $window keep
return $window
}
proc dialog_window { window parent } {
make_toplevel $window $parent
tk::wm title $window "Dialog ($window)"
wtree::register $window $parent
wtree::set_focus_mode $window ontop
wtree::set_focus_window $parent $window
return $window
}
proc error_window { window parent } {
make_toplevel $window $parent
tk::wm title $window "Error ($window)"
wtree::register $window $parent
wtree::set_focus_mode $window keep
wtree::set_focus_window $parent $window
return $window
}
proc make_toplevel { window parent } {
tk::toplevel $window
tk::wm positionfrom $window program
set g [tk::wm geometry $parent]
scan $g "%dx%d+%d+%d" width height x y
tk::wm geometry $window \
[format "300x100+%d+%d" [expr {$x+60}] [expr {$y+90}]]
return $window
}
#PAGE
::tcltest::test wtree-1.1 "register/unregister" {
-setup {
tk::toplevel .t
}
-body {
set res [wtree::exists .t]
wtree::register .t
lappend res [wtree::exists .t]
wtree::forget .t
lappend res [wtree::exists .t]
}
-result {0 1 0}
-cleanup {
tk::destroy .t
unset -nocomplain res
}
}
::tcltest::test wtree-1.2 "register/destroy" {
-setup {
tk::toplevel .t
}
-body {
set res [wtree::exists .t]
wtree::register .t
lappend res [wtree::exists .t]
tk::destroy .t
lappend res [wtree::exists .t]
}
-result {0 1 0}
-cleanup {
unset -nocomplain res
}
}
#PAGE
::tcltest::test wtree-2.1 "data->error" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
error_window .errorw .dataw
tk::focus .errorw
wait
}
-body {
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dataw]
tk::focus .dataw
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dataw]
}
-result ".errorw 1 .errorw 1"
-cleanup {
tk::destroy .errorw .dataw
unset -nocomplain errorw dataw res
}
}
::tcltest::test wtree-2.2 "data->dialog" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
}
-body {
lappend res [tk::focus] \
[tk::wm stackorder .dialogw isabove .dataw]
tk::focus .dataw
wait
lappend res [tk::focus] \
[tk::wm stackorder .dialogw isabove .dataw]
tk::focus .dialogw
wait
lappend res [tk::focus] \
[tk::wm stackorder .dialogw isabove .dataw]
}
-result ".dialogw 1 .dataw 1 .dialogw 1"
-cleanup {
tk::destroy .dialogw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-2.3 "data->dialog->error, focus all" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
error_window .errorw .dialogw
tk::focus .errorw
wait
}
-body {
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
tk::focus .dialogw
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
tk::focus .dataw
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
tk::focus .errorw
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
}
-result ".errorw 1 1 .errorw 1 1 .errorw 1 1 .errorw 1 1"
-cleanup {
tk::destroy .dialogw .errorw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-2.4 "data->dialog|error, focus dialog" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
error_window .errorw .dataw
tk::focus .errorw
wait
}
-body {
lappend res [tk::focus]
tk::focus .dialogw
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .errorw isabove .dataw]
}
-result ".errorw .errorw 1 1"
-cleanup {
tk::destroy .dialogw .errorw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-2.5 "data->dialog->error, data->dialog->error" {
-setup {
data_window .dataw1 .
tk::focus .dataw1
wait
dialog_window .dialogw1 .dataw1
tk::focus .dialogw1
wait
error_window .errorw1 .dialogw1
tk::focus .errorw1
wait
data_window .dataw2 .
tk::focus .dataw2
wait
dialog_window .dialogw2 .dataw2
tk::focus .dialogw2
wait
error_window .errorw2 .dialogw2
tk::focus .errorw2
wait
}
-body {
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
tk::focus .dialogw2
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
tk::focus .dataw2
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
tk::focus .dataw1
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
tk::focus .dialogw1
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
tk::focus .errorw2
wait
lappend res [tk::focus] \
[tk::wm stackorder .errorw1 isabove .dialogw1] \
[tk::wm stackorder .dialogw1 isabove .dataw1] \
[tk::wm stackorder .errorw2 isabove .dialogw2] \
[tk::wm stackorder .dialogw2 isabove .dataw2]
}
-result ".errorw2 1 1 1 1 .errorw2 1 1 1 1 .errorw2 1 1 1 1 .errorw1 1 1 1 1 .errorw1 1 1 1 1 .errorw2 1 1 1 1"
-cleanup {
tk::destroy .dialogw .errorw .dataw
unset -nocomplain res
}
}
#PAGE
::tcltest::test wtree-3.1 "data->error, iconify" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
error_window .errorw .dataw
tk::focus .errorw
wait
}
-body {
tk::wm iconify .dataw
wait
lappend res [tk::wm state .dataw] [tk::wm state .errorw]
tk::wm deiconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .errorw] \
[string equal [tk::focus] .errorw] \
[tk::wm stackorder .errorw isabove .dataw]
}
-result "iconic withdrawn normal normal 1 1"
-cleanup {
tk::destroy .errorw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-3.2 "data->dialog, iconify" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
}
-body {
tk::wm iconify .dataw
wait
lappend res [tk::wm state .dataw] [tk::wm state .dialogw]
tk::wm deiconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .dialogw] \
[string equal [tk::focus] .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
}
-result "iconic withdrawn normal normal 1 1"
-cleanup {
tk::destroy .dialogw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-3.3 "data->dialog->error, iconify" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
error_window .errorw .dialogw
tk::focus .errorw
wait
}
-body {
tk::wm iconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .dialogw] \
[tk::wm state .errorw]
tk::wm deiconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .dialogw] \
[tk::wm state .errorw] \
[string equal [tk::focus] .errorw] \
[tk::wm stackorder .errorw isabove .dialogw] \
[tk::wm stackorder .dialogw isabove .dataw]
}
-result "iconic withdrawn withdrawn normal normal normal 1 1 1"
-cleanup {
tk::destroy .dialogw .errorw .dataw
unset -nocomplain res
}
}
::tcltest::test wtree-3.4 "data->dialog|error, iconify" {
-setup {
data_window .dataw .
tk::focus .dataw
wait
dialog_window .dialogw .dataw
tk::focus .dialogw
wait
error_window .errorw .dataw
tk::focus .errorw
wait
}
-body {
tk::wm iconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .dialogw] \
[tk::wm state .errorw]
tk::wm deiconify .dataw
wait
lappend res \
[tk::wm state .dataw] \
[tk::wm state .dialogw] \
[tk::wm state .errorw] \
[string equal [tk::focus] .errorw] \
[tk::wm stackorder .errorw isabove .dataw] \
[tk::wm stackorder .errorw isabove .dialogw]
}
-result "iconic withdrawn withdrawn normal normal normal 1 1 1"
-cleanup {
tk::destroy .dialogw .errorw .dataw
unset -nocomplain res
}
}
::tcltest::cleanupTests
}
namespace delete ::test
### end of file
# Local Variables:
# mode: tcl
# page-delimiter: "^#PAGE"
# End: