====== # 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: ====== <> Testing | Widget